summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRich Hickey <richhickey@gmail.com>2006-05-05 19:35:42 +0000
committerRich Hickey <richhickey@gmail.com>2006-05-05 19:35:42 +0000
commitb5867713b47e73335a0ced582741e6cae0769c0e (patch)
tree86a338f040f62dd8c6cb70cb3b3241c2110487a4
parent6758d50fecc5b042a3d880ca9bf0fe17014aec1a (diff)
added quote, RT.arrayToList
-rw-r--r--src/cli/runtime/RT.cs8
-rw-r--r--src/lisp/clojure.lisp53
-rw-r--r--src/lisp/test.lisp8
-rw-r--r--src/org/clojure/runtime/RT.java7
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;