diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/lisp/clojure.lisp | 76 | ||||
-rw-r--r-- | src/lisp/test.lisp | 9 |
2 files changed, 83 insertions, 2 deletions
diff --git a/src/lisp/clojure.lisp b/src/lisp/clojure.lisp index f8148f6c..066f87bd 100644 --- a/src/lisp/clojure.lisp +++ b/src/lisp/clojure.lisp @@ -361,13 +361,87 @@ (:if (emit-if context expr)) (:not (emit-not context expr)) (:or (emit-or context expr)) - (:and (emit-and context expr)))))) + (:and (emit-and context expr)) + (:set (emit-set context expr)))))) (defun emit-return (expr) (format t "return ") (emit :expression expr) (format t ";~%")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; set ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun analyze-set (context form) + ;expecting one of + ;(set local val) => local = val; + ;(set var val) => var.setValue(val); + ;(set (:key x) val) => key.invoke(x,val); + ;(set (.accessor x) val) => accessor.invoke(x, val); + ;(set (global x y z ...) val)) => global.setfn.invoke(val, x, y, z) + (declare (ignore context)) + (let ((val (analyze :expression (macroexpand (third form))))) + (if (atom (second form)) + (let ((target (analyze-symbol :statement (second form)))) + (when (eql (@ :type target) :binding) + (setf (@ :assigned? target) t)) + (newobj :type :set + :target target + :val val)) + (let* ((place (second form)) + (name (analyze-symbol :statement (first place))) + (args (mapcar (lambda (e) + (analyze :expression (macroexpand e))) + (rest place)))) + (ccase (@ :type name) + ((:keyword :accessor :global-binding) + (newobj :type :set + :name name + :args args + :val val))))))) + +(defun emit-set (context expr) + (if (eql context :return) + (emit-return expr) + (progn + (when (member context '(:expression :fn)) + (format t "(")) + (let ((val (@ :val expr)) + (name (@ :name expr))) + (if name ;must be a place + (ccase (@ :type name) + ((:keyword :accessor) + (emit :expression name) + (format t ".invoke(__tld, ") + (emit :expression (first (@ :args expr))) + (format t ", ") + (emit :expression val) + (format t ")")) + (:global-binding + (emit :expression name) + (format t ".setfn.invoke(__tld, ") + (emit :expression val) + (format t "~{, ~A~}" + (mapcar (lambda (e) + (emit-to-string (emit :expression e))) + (@ :args expr))) + (format t ")"))) + (let ((target (@ :target expr))) + (ccase (@ :type target) + (:binding + (emit :expression target) + (format t " = ") + (emit :expression val)) + (:global-binding + (emit :expression target) + (format t ".setValue(__tld, ") + (emit :expression val) + (format t ")")))))) + (when (member context '(:expression :fn)) + (format t ")")) + (when (eql context :statement) + (format t ";~%"))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; if ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun analyze-if (context form) diff --git a/src/lisp/test.lisp b/src/lisp/test.lisp index f17e4ded..e834d0a6 100644 --- a/src/lisp/test.lisp +++ b/src/lisp/test.lisp @@ -64,4 +64,11 @@ (defn fand (x y z) (if (and x y) x - (and x y z)))
\ No newline at end of file + (and x y z))) + +(defn fset (x y z) + (set x a) + (set b y) + (if (set (:foo x) z) + (set (.bar y) z) + (set (foo x y) z)))
\ No newline at end of file |