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))
(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 (show . x)
(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)
(lambda ()
(let ((module (read)))
(mes-load-module-env module a))))
(mes-load-module-env module a)
module)))
(define (meta command a)
(let ((command-alist `((expand . ,(expand a))
(help . ,help)
@ -163,19 +184,26 @@ along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
(display sexp)
(display "]")
(newline))
(if (and (pair? sexp) (eq? (car sexp) 'mes-use-module))
(loop (mes-load-module-env (cadr sexp) a))
(let ((e (if (and (pair? sexp) (eq? (car sexp) (string->symbol "unquote")))
(meta (cadr sexp) a)
(core:eval sexp 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)))))))))
(cond
((and (pair? sexp) (eq? (car sexp) 'mes-use-module))
(let ((module (cadr sexp)))
(mes-load-module-env module a)
(loop a)))
((and (pair? sexp) (memq (car sexp) '(include load)))
(load-env (cadr sexp) a)
(loop a))
(else
(let ((e (if (and (pair? sexp) (eq? (car sexp) (string->symbol "unquote")))
(meta (cadr sexp) a)
(core:eval sexp 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)
(if (defined? 'with-output-to-string)
(simple-format (current-error-port) "exception:~a:~a\n" key args)