map->form: add :case*, fix typo in :set, quote constant symbols.

Fixes #19
frenchy64 · Jan 26, 2013 · 086e95f · 086e95f
1 parent b41c511
commit 086e95f
Show file tree

Hide file tree

Showing 2 changed files with 36 additions and 3 deletions.
diff --git a/src/analyze/core.clj b/src/analyze/core.clj
@@ -650,6 +650,8 @@
           {:Expr-obj expr}))))
 
   ;; case
+  ;; (from Compiler.java)
+  ;;  //(case* expr shift mask default map<minhash, [test then]> table-type test-type skip-check?)
   Compiler$CaseExpr
   (analysis->map
     [expr env]
@@ -663,7 +665,12 @@
          :the-expr the-expr
          :tests tests
          :thens thens
-         :default default}
+         :default default
+         :shift (.shift expr)
+         :mask (.mask expr)
+         :test-type (.testType expr)
+         :switch-type (.switchType expr)
+         :skip-check (.skipCheck expr)}
         (when @CHILDREN
           {:children (concat [the-expr] tests thens [default])})
         (when @JAVA-OBJ

diff --git a/src/analyze/emit_form.clj b/src/analyze/emit_form.clj
@@ -5,7 +5,7 @@
 
 (defmethod map->form :nil [{:keys [val]}] val)
 (defmethod map->form :number [{:keys [val]}] val)
-(defmethod map->form :constant [{:keys [val]}] val)
+(defmethod map->form :constant [{:keys [val]}] (list 'quote val))
 (defmethod map->form :string [{:keys [val]}] val)
 (defmethod map->form :boolean [{:keys [val]}] val)
 (defmethod map->form :keyword [{:keys [val]}] val)
@@ -49,7 +49,7 @@
 (defmethod map->form :empty-expr [{:keys [coll]}] coll)
 (defmethod map->form :vector [{:keys [args]}] (vec (map map->form args)))
 (defmethod map->form :map [{:keys [keyvals]}] (apply hash-map (map map->form keyvals)))
-(defmethod map->form :set [{:keys [keyvals]}] (set (map map->form keyvals)))
+(defmethod map->form :set [{:keys [keys]}] (set (map map->form keys)))
 
 (defmethod map->form :fn-expr
   [{:keys [methods variadic-method]}]
@@ -138,6 +138,25 @@
   (list 'catch (map->form local-binding) 
         (map->form handler)))
 
+;; (from Compiler.java)
+;;  //(case* expr shift mask default map<minhash, [test then]> table-type test-type skip-check?)
+(defmethod map->form :case*
+  [{:keys [the-expr tests thens default shift mask low high switch-type test-type skip-check]}]
+  (list* 'case*
+         (map->form the-expr)
+         shift
+         mask
+         (map->form default)
+         (let [texprs (map map->form tests)]
+           (zipmap texprs
+                   (map vector texprs
+                        (map map->form thens))))
+         switch-type
+         test-type
+         (when skip-check
+           [skip-check])))
+
+
 (comment
   (defmacro frm [f]
     `(-> (ast ~f) map->form))
@@ -191,4 +210,11 @@
   (frm (Integer/toHexString 1))
   (frm (Integer/TYPE))
   (frm #'conj)
+
+  (frm 'a)
+  (frm (let [b 1] 
+         [b 'a 1]))
+
+  (frm #{1 2 3})
+  (frm (case 1 2 3 4))
   )