mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
fixes so that typing asdfadfasff in the repl doesn't error
Before: > ,c (set! x 3) 0 (make-int8 3) ;; 3 2 (link "x") 5 (variable-set) > ,c (define x 3) 0 (make-int8 3) ;; 3 2 (link "x") 5 (variable-set) After: > ,c (define x 3) 0 (make-int8 3) ;; 3 2 (define "x") 5 (variable-set) * src/vm_loader.c (link): `link' now errors if the variable is undefined. This corresponds with desired behavior, for both `ref' and `set' operations, for scheme. It's not what elisp wants, though. Perhaps elisp linking needs another instruction. (define): New instruction, the same as calling scm_define(), basically. * module/language/scheme/translate.scm (trans-pair): Don't try to look up an existing variable definition when translating `define'; instead use the special-purpose lookup from ghil.scm's `ghil-define'. * module/system/il/compile.scm (codegen): Compile to a different kind of variable access from `set!', specifically via passing 'define as the op to `make-glil-var'. * module/system/il/ghil.scm (ghil-lookup): Don't add to the module table when compiling variable sets via `set!'. (ghil-define): New procedure, for looking up variables for `define'. * module/system/vm/assemble.scm (<vdefine>): New record: a new instruction type. (codegen): Compile `define' module vars into <vdefine>. (dump-object!): <vdefine> == `define'.
This commit is contained in:
parent
859f639074
commit
cd9d95d760
5 changed files with 41 additions and 26 deletions
|
@ -191,7 +191,8 @@
|
|||
(pmatch tail
|
||||
;; (define NAME VAL)
|
||||
((,name ,val) (guard (symbol? name) (ghil-env-toplevel? e))
|
||||
(make-ghil-define e l (ghil-lookup e name) (trans:x val)))
|
||||
(make-ghil-define e l (ghil-define (ghil-env-parent e) name)
|
||||
(trans:x val)))
|
||||
|
||||
;; (define (NAME FORMALS...) BODY...)
|
||||
(((,name . ,formals) . ,body) (guard (symbol? name))
|
||||
|
|
|
@ -188,7 +188,7 @@
|
|||
|
||||
((<ghil-define> env loc var val)
|
||||
(comp-push val)
|
||||
(push-code! (make-glil-var 'set env var))
|
||||
(push-code! (make-glil-var 'define env var))
|
||||
(return-void!))
|
||||
|
||||
((<ghil-if> env loc test then else)
|
||||
|
|
|
@ -81,7 +81,7 @@
|
|||
<ghil-env> make-ghil-env ghil-env?
|
||||
ghil-env-mod ghil-env-parent ghil-env-table ghil-env-variables
|
||||
|
||||
ghil-primitive-macro? ghil-env-add! ghil-lookup
|
||||
ghil-primitive-macro? ghil-env-add! ghil-lookup ghil-define
|
||||
ghil-env-toplevel?
|
||||
call-with-ghil-environment call-with-ghil-bindings))
|
||||
|
||||
|
@ -192,15 +192,20 @@
|
|||
(record-case e
|
||||
((<ghil-mod> module table imports)
|
||||
(or (assq-ref table sym)
|
||||
(let ((var (make-ghil-var #f sym 'module)))
|
||||
(apush! sym var (ghil-mod-table e))
|
||||
var)))
|
||||
;; a free variable that we have not resolved
|
||||
(make-ghil-var #f sym 'module)))
|
||||
((<ghil-env> mod parent table variables)
|
||||
(let ((found (assq-ref table sym)))
|
||||
(if found
|
||||
(begin (set! (ghil-var-kind found) 'external) found)
|
||||
(loop parent))))))))
|
||||
|
||||
(define (ghil-define mod sym)
|
||||
(or (assq-ref (ghil-mod-table mod) sym)
|
||||
(let ((var (make-ghil-var mod sym 'module)))
|
||||
(apush! sym var (ghil-mod-table mod))
|
||||
var)))
|
||||
|
||||
(define (call-with-ghil-environment e syms func)
|
||||
(let* ((e (make-ghil-env e))
|
||||
(vars (map (lambda (s)
|
||||
|
|
|
@ -44,6 +44,7 @@
|
|||
(define-record (<venv> parent nexts closure?))
|
||||
(define-record (<vmod> id))
|
||||
(define-record (<vlink> module name))
|
||||
(define-record (<vdefine> module name))
|
||||
(define-record (<bytespec> vars bytes meta objs closure?))
|
||||
|
||||
|
||||
|
@ -146,10 +147,16 @@
|
|||
(push-code! `(external-set ,(+ n index)))))))
|
||||
|
||||
((<glil-module> op module name)
|
||||
(push-object! (make-vlink :module #f :name name))
|
||||
(if (eq? op 'ref)
|
||||
(push-code! '(variable-ref))
|
||||
(push-code! '(variable-set))))
|
||||
(case op
|
||||
((ref)
|
||||
(push-object! (make-vlink :module module :name name))
|
||||
(push-code! '(variable-ref)))
|
||||
((set)
|
||||
(push-object! (make-vlink :module module :name name))
|
||||
(push-code! '(variable-set)))
|
||||
((define)
|
||||
(push-object! (make-vdefine :module module :name name))
|
||||
(push-code! '(variable-set)))))
|
||||
|
||||
((<glil-label> label)
|
||||
(set! label-alist (assq-set! label-alist label (current-address))))
|
||||
|
@ -252,6 +259,9 @@
|
|||
((<vlink> module name)
|
||||
;; FIXME: dump module
|
||||
(push-code! `(link ,(symbol->string name))))
|
||||
((<vdefine> module name)
|
||||
;; FIXME: dump module
|
||||
(push-code! `(define ,(symbol->string name))))
|
||||
((<vmod> id)
|
||||
(push-code! `(load-module ,id)))
|
||||
(else
|
||||
|
|
|
@ -187,22 +187,21 @@ VM_DEFINE_LOADER (link, "link")
|
|||
sym = scm_from_locale_symboln ((char *)ip, len);
|
||||
ip += len;
|
||||
|
||||
#if 0
|
||||
*sp = scm_c_env_vcell (*sp, sym, 1);
|
||||
#endif
|
||||
{
|
||||
/* Temporary hack that supports the current module system */
|
||||
SCM mod = scm_current_module ();
|
||||
SCM var = scm_eval_closure_lookup (scm_standard_eval_closure (mod),
|
||||
sym, SCM_BOOL_F);
|
||||
if (SCM_FALSEP (var))
|
||||
/* Create a new variable if not defined yet */
|
||||
var = scm_eval_closure_lookup (scm_standard_eval_closure (mod),
|
||||
sym, SCM_BOOL_T);
|
||||
PUSH (var);
|
||||
/* Was: SCM_VARVCELL (var)); */
|
||||
PUSH (scm_lookup (sym));
|
||||
NEXT;
|
||||
}
|
||||
|
||||
VM_DEFINE_LOADER (define, "define")
|
||||
{
|
||||
SCM sym;
|
||||
size_t len;
|
||||
|
||||
FETCH_LENGTH (len);
|
||||
sym = scm_from_locale_symboln ((char *)ip, len);
|
||||
ip += len;
|
||||
|
||||
PUSH (scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_T));
|
||||
NEXT;
|
||||
}
|
||||
|
||||
/*
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue