From 8fa8f0e596419086911c600b40d286734e5cff19 Mon Sep 17 00:00:00 2001 From: =?utf8?q?David=20V=C3=A1zquez?= Date: Sun, 20 Jan 2013 17:24:54 +0000 Subject: [PATCH] PSETQ and multiple pairs SETQ --- ecmalisp.lisp | 36 +++++++++++++++++++++++++++++++++++- 1 file changed, 35 insertions(+), 1 deletion(-) diff --git a/ecmalisp.lisp b/ecmalisp.lisp index d015254..3771188 100644 --- a/ecmalisp.lisp +++ b/ecmalisp.lisp @@ -277,6 +277,25 @@ (defun reverse (list) (revappend list '())) + (defmacro psetq (&rest pairs) + (let (;; For each pair, we store here a list of the form + ;; (VARIABLE GENSYM VALUE). + (assignments '())) + (while t + (cond + ((null pairs) (return)) + ((null (cdr pairs)) + (error "Odd paris in PSETQ")) + (t + (let ((variable (car pairs)) + (value (cadr pairs))) + (push `(,variable ,(gensym) ,value) assignments) + (setq pairs (cddr pairs)))))) + (setq assignments (reverse assignments)) + ;; + `(let ,(mapcar #'cdr assignments) + (setq ,@(!reduce #'append (mapcar #'butlast assignments) '()))))) + (defun list-length (list) (let ((l 0)) (while (not (null list)) @@ -1150,12 +1169,27 @@ (ls-compile-block body t)) *newline* "})")))) -(define-compilation setq (var val) + +(defun setq-pair (var val) (let ((b (lookup-in-lexenv var *environment* 'variable))) (if (eq (binding-type b) 'lexical-variable) (concat (binding-value b) " = " (ls-compile val)) (ls-compile `(set ',var ,val))))) +(define-compilation setq (&rest pairs) + (let ((result "")) + (while t + (cond + ((null pairs) (return)) + ((null (cdr pairs)) + (error "Odd paris in SETQ")) + (t + (concatf result + (concat (setq-pair (car pairs) (cadr pairs)) + (if (null (cddr pairs)) "" ", "))) + (setq pairs (cddr pairs))))) + (concat "(" result ")"))) + ;;; FFI Variable accessors (define-compilation js-vref (var) var) -- 1.7.10.4