artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

repl: Fix include, load, use MODULE, and mes-use-module.

Browse source 
Reported by Irvise via IRC.

* mes/module/mes/repl.mes (repl)[load-env, mes-load-module-env]: New
inner defines.
[use]: Use mes-load-module-env, do not return content of module.
Special-case 'include' and 'load'.
This commit is contained in:
Janneke Nieuwenhuizen 2023-07-08 11:11:38 +02:00
parent 5850531ae9
commit 8e75c00c7b
1 changed files with 42 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

56
mes/module/mes/repl.mes
View file

@ -126,6 +126,26 @@ along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
(newline)) (newline))
(core:macro-expand sexp)))) (core:macro-expand sexp))))
(define (load-env file-name a)
(push! *input-ports* (current-input-port))
(set-current-input-port
(open-input-file file-name))
(let ((x (core:eval (append2 (cons 'begin (read-input-file-env a))
'((current-module)))
a)))
(set-current-input-port (pop! *input-ports*))
x))
(define (mes-load-module-env module a)
(push! *input-ports* (current-input-port))
(set-current-input-port
(open-input-file (string-append %moduledir (module->file module))))
(let ((x (core:eval (append2 (cons 'begin (read-input-file-env a))
'((current-module)))
a)))
(set-current-input-port (pop! *input-ports*))
x))
(define (help . x) (display help-commands) *unspecified*) (define (help . x) (display help-commands) *unspecified*)
(define (show . x) (define (show . x)
(define topic-alist `((#\newline . ,show-commands) (define topic-alist `((#\newline . ,show-commands)
@ -140,7 +160,8 @@ along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
(define (use a) (define (use a)
(lambda () (lambda ()
(let ((module (read))) (let ((module (read)))
(mes-load-module-env module a)))) (mes-load-module-env module a)
module)))
(define (meta command a) (define (meta command a)
(let ((command-alist `((expand . ,(expand a)) (let ((command-alist `((expand . ,(expand a))
(help . ,help) (help . ,help)
@ -163,19 +184,26 @@ along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
(display sexp) (display sexp)
(display "]") (display "]")
(newline)) (newline))
(if (and (pair? sexp) (eq? (car sexp) 'mes-use-module)) (cond
(loop (mes-load-module-env (cadr sexp) a)) ((and (pair? sexp) (eq? (car sexp) 'mes-use-module))
(let ((e (if (and (pair? sexp) (eq? (car sexp) (string->symbol "unquote"))) (let ((module (cadr sexp)))
(meta (cadr sexp) a) (mes-load-module-env module a)
(core:eval sexp a)))) (loop a)))
(if (eq? e *unspecified*) (loop a) ((and (pair? sexp) (memq (car sexp) '(include load)))
(let ((id (string->symbol (string-append "$" (number->string count))))) (load-env (cadr sexp) a)
(set! count (+ count 1)) (loop a))
(display id) (else
(display " = ") (let ((e (if (and (pair? sexp) (eq? (car sexp) (string->symbol "unquote")))
(write e) (meta (cadr sexp) a)
(newline) (core:eval sexp a))))
(loop (acons id e a))))))))) (if (eq? e *unspecified*) (loop a)
(let ((id (string->symbol (string-append "$" (number->string count)))))
(set! count (+ count 1))
(display id)
(display " = ")
(write e)
(newline)
(loop (acons id e a))))))))))
(lambda (key . args) (lambda (key . args)
(if (defined? 'with-output-to-string) (if (defined? 'with-output-to-string)
(simple-format (current-error-port) "exception:~a:~a\n" key args) (simple-format (current-error-port) "exception:~a:~a\n" key args)