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'.

diff --git a/module/language/scheme/translate.scm b/module/language/scheme/translate.scm
index c5322f1..930b75d 100644 (file)
--- a/module/language/scheme/translate.scm
+++ b/module/language/scheme/translate.scm
@@ -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))

diff --git a/module/system/il/compile.scm b/module/system/il/compile.scm
index 5056ab7..691731b 100644 (file)
--- a/module/system/il/compile.scm
+++ b/module/system/il/compile.scm
@@ -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)

diff --git a/module/system/il/ghil.scm b/module/system/il/ghil.scm
index fe241b3..e2b2bfa 100644 (file)
--- a/module/system/il/ghil.scm
+++ b/module/system/il/ghil.scm
@@ -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)

diff --git a/module/system/vm/assemble.scm b/module/system/vm/assemble.scm
index 9d9a0e8..19e633b 100644 (file)
--- a/module/system/vm/assemble.scm
+++ b/module/system/vm/assemble.scm
@@ -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?))
 
 \f
@@ -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

diff --git a/src/vm_loader.c b/src/vm_loader.c
index 0c61491..f901002 100644 (file)
--- a/src/vm_loader.c
+++ b/src/vm_loader.c
@@ -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)); */
-    NEXT;
-  }
+  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;
 }
 
 /*