summaryrefslogtreecommitdiff
path: root/src/lisp
diff options
context:
space:
mode:
authorRich Hickey <richhickey@gmail.com>2006-04-29 15:01:58 +0000
committerRich Hickey <richhickey@gmail.com>2006-04-29 15:01:58 +0000
commit8e01cb19d1f2ed95b88c040457a622325dedc158 (patch)
tree7a6fa1d2c2229d44cd41afbb74646ccd3af6b001 /src/lisp
parent5fe51069a1c0f1bdbd61f0e5dcf9021f0a89da25 (diff)
interim checkin
Diffstat (limited to 'src/lisp')
-rw-r--r--src/lisp/clojure.lisp51
-rw-r--r--src/lisp/test.lisp6
2 files changed, 55 insertions, 2 deletions
diff --git a/src/lisp/clojure.lisp b/src/lisp/clojure.lisp
index f5da226f..cf7e0469 100644
--- a/src/lisp/clojure.lisp
+++ b/src/lisp/clojure.lisp
@@ -403,7 +403,8 @@
(:keyword (emit-keyword context expr))
(:global-binding (emit-global-binding context expr))
(:block (emit-block context expr))
- (:invoke (emit-invoke context expr))))))
+ (:invoke (emit-invoke context expr))
+ (:let (emit-let context expr))))))
(defun emit-return (expr)
(format t "return ")
@@ -439,8 +440,50 @@
(format t "~A~:[~;.val~]" (binding-name expr) (needs-box expr))))
(:return (emit-return expr))))
+;;;;;;;;;;;;;;;;;;;;;;;;;; let ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun normalize-let-bindings (binding-list)
+ (mapcar (lambda (b)
+ (if (atom b)
+ (list b nil)
+ b))
+ binding-list))
+
(defun analyze-let (context form)
- )
+ (let ((bindings (normalize-let-bindings (second form)))
+ (body (rest (rest form))))
+ (cond
+ ;special case of (let () expr) ==> expr
+ ((not (or bindings (> (length body) 1)))
+ (analyze context (third form)))
+ ((eql context :expression)
+ (analyze :expression `((|fn*| (,(mapcar #' first bindings) ,@body))
+ ,@(mapcar #'second bindings))))
+ (t (let* ((binding-inits
+ ;init exprs are analyzed prior to adding bindings to env
+ (mapcar (lambda (b)
+ (newobj :binding (newobj :type :binding :symbol (first b))
+ :init (analyze :expression (second b))))
+ bindings))
+ (*var-env* *var-env*))
+ (mapc (lambda (binit)
+ (register-local-binding (@ :binding binit))
+ (add-to-var-env (@ :binding binit)))
+ binding-inits)
+ (newobj :type :let
+ :binding-inits binding-inits
+ :body (analyze-body context body)))))))
+
+(defun emit-let (context expr)
+ (let ((binding-inits (@ :binding-inits expr))
+ (body (@ :body expr)))
+ (dolist (bi binding-inits)
+ (unless (will-be-static-method (@ :binding bi))
+ (emit :expression (@ :binding bi))
+ (format t " = ")
+ (emit :expression (@ :init bi))
+ (format t ";~%")))
+ (emit-body context body)))
(defun analyze-body (context exprs)
(when exprs
@@ -467,6 +510,8 @@
(dolist (e body)
(emit :statement e)))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; block ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
(defun emit-block (context expr)
(when (@ :body expr)
(format t "{~%")
@@ -484,6 +529,8 @@
((:statement :return) (newobj :type :block
:body (analyze-body context (rest form))))))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; defn ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
(defun analyze-defn* (context form)
(assert (eql context :top))
(let* ((*quoted-aggregates* nil)
diff --git a/src/lisp/test.lisp b/src/lisp/test.lisp
index b653e49c..40d45822 100644
--- a/src/lisp/test.lisp
+++ b/src/lisp/test.lisp
@@ -19,4 +19,10 @@
(defn fk (x)
(:foo x))
+(defn fl (a b c)
+ (let ((d b)
+ d))
+ (let ((e c)
+ e)))
+
(defn fr (a b & c) c) \ No newline at end of file