diff options
author | Rich Hickey <richhickey@gmail.com> | 2006-05-05 19:35:42 +0000 |
---|---|---|
committer | Rich Hickey <richhickey@gmail.com> | 2006-05-05 19:35:42 +0000 |
commit | b5867713b47e73335a0ced582741e6cae0769c0e (patch) | |
tree | 86a338f040f62dd8c6cb70cb3b3241c2110487a4 | |
parent | 6758d50fecc5b042a3d880ca9bf0fe17014aec1a (diff) |
added quote, RT.arrayToList
-rw-r--r-- | src/cli/runtime/RT.cs | 8 | ||||
-rw-r--r-- | src/lisp/clojure.lisp | 53 | ||||
-rw-r--r-- | src/lisp/test.lisp | 8 | ||||
-rw-r--r-- | src/org/clojure/runtime/RT.java | 7 |
4 files changed, 70 insertions, 6 deletions
diff --git a/src/cli/runtime/RT.cs b/src/cli/runtime/RT.cs index 11aa7bda..d6b4ee35 100644 --- a/src/cli/runtime/RT.cs +++ b/src/cli/runtime/RT.cs @@ -137,6 +137,14 @@ static public Cons listStar(Object arg1, Object arg2, Object arg3, Object arg4, return cons(arg1, cons(arg2, cons(arg3, cons(arg4, cons(arg5, rest)))));
}
+static public Cons arrayToList(Object[] a)
+ {
+ Cons ret = null;
+ for (int i = a.Length - 1; i >= 0; --i)
+ ret = cons(a[i], ret);
+ return ret;
+ }
+
static public int length(Cons list)
{
int i = 0;
diff --git a/src/lisp/clojure.lisp b/src/lisp/clojure.lisp index 55693909..e193ac63 100644 --- a/src/lisp/clojure.lisp +++ b/src/lisp/clojure.lisp @@ -35,7 +35,7 @@ (defvar *accessors*) (defvar *defvars*) (defvar *defns*) -(defvar *quoted-aggregates*) +(defvar *quoted-aggregates* nil) (defvar *nested-fn-bindings*) (defvar *var-env* nil) (defvar *frame* nil) @@ -376,7 +376,7 @@ (defun analyze-op (context op form) (case op - (|quote| (analyze-quote context form)) + (quote (analyze-quote context form)) (|defn*| (analyze-defn* context form)) (|def| (analyze-def context form)) (|block| (analyze-block context form)) @@ -422,7 +422,8 @@ (:loop (emit-loop context expr)) (:break (emit-break context expr)) (:try (emit-try context expr)) - (:bind(emit-bind context expr)))) + (:bind(emit-bind context expr)) + (:quoted-aggregate (emit-quoted-aggregate context expr)))) (t (emit-other context expr)))) (defun emit-other (context expr) @@ -439,7 +440,19 @@ (case expr (0 (format t "Num.ZERO")) (1 (format t "Num.ONE")) - (t (format t "Num.from(~A)" expr)))))))) + (t (format t "Num.from(~A)" expr)))) + ((symbolp expr) + (cond + ((keywordp expr) + (format t "~A" (keyword-member-name expr))) + ((accessor? expr) + (format t "~A" (accessor-member-name expr))) + (t (format t "~A" (var-member-name expr))))) + ((consp expr) + (format t "RT.arrayToList(new Object[]{~{~A~^, ~}})" + (mapcar (lambda (e) + (emit-to-string (emit :expression e))) + expr))))))) (defun emit-return (expr) (format t "return ") @@ -447,6 +460,33 @@ (format t ";~%")) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; quote ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun analyze-quote (context form) + (let ((q (second form))) + (cond + ((symbolp q) + (cond + ((keywordp q) + (register-keyword-reference q)) + ((host-symbol? q) (error "Can't quote host symbols")) + ((accessor? q) + (register-accessor-reference q)) + (t (register-var-reference q))) + q) + ((atom q) q) + (t + (let* ((ql (newobj :type :quoted-aggregate :symbol (gensym "QA__") :form q))) + (register-quoted-aggregate ql) + ql))))) + +(defun emit-quoted-aggregate (context expr) + (ccase context + (:return (emit-return expr)) + (:expression + (format t "~A" (munge-name (@ :symbol expr)))))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; set ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun analyze-set (context form) @@ -524,7 +564,7 @@ ;optimize macro-generated (if t ...) forms (analyze context (macroexpand (third form))) (let* ((test (analyze :expression (macroexpand (second form)))) - (negate (eql :not (@ :type test)))) + (negate (and (hash-table-p test)(eql :not (@ :type test))))) (newobj :type :if :test (if negate (@ :expr test) test) :comp (if negate "==" "!=") @@ -1266,6 +1306,9 @@ (defun register-var-reference (sym) (pushnew sym *vars*)) +(defun register-quoted-aggregate (qa) + (pushnew qa *quoted-aggregates*)) + (defun register-accessor-reference (sym) (pushnew sym *accessors*)) diff --git a/src/lisp/test.lisp b/src/lisp/test.lisp index e9efc969..d40f4176 100644 --- a/src/lisp/test.lisp +++ b/src/lisp/test.lisp @@ -112,4 +112,10 @@ c) (bind ((x nil) (y b)) - c))
\ No newline at end of file + c)) + +(defn fq (x) + (if ':key '.foo 'a)) + +(defn fql () + '(1 2 3 (4 5)))
\ No newline at end of file diff --git a/src/org/clojure/runtime/RT.java b/src/org/clojure/runtime/RT.java index 75e16afb..b55e89a2 100644 --- a/src/org/clojure/runtime/RT.java +++ b/src/org/clojure/runtime/RT.java @@ -132,6 +132,13 @@ static public Cons listStar(Object arg1, Object arg2, Object arg3, Object arg4, return cons(arg1, cons(arg2, cons(arg3, cons(arg4, cons(arg5, rest))))); } +static public Cons arrayToList(Object[] a){ + Cons ret = null; + for(int i=a.length-1;i>=0;--i) + ret = cons(a[i], ret); + return ret; +} + static public int length(Cons list) { int i = 0; |