X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=ecmalisp.lisp;h=d369798eb2198e1ad25749212f90a2f730d59205;hb=954f67d2bd220a9236f89a23b2b87f8678c3530e;hp=5ae918fcfbed9a7df9824e4b0bb98c497f847802;hpb=0f2ea1483ea09443ff9473df9d9bb4b675f4c059;p=jscl.git diff --git a/ecmalisp.lisp b/ecmalisp.lisp index 5ae918f..d369798 100644 --- a/ecmalisp.lisp +++ b/ecmalisp.lisp @@ -27,16 +27,14 @@ (eval-when-compile (%compile-defmacro 'defmacro '(lambda (name args &rest body) - `(progn - (eval-when-compile - (%compile-defmacro ',name - '(lambda ,(mapcar (lambda (x) - (if (eq x '&body) - '&rest - x)) - args) - ,@body))) - ',name)))) + `(eval-when-compile + (%compile-defmacro ',name + '(lambda ,(mapcar (lambda (x) + (if (eq x '&body) + '&rest + x)) + args) + ,@body)))))) (setq nil 'nil) (setq t 't) @@ -750,7 +748,7 @@ (defun binding-name (b) (first b)) (defun binding-type (b) (second b)) -(defun binding-translation (b) (third b)) +(defun binding-value (b) (third b)) (defun binding-declared (b) (and b (fourth b))) (defun mark-binding-as-declared (b) @@ -796,7 +794,7 @@ (concat "v" (integer-to-string (incf *variable-counter*)))) (defun translate-variable (symbol) - (binding-translation (lookup-in-lexenv symbol *environment* 'variable))) + (binding-value (lookup-in-lexenv symbol *environment* 'variable))) (defun extend-local-env (args) (let ((new (copy-lexenv *environment*))) @@ -931,7 +929,7 @@ (define-compilation setq (var val) (let ((b (lookup-in-lexenv var *environment* 'variable))) (if (eq (binding-type b) 'lexical-variable) - (concat (binding-translation b) " = " (ls-compile val)) + (concat (binding-value b) " = " (ls-compile val)) (ls-compile `(set ',var ,val))))) ;;; FFI Variable accessors @@ -1086,7 +1084,7 @@ (js!selfcall "throw ({" "type: 'block', " - "id: " (binding-translation b) ", " + "id: " (binding-value b) ", " "value: " (ls-compile value) ", " "message: 'Return from unknown block " (symbol-name name) ".'" "})") @@ -1145,7 +1143,7 @@ (let ((*environment* (declare-tagbody-tags tbidx body)) initag) (let ((b (lookup-in-lexenv (first body) *environment* 'gotag))) - (setq initag (second (binding-translation b)))) + (setq initag (second (binding-value b)))) (js!selfcall "var tagbody_" tbidx " = " initag ";" *newline* "tbloop:" *newline* @@ -1159,7 +1157,7 @@ (if (not (go-tag-p form)) (indent (ls-compile form) ";" *newline*) (let ((b (lookup-in-lexenv form *environment* 'gotag))) - (concat "case " (second (binding-translation b)) ":" *newline*))))) + (concat "case " (second (binding-value b)) ":" *newline*))))) "default:" *newline* " break tbloop;" *newline* "}" *newline*))) @@ -1182,8 +1180,8 @@ (js!selfcall "throw ({" "type: 'tagbody', " - "id: " (first (binding-translation b)) ", " - "label: " (second (binding-translation b)) ", " + "id: " (first (binding-value b)) ", " + "label: " (second (binding-value b)) ", " "message: 'Attempt to GO to non-existing tag " n "'" "})" *newline*) (error (concat "Unknown tag `" n "'."))))) @@ -1455,7 +1453,7 @@ (defun ls-macroexpand-1 (form) (let ((macro-binding (macro (car form)))) (if macro-binding - (apply (eval (binding-translation macro-binding)) (cdr form)) + (apply (eval (binding-value macro-binding)) (cdr form)) form))) (defun compile-funcall (function args) @@ -1469,7 +1467,7 @@ ((symbolp sexp) (let ((b (lookup-in-lexenv sexp *environment* 'variable))) (if (eq (binding-type b) 'lexical-variable) - (binding-translation b) + (binding-value b) (ls-compile `(symbol-value ',sexp))))) ((integerp sexp) (integer-to-string sexp)) ((stringp sexp) (concat "\"" (escape-string sexp) "\""))