1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +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:
Andy Wingo 2008-05-12 00:22:36 +02:00
parent 859f639074
commit cd9d95d760
5 changed files with 41 additions and 26 deletions

View file

@ -191,7 +191,8 @@
(pmatch tail (pmatch tail
;; (define NAME VAL) ;; (define NAME VAL)
((,name ,val) (guard (symbol? name) (ghil-env-toplevel? e)) ((,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...) ;; (define (NAME FORMALS...) BODY...)
(((,name . ,formals) . ,body) (guard (symbol? name)) (((,name . ,formals) . ,body) (guard (symbol? name))

View file

@ -188,7 +188,7 @@
((<ghil-define> env loc var val) ((<ghil-define> env loc var val)
(comp-push val) (comp-push val)
(push-code! (make-glil-var 'set env var)) (push-code! (make-glil-var 'define env var))
(return-void!)) (return-void!))
((<ghil-if> env loc test then else) ((<ghil-if> env loc test then else)

View file

@ -81,7 +81,7 @@
<ghil-env> make-ghil-env ghil-env? <ghil-env> make-ghil-env ghil-env?
ghil-env-mod ghil-env-parent ghil-env-table ghil-env-variables 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? ghil-env-toplevel?
call-with-ghil-environment call-with-ghil-bindings)) call-with-ghil-environment call-with-ghil-bindings))
@ -192,15 +192,20 @@
(record-case e (record-case e
((<ghil-mod> module table imports) ((<ghil-mod> module table imports)
(or (assq-ref table sym) (or (assq-ref table sym)
(let ((var (make-ghil-var #f sym 'module))) ;; a free variable that we have not resolved
(apush! sym var (ghil-mod-table e)) (make-ghil-var #f sym 'module)))
var)))
((<ghil-env> mod parent table variables) ((<ghil-env> mod parent table variables)
(let ((found (assq-ref table sym))) (let ((found (assq-ref table sym)))
(if found (if found
(begin (set! (ghil-var-kind found) 'external) found) (begin (set! (ghil-var-kind found) 'external) found)
(loop parent)))))))) (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) (define (call-with-ghil-environment e syms func)
(let* ((e (make-ghil-env e)) (let* ((e (make-ghil-env e))
(vars (map (lambda (s) (vars (map (lambda (s)

View file

@ -44,6 +44,7 @@
(define-record (<venv> parent nexts closure?)) (define-record (<venv> parent nexts closure?))
(define-record (<vmod> id)) (define-record (<vmod> id))
(define-record (<vlink> module name)) (define-record (<vlink> module name))
(define-record (<vdefine> module name))
(define-record (<bytespec> vars bytes meta objs closure?)) (define-record (<bytespec> vars bytes meta objs closure?))
@ -146,10 +147,16 @@
(push-code! `(external-set ,(+ n index))))))) (push-code! `(external-set ,(+ n index)))))))
((<glil-module> op module name) ((<glil-module> op module name)
(push-object! (make-vlink :module #f :name name)) (case op
(if (eq? op 'ref) ((ref)
(push-code! '(variable-ref)) (push-object! (make-vlink :module module :name name))
(push-code! '(variable-set)))) (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) ((<glil-label> label)
(set! label-alist (assq-set! label-alist label (current-address)))) (set! label-alist (assq-set! label-alist label (current-address))))
@ -252,6 +259,9 @@
((<vlink> module name) ((<vlink> module name)
;; FIXME: dump module ;; FIXME: dump module
(push-code! `(link ,(symbol->string name)))) (push-code! `(link ,(symbol->string name))))
((<vdefine> module name)
;; FIXME: dump module
(push-code! `(define ,(symbol->string name))))
((<vmod> id) ((<vmod> id)
(push-code! `(load-module ,id))) (push-code! `(load-module ,id)))
(else (else

View file

@ -187,22 +187,21 @@ VM_DEFINE_LOADER (link, "link")
sym = scm_from_locale_symboln ((char *)ip, len); sym = scm_from_locale_symboln ((char *)ip, len);
ip += len; ip += len;
#if 0 PUSH (scm_lookup (sym));
*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; 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;
} }
/* /*