Commits

ariovistus committed 72c0eb4

* set Formatter to ignore root siblings by default
* visitor is here to stay. it's useful in conjunction with macro
do-when. planning on deprecating Visitor2.
* Also planning on deprecating Type, as it no longer has useful functionality
disjoint from d-type.
* planning on providing full support for cent and ucent types.
* type equality is almost good to go (just need to implement symbol lookup)
* working on constant folding - have most operations for integer types working
* added another matcher - tok-case - operates on token type (int)
* fixed a bug in matcher that prevented symbols from root spec from binding

Comments (0)

Files changed (10)

src/org/d/compiler/ast_utils.clj

     (org.d.generated D2ParserTokenTypes D2Lexer D2Parser))
   (:use (clojure.contrib def macro-utils))
   (:use org.d.compiler.utils)
-  (:use clojure.test))
+  (:use (clojure test set)))
 
 (defmacro parse2 
   "string of d code to ast"
   [a]
   (Formatter/format2 a))
 
-(defn printast [printer ast indent]
-  (let [a (.toString ast)
-        h (.attributes ast)]
-    (.print printer a)
-    (.print printer "{")
-    (let [kv (drop-last (interleave 
-                          (for [k (keys h)]
-                            (let [kstr (print-str k)
-                                  vstr (cond (= k 'type) (format2 (get h k)) 
-                                             true (print-str (get h k)))]
-                              (str kstr "=" vstr))) 
-                          (repeat ", ")))]
-      (last (for [x kv] (.print printer x))))
-    (.println printer "}")))
-
-
-(defn dumpt 
-  "print ast structure"
-  [a]
-  (let [dumper (proxy [Visitor$Dumper] []
-                 (printAST [ast printer indent]
-                           (printast printer ast indent)))]
-    (.visit dumper a)))
-(defn cp [ast] (Visitor/copy ast))
-(defn cpTree [ast] (Visitor/copyTree ast))
-
 (defmacro tok 
   "int value of token"
   [s] 
     nil
     (.. state stack (get n))))
 
-(defnk rewrite! 
-  "replaces ast with the result of rewriter! and performs any 
+(defnk old-rewrite! 
+  "uses org.d.model.Visitor2$State as type of state
+  replaces ast with the result of rewriter! and performs any 
   fixups to state to ensure that the visitor will correctly walk 
   the resulting AST. Assumes that ast is the current node being 
   visited (you probably shouldn't call this from anything other 
   and its siblings, however, it should not modify ast's parents.  "
   [ast state rewriter! :skipsibs? false]
   (let [par (stacknth state 0)
-        nxt (.getNextSibling ast)
+        nxt (getsib ast)
         fch? (or (nil? par) (chN? par ast 0))
         [[prev _] & _] (if fch? nil 
                          (filter #(= (second %) ast) 
     (if (nil? par)
       (set! (. state t0) new_)
       (if (chN? par ast 0)
-        (.setFirstChild par new_)
+        (setch! par new_)
         (let [[[prev _] & rst] (filter #(= (second %) ast) 
                                        (partition 2 1 (children par)))]
-          (.setNextSibling prev new_))))
+          (setsib! prev new_))))
     (let [laxt (last (ast&siblings new_))]
-    (.setNextSibling laxt nxt)
+    (setsib! laxt nxt)
     (set! (. state t) (if skipsibs? laxt new_)))))
+(defnk new-rewrite! 
+  "uses org.d.compiler.visitor.State as type of state
+  returns new state
+  replaces ast with the result of rewriter! and performs any 
+  fixups to state to ensure that the visitor will correctly walk 
+  the resulting AST. Assumes that ast is the current node being 
+  visited (you probably shouldn't call this from anything other 
+  than onVisit)
+  rewriter! is called like (rewriter! ast state),
+  and rewriter! may totally destroy ast, its subtree,
+  and its siblings, however, it should not modify ast's parents.  "
+  [ast state rewriter! :skipsibs? false]
+  (let [par (first (:stack state))
+        nxt (getsib ast)
+        fch? (or (nil? par) (chN? par ast 0))
+        [[prev _] & _] (if fch? nil 
+                         (filter #(= (second %) ast) 
+                                 (partition 2 1 (children par))))
+        new_ (rewriter! ast state)
+        state1 (if (nil? par) (assoc state :ast-root new_) state)]
+    (when (not (nil? par))
+      (if (chN? par ast 0)
+        (setch! par new_)
+        (let [[[prev _] & rst] (filter #(= (second %) ast) 
+                                       (partition 2 1 (children par)))]
+          (setsib! prev new_))))
+    (let [laxt (last (ast&siblings new_))]
+      (setsib! laxt nxt)
+      (assoc state1 :ast (if skipsibs? laxt new_)))))
 
 ;;;; The ATTRIBUTE MANIPULATORS ;;;;
 
   meant to bind values to the symbols per a terminal specification"
   [sym tok] 
   (if (symbol? tok) ()
-    (let [type-syms (if (contains? tok 'type/?->) 
+    (let [type-syms (if (contains? tok 'type/?->)
                       (let [tsym (get tok 'type/?->)]
                         `(~tsym (cond ~(cond2 sym tok) nil 
                                       (attr? ~sym ~'type) (attr ~sym ~'type) 
                                       true nil)
                             ~(symbol (str tsym "?")) 
                             (cond ~(cond2 sym tok) false 
-                                  (attr? ~sym 'type) true
-                                  true false))
-                        ()))]
-
+                                  (attr? ~sym ~'type) true
+                                  true false)))
+                      ())]
       (when (and (map? tok) (or (contains? tok 'ast/?->) 
                                 (contains? tok 'ast?->))) 
         (assert (not (contains? tok 't))))
        (let [~astsym ~ast ~@lets] ~on-match)))
     (loop [sched (visit-schedule spec) code on-match last nil]
       (if (empty? sched) 
-        (let [[[spec1 sym1] [spec2 sym2] n] last]
-          `(let [~sym1 ~ast] (if ~(cond1 sym1 spec1) ~on-nomatch (do ~code))))
+        (let [[[spec1 sym1] [spec2 sym2] n] last
+              lets (syms sym1 spec1)]
+          `(let [~sym1 ~ast ~@lets ] (if ~(cond1 sym1 spec1) ~on-nomatch (do ~code))))
         (let [[[spec1 sym1] [spec2 sym2] n] (first sched)
               meth (if (= n 1) 'getFirstChild 'getNextSibling)
               exp1 `(. ~sym1 ~meth)
               expr (if (not (spec-optional? spec1)) exp1
                      `(if ~(cond2 sym1 spec1) ~sym1 ~exp1))
-              lets (syms sym2 spec2) 
+              lets (syms sym2 spec2)
               condi (cond1 sym2 spec2) ]
           (recur (rest sched) 
                  `(let [~sym2 ~expr]
   (or (symbol? x) (and (map? x) 
                        (not (insert-spec? x))))) 
 
+(defmacro tok-case [exp & rst]
+  (let [pairs (partition 2 rst)
+        symexp (gensym)
+        deflt? (odd? (count rst))
+        deflt (when deflt? (last rst)) ]
+    (loop [toks #{} p pairs cases () prec ()]
+      (if (empty? p) 
+        (do
+        `(let [~@prec ~symexp ~exp] 
+           (case (cond (= (type ~symexp) org.d.model.MyAST) (.getType ~symexp) 
+                       (symbol? ~symexp) (eval (list 'tok ~symexp))
+                       true ~symexp)
+             ~@(concat cases (when deflt? (list deflt))))))
+        (let [[c v] (first p)]
+          (cond 
+            (and (symbol? c) (contains? toks c)) (assert false)
+            (symbol? c)
+            (recur (conj toks c) (rest p) 
+                   (conz (eval `(tok ~c)) v cases) prec)
+            true
+            (let [cs (seq c)
+                  sym (gensym)]
+              (cond (zero? (count cs)) (recur toks p cases prec)
+                    (any #(contains? toks %) cs) (assert false)
+                    (= 1 (count cs)) (recur (conj toks (first cs))
+                                            (rest p)
+                                            (conz (eval `(tok ~(first cs)))
+                                                  v cases)
+                                            prec)
+                    true (recur (union toks cs)
+                                (rest p)
+                                (concat (interleave 
+                                          (map #(eval `(tok ~%)) cs)
+                                          (repeat sym))
+                                        cases)
+                                (conz sym v prec))))))))))
+
 (defn tokstr [token]
-  (condp #(if (set? %1) (contains? %1 %2) (= %1 %2)) token
-    #{'Bool 'Byte 'Ubyte 'Short 'Ushort 'Int 
-      'Uint 'Long 'Ulong 'Char 'Wchar 'Dchar
-      'Float 'Double 'Real 'Ifloat 'Idouble 'Ireal
-      'Cfloat 'Cdouble 'Creal 'Void 'True 'False 
-      'Null 'This 'Super 'Template 'Class 'Interface
-      'FUNCTION 'Function 'DELEGATE 'Delegate
-      'Auto 'Alias 'Typedef } 
+  (tok-case 
+    token
+    (Bool Byte Ubyte Short Ushort Int 
+          Uint Long Ulong Char Wchar Dchar
+          Float Double Real Ifloat Idouble Ireal
+          Cfloat Cdouble Creal Void True False 
+          Null This Super Template Class Interface
+          FUNCTION Function DELEGATE Delegate
+          Auto Alias Typedef Cast) 
     (. (str token) toLowerCase)
-    'Dot "."
-    'Assign "="
-    'Add_assign "+="
-    'Minus_assign "-="
-    'POINTER "*"
-    'Mul "*"
-    'Add "+"
-    'Plusplus "++"
-    'Minus "-"
-    'Minusminus "--"
+    Dot "."
+    Assign "="
+    Add_assign "+="
+    Minus_assign "-="
+    POINTER "*"
+    Mul "*"
+    Add "+"
+    Plusplus "++"
+    Minus "-"
+    Minusminus "--"
     (str token)))
 
 (defn init-ast [[spec sym]]

src/org/d/compiler/constfold.clj

   "
   (:import (java.io BufferedWriter OutputStreamWriter ByteArrayOutputStream)
            (java.util Arrays))
-  (:use (org.d.compiler ast-utils d-type type-deduce utils)
-        (clojure.contrib math)
+  (:use (org.d.compiler ast-utils d-type type-deduce utils visitor d-type)
+        (clojure.contrib math macro-utils)
         (clojure test))
 
   )
   (if (nil? v) nil
     (bigint (if (= (type v) Boolean) (if v 1 0) v))))
 
+(defn intv2ast [value tipo state]
+  (assert tipo)
+  (assert (int-t? tipo state))
+  (assert (<= (dt-min tipo) value (dt-max tipo)))
+
+  (letfn [(atr!! [ast] 
+                 (attr! ast 'type tipo) 
+                 (attr! ast 'value value) 
+                 (attr! ast 'int-max value)
+                 (attr! ast 'int-min value)
+                 ast)]
+    (cond
+      (=t= tipo ULONG) 
+      (atr!! (make-ast! ({t IntegerLiteral s (str value "UL")})))
+      (=t= tipo LONG) 
+      (if (< value 0)
+        (atr!! (make-ast! (Minus {t IntegerLiteral s (str (- value) "L")})))
+        (atr!! (make-ast! ({t IntegerLiteral s (str value "L")}))))
+      (=t= tipo UINT) 
+      (atr!! (make-ast! ({t IntegerLiteral s (str value "U")})))
+      (=t= tipo INT) 
+      (if (< value 0)
+        (atr!! (make-ast! (Minus {t IntegerLiteral s (str (- value))})))
+        (atr!! (make-ast! ({t IntegerLiteral s (str value)}))))
+      (signed? tipo)
+      (if (< value 0)
+        (atr!! (make-ast! (Cast {ast (copy tipo)} 
+                                (Minus {t IntegerLiteral s (str (- value))}))))
+        (atr!! (make-ast! (Cast {ast (copy tipo)} 
+                                (Minus {t IntegerLiteral s (str value)})))))
+      true
+      (atr!! (make-ast! (Cast {ast (copy tipo)} 
+                              (Minus {t IntegerLiteral s (str value)})))))))
+
 (defn str-lit-v [ast state]
   (let [s (.getText ast)
         [e1,tipo] (case (last s)
               (False) false
               (error! ast "why the honk are we thinking this is boolean literal?")))
 
+(defn int-cast-v [from to value state]
+  (cond (<= (dt-min to) value (dt-max to)) value
+        (<= (sizeof to) (sizeof from))
+        (let [mask (- (pow 2 (* 8 (sizeof to))) 1)
+              nv1 (bit-and mask value)]
+          (cond (and (signed? to) (> nv1 (dt-max to))) 
+                (- nv1 (pow 2 (* 8 (sizeof to))))
+                (and (signed? to) (< nv1 (dt-min to))) 
+                (assert false) ; not sure if this will happen..
+                (> nv1 (dt-max to)) (assert false) ; this shouldn't happen..
+                (< nv1 (dt-min to)) (assert false) ; nor this..
+                true nv1)) 
+        true
+        (do
+          (assert (> (sizeof to) (sizeof from)))
+          (assert (and (signed? from) (not (signed? to))))
+          (assert (> 0 value))
+          (let [fmask (- (pow 2 (* 8 (sizeof from))) 1)
+                tmask (- (pow 2 (* 8 (sizeof to))) 1)]
+            (bit-and tmask (bit-or (- tmask fmask) value))))))
+
 (defmacro int-arith-2 
   "simulate fixed width integer binary operator arithmetic
   using arbitrary precision integers.
   complete with overflow. yay!"
   [op lhv rhv lht rht rt ast state]
-  `(let [lhv2# (to-int ~lhv)
-         rhv2# (to-int ~rhv)]
-     (assert (<= (dt-min ~lht) lhv2# (dt-max ~lht)))
-     (assert (<= (dt-min ~rht) rhv2# (dt-max ~rht)))
+  `(let [lhv1# (to-int ~lhv)
+         rhv1# (to-int ~rhv)
+         lhv2# (if (not (=t= ~lht ~rt)) (int-cast-v ~lht ~rt lhv1# ~state) lhv1#)
+         rhv2# (if (not (=t= ~rht ~rt)) (int-cast-v ~rht ~rt rhv1# ~state) rhv1#)
+         ]
+     (assert (<= (dt-min ~rt) lhv2# (dt-max ~rt)))
+     (assert (<= (dt-min ~rt) rhv2# (dt-max ~rt)))
      (let [ rv0# (~op lhv2# rhv2#)
            rN# (pow 2 (* 8 (sizeof ~rt ~ast ~state)))
            rv1# (mod rv0# rN#)
   (let [[lht rht rt] (map #(attr % 'type) [lhs rhs ast])
         [lhv rhv] (map #(attr % 'value) [lhs rhs])]
     (assert (all #(not (nil? %)) [lht rht rt lhv rhv]))
-    (cond (and (or (int-t? lht) (char-t? lht) (=t= lht BOOL))
-               (or (int-t? rht) (char-t? rht) (=t= rht BOOL)))
+    (cond (and (or (int-t? lht state) (char-t? lht) (=t= lht BOOL))
+               (or (int-t? rht state) (char-t? rht) (=t= rht BOOL)))
           (do (int-arith +)))))
 
 (defn add-v-range [ast lhs rhs state]
         [lmin rmin] (map #(to-int (attr % 'min)) [lhs rhs])
         [lmax rmax] (map #(to-int (attr % 'max)) [lhs rhs])]
     (assert (all #(not (nil? %)) [lht rht rt lmin rmin lmax rmax]))
-    (assert (all #(or (int-t? %) (char-t? %) (=t= BOOL)) [lht rht rt]))
+    (assert (all #(or (int-t? % state) (char-t? %) (=t= BOOL)) [lht rht rt]))
     (assert (and (<= lmin lmax) (<= rmin rmax)))
     (let [amin (+ lmin rmin)
           amax (+ lmax rmax)]
   (let [[lht rht rt] (map #(attr % 'type) [lhs rhs ast])
         [lhv rhv] (map #(attr % 'value) [lhs rhs])]
     (assert (all #(not (nil? %)) [lht rht rt lhv rhv]))
-    (cond (and (or (int-t? lht) (char-t? lht) (=t= lht BOOL))
-               (or (int-t? rht) (char-t? rht) (=t= rht BOOL)))
+    (cond (and (or (int-t? lht state) (char-t? lht) (=t= lht BOOL))
+               (or (int-t? rht state) (char-t? rht) (=t= rht BOOL)))
           (do (int-arith -)))))
 
 (defn minus-v-range [ast lhs rhs state]
         [lmin rmin] (map #(to-int (attr % 'min)) [lhs rhs])
         [lmax rmax] (map #(to-int (attr % 'max)) [lhs rhs])]
     (assert (all #(not (nil? %)) [lht rht rt lmin rmin lmax rmax]))
-    (assert (all #(or (int-t? %) (char-t? %) (=t= BOOL)) [lht rht rt]))
+    (assert (all #(or (int-t? % state) (char-t? %) (=t= BOOL)) [lht rht rt]))
     (assert (and (<= lmin lmax) (<= rmin rmax)))
     (let [amin (- lmin rmax)
           amax (+ lmax rmax)]
   (let [[lht rht rt] (map #(attr % 'type) [lhs rhs ast])
         [lhv rhv] (map #(attr % 'value) [lhs rhs])]
     (assert (all #(not (nil? %)) [lht rht rt lhv rhv]))
-    (cond (and (or (int-t? lht) (char-t? lht) (=t= lht BOOL))
-               (or (int-t? rht) (char-t? rht) (=t= rht BOOL)))
+    (cond (and (or (int-t? lht state) (char-t? lht) (=t= lht BOOL))
+               (or (int-t? rht state) (char-t? rht) (=t= rht BOOL)))
           (do (int-arith *)))))
 
 ; todo: prove correctness
         [lmin rmin] (map #(to-int (attr % 'min)) [lhs rhs])
         [lmax rmax] (map #(to-int (attr % 'max)) [lhs rhs])]
     (assert (all #(not (nil? %)) [lht rht rt lmin rmin lmax rmax]))
-    (assert (all #(or (int-t? %) (char-t? %) (=t= BOOL)) [lht rht rt]))
+    (assert (all #(or (int-t? % state) (char-t? %) (=t= BOOL)) [lht rht rt]))
     (assert (and (<= lmin lmax) (<= rmin rmax)))
     (let [[amin _ _ amax] (sort (for [l [lmin lmax] r [rmin rmax]] (* l r)))]
         [amin amax])))
   (let [[lht rht rt] (map #(attr % 'type) [lhs rhs ast])
         [lhv rhv] (map #(attr % 'value) [lhs rhs])]
     (assert (all #(not (nil? %)) [lht rht rt lhv rhv]))
-    (cond (and (or (int-t? lht) (char-t? lht) (=t= lht BOOL))
-               (or (int-t? rht) (char-t? rht) (=t= rht BOOL)))
+    (cond (and (or (int-t? lht state) (char-t? lht) (=t= lht BOOL))
+               (or (int-t? rht state) (char-t? rht) (=t= rht BOOL)))
           (do (int-arith quot)))))
 
 ; todo: prove correctness
         [lmin rmin] (map #(to-int (attr % 'min)) [lhs rhs])
         [lmax rmax] (map #(to-int (attr % 'max)) [lhs rhs])]
     (assert (all #(not (nil? %)) [lht rht rt lmin rmin lmax rmax]))
-    (assert (all #(or (int-t? %) (char-t? %) (=t= BOOL)) [lht rht rt]))
+    (assert (all #(or (int-t? % state) (char-t? %) (=t= BOOL)) [lht rht rt]))
     (assert (and (<= lmin lmax) (<= rmin rmax)))
     (if (= rmin rmax 0)
       (error! ast "division by zero")
   (let [[lht rht rt] (map #(attr % 'type) [lhs rhs ast])
         [lhv rhv] (map #(attr % 'value) [lhs rhs])]
     (assert (all #(not (nil? %)) [lht rht rt lhv rhv]))
-    (cond (and (or (int-t? lht) (char-t? lht) (=t= lht BOOL))
-               (or (int-t? rht) (char-t? rht) (=t= rht BOOL)))
+    (cond (and (or (int-t? lht state) (char-t? lht) (=t= lht BOOL))
+               (or (int-t? rht state) (char-t? rht) (=t= rht BOOL)))
           (do (int-arith rem)))))
 
 (defn modmax 
         [lmin rmin] (map #(to-int (attr % 'min)) [lhs rhs])
         [lmax rmax] (map #(to-int (attr % 'max)) [lhs rhs])]
     (assert (all #(not (nil? %)) [lht rht rt lmin rmin lmax rmax]))
-    (assert (all #(or (int-t? %) (char-t? %) (=t= BOOL)) [lht rht rt]))
+    (assert (all #(or (int-t? % state) (char-t? %) (=t= BOOL)) [lht rht rt]))
     (assert (and (<= lmin lmax) (<= rmin rmax)))
     (cond (= 0 rmin rmax) (error! "division by zero")
           ; if lhs subrange of rhs, should be able to calculate exactly
   (let [[lht rht rt] (map #(attr % 'type) [lhs rhs ast])
         [lhv rhv] (map #(attr % 'value) [lhs rhs])]
     (assert (all #(not (nil? %)) [lht rht rt lhv rhv]))
-    (cond (and (int-t? lht) 
-               (int-t? rht))
+    (cond (and (int-t? lht state) 
+               (int-t? rht state))
           (if (< rhv 0)
             (error! ast "negative integer power")
             (do (int-arith expt))))))
         [lmin rmin] (map #(to-int (attr % 'min)) [lhs rhs])
         [lmax rmax] (map #(to-int (attr % 'max)) [lhs rhs])]
     (assert (all #(not (nil? %)) [lht rht rt lmin rmin lmax rmax]))
-    (assert (all #(int-t? %) [lht rht rt]))
+    (assert (all #(int-t? % state) [lht rht rt]))
     (assert (and (<= lmin lmax) (<= rmin rmax)))
     (if (< rmin 0) (error! ast "integer negative power")
       (let [[amin amax] (powminmax lmin lmax rmin rmax)]
   (let [[rht rt] (map #(attr % 'type) [rhs ast])
         [rhv] (map #(attr % 'value) [rhs])]
     (assert (all #(not (nil? %)) [rht rt rhv]))
-    (cond (int-t? rht)
+    (cond (int-t? rht state)
           (do (int-arith1 -)))))
 
 (defn negative-v-range [ast rhs state]
         [rmin] (map #(to-int (attr % 'min)) [rhs])
         [rmax] (map #(to-int (attr % 'max)) [rhs])]
     (assert (all #(not (nil? %)) [rht rt rmin rmax]))
-    (assert (all #(or (int-t? %) (char-t? %)) [rht rt]))
+    (assert (all #(or (int-t? % state) (char-t? %)) [rht rt]))
     (assert (<= rmin rmax))
     [(- rmax) (- rmin)]))
 
   (let [[lht rht rt] (map #(attr % 'type) [lhs rhs ast])
         [lhv rhv] (map #(attr % 'value) [lhs rhs])]
     (assert (all #(not (nil? %)) [lht rht rt lhv rhv]))
-    (cond (and (int-t? lht) 
-               (int-t? rht))
-          (if (< rhv 0)
-            (error! ast "negative integer power")
-            (do (int-arith bit-or))))))
+    (cond (and (int-t? lht state) 
+               (int-t? rht state))
+            (do (int-arith bit-or)))))
+
+(defn and-bitwise-v [ast lhs rhs state]
+  (let [[lht rht rt] (map #(attr % 'type) [lhs rhs ast])
+        [lhv rhv] (map #(attr % 'value) [lhs rhs])]
+    (assert (all #(not (nil? %)) [lht rht rt lhv rhv]))
+    (cond (and (int-t? lht state) 
+               (int-t? rht state))
+            (do (int-arith bit-and)))))
+
+(defn xor-bitwise-v [ast lhs rhs state]
+  (let [[lht rht rt] (map #(attr % 'type) [lhs rhs ast])
+        [lhv rhv] (map #(attr % 'value) [lhs rhs])]
+    (assert (all #(not (nil? %)) [lht rht rt lhv rhv]))
+    (cond (and (int-t? lht state) 
+               (int-t? rht state))
+            (do (int-arith bit-xor)))))
 
 (defn hbmask [xx t]
   (let [x (bigint xx)
                           (xor-min-u amin amax bmin bmax UINT)))))
          )
 
+(defn lshift-v [ast lhs rhs state]
+  (let [[lht rht rt] (map #(attr % 'type) [lhs rhs ast])
+        [lhv rhv] (map #(attr % 'value) [lhs rhs])]
+    (assert (all #(not (nil? %)) [lht rht rt lhv rhv]))
+    (cond (and (int-t? lht state) 
+               (int-t? rht state))
+            (do (int-arith bit-shift-left)))))
+
+(defn rshift-v [ast lhs rhs state]
+  (let [[lht rht rt] (map #(attr % 'type) [lhs rhs ast])
+        [lhv rhv] (map #(attr % 'value) [lhs rhs])]
+    (assert (all #(not (nil? %)) [lht rht rt lhv rhv]))
+    (cond (and (int-t? lht state) 
+               (int-t? rht state))
+            (do (int-arith bit-shift-right)))))
+
+(defn urshift-v [ast lhs rhs state]
+  (let [[lht1 rht rt] (map #(attr % 'type) [lhs rhs ast])
+        lht (if (int-t? lht1 state) (integer-by (sizeof rt) false) lht1)
+        [lhv1 rhv] (map #(attr % 'value) [lhs rhs])
+        lhv (if (int-t? lht1 state) 
+              (int-cast-v lht1 lht lhv1 state) 
+              lhv1)]
+    (assert (all #(not (nil? %)) [lht rht rt lhv rhv]))
+    (cond (and (int-t? lht state) 
+               (int-t? rht state))
+          ; need to trick int-arith to treat lhs as an unsigned value
+          (let [v1 (int-arith-2 bit-shift-right lhv rhv lht rht lht ast state)]
+            (int-cast-v lht rt v1 state)))))
+
+(defn lt-v [ast lhs rhs state]
+  (let [[lht rht rt] (map #(attr % 'type) [lhs rhs ast])
+        [lhv rhv] (map #(attr % 'value) [lhs rhs])]
+    (assert (all #(not (nil? %)) [lht rht rt lhv rhv]))
+    (cond (and (int-t? lht state) 
+               (int-t? rht state))
+            (do (< lhv rhv)))))
+
+(defn le-v [ast lhs rhs state]
+  (let [[lht rht rt] (map #(attr % 'type) [lhs rhs ast])
+        [lhv rhv] (map #(attr % 'value) [lhs rhs])]
+    (assert (all #(not (nil? %)) [lht rht rt lhv rhv]))
+    (cond (and (int-t? lht state) 
+               (int-t? rht state))
+            (do (<= lhv rhv)))))
+
+(defn gt-v [ast lhs rhs state]
+  (let [[lht rht rt] (map #(attr % 'type) [lhs rhs ast])
+        [lhv rhv] (map #(attr % 'value) [lhs rhs])]
+    (assert (all #(not (nil? %)) [lht rht rt lhv rhv]))
+    (cond (and (int-t? lht state) 
+               (int-t? rht state))
+            (do (> lhv rhv)))))
+
+(defn ge-v [ast lhs rhs state]
+  (let [[lht rht rt] (map #(attr % 'type) [lhs rhs ast])
+        [lhv rhv] (map #(attr % 'value) [lhs rhs])]
+    (assert (all #(not (nil? %)) [lht rht rt lhv rhv]))
+    (cond (and (int-t? lht state) 
+               (int-t? rht state))
+            (do (>= lhv rhv)))))
+
+(defn and-v [ast lhs rhs state]
+  (let [[lht rht rt] (map #(attr % 'type) [lhs rhs ast])
+        [lhv rhv] (map #(let [v (attr % 'value)
+                              t (attr % 'type)]
+                          (cond (=t= BOOL t) v
+                                (or (char-t? t) (int-t? t state)) (not (zero? v))
+                                true (assert false))) [lhs rhs])]
+    (assert (all #(not (nil? %)) [lht rht rt lhv rhv]))
+    (do (and lhv rhv))))
+
+(defn or-v [ast lhs rhs state]
+  (let [[lht rht rt] (map #(attr % 'type) [lhs rhs ast])
+        [lhv rhv] (map #(let [v (attr % 'value)
+                              t (attr % 'type)]
+                          (cond (=t= BOOL t) v
+                                (or (char-t? t) (int-t? t state)) (not (zero? v))
+                                true (assert false))) [lhs rhs])]
+    (assert (all #(not (nil? %)) [lht rht rt lhv rhv]))
+            (do (or lhv rhv))))
+
+(defn not-v [ast rhs state]
+  (let [[rht rt] (map #(attr % 'type) [rhs ast])
+        [rhv] (map #(let [v (attr % 'value)
+                              t (attr % 'type)]
+                          (cond (=t= BOOL t) v
+                                (or (char-t? t) (int-t? t state)) (not (zero? v))
+                                true (assert false))) [rhs])]
+    (assert (all #(not (nil? %)) [rht rt rhv]))
+            (do (not rhv))))
+
+(defn literal? 
+  "is ast a literal?"
+  [ast state]
+  (match-case ast 
+              (IntegerLiteral) true
+              (FloatLiteral) true
+              (CharacterLiteral) true
+              (StringLiteral) true
+              (True)  true
+              (False) true 
+              (Null) true
+              ({t Cast type/?-> t} {} IntegerLiteral)
+              (and t? (< (sizeof t ast state) 4))
+              ({t Minus nch 1} FloatLiteral) true
+              ({t Minus nch 1 type/?-> t} IntegerLiteral) 
+              (and t? (signed? t))
+              false))
+
+(defn rewrite-value? [ast state]
+  (if (or (not (attr? ast 'value))
+          (not (attr? ast 'type)))
+    false
+    (match-case ast 
+                ({t Cast type/?-> t1} {} {type/?-> t2})
+                (and t1? t2? (=t= t1 t2) )
+                (not (literal? ast state)))))
+
+(defn rewrite-value! [ast state]
+  (assert (attr? ast 'type))
+  (assert (attr? ast 'value))
+  (assert (not (literal? ast state)))
+  (cond 
+    (and (matches? ast (Cast))
+         (match-case ast (Cast {} {type true type/?-> t}) t?)
+         (=t= (attr ast 'type) (match-case ast (Cast {} {type true type/?-> t}) t)))
+    (match-case ast (Cast {} {ast-> e}) e)
+    (int-t? (attr ast 'type) state)
+    (intv2ast (attr ast 'value) (attr ast 'type) state)
+    (=t= (attr ast 'type) BOOL)
+    (if (attr ast 'value) (make-ast! (True)) (make-ast! (False)))
+    true (assert false)))
+
+(defn constfold 
+  "computes and adds value attribute to ast"
+  [ast state]
+  (when (and (exp? ast) (attr? ast 'type) (not (attr? ast 'value)))
+    (match-case ast ({nch 2} {ast-> lhs} {ast-> rhs})
+                (when (and (attr? rhs 'type) (attr? lhs 'type) 
+                           (attr? lhs 'value) (attr? rhs 'value))
+                  (let [op (tok-case ast 
+                                     Add add-v 
+                                     Minus minus-v
+                                     Mul mul-v
+                                     Mod mod-v
+                                     Div div-v
+                                     Power pow-v
+                                     Or_bitwise or-bitwise-v 
+                                     And_bitwise and-bitwise-v 
+                                     Xor xor-bitwise-v
+                                     Lshift lshift-v
+                                     Rshift rshift-v
+                                     Urshift urshift-v
+                                     And and-v
+                                     Or or-v
+                                     Lt lt-v
+                                     Gt gt-v
+                                     Le le-v
+                                     Ge ge-v
+                                     nil)]
+                    (if (nil? op) nil
+                      (let [v (op ast lhs rhs state)]
+                        (attr! ast 'value v)))))
+                ({nch 1} {ast-> rhs})
+                (when (and (attr? rhs 'type) (attr? rhs 'value))
+                  (let [op (tok-case ast
+                                     Minus negative-v
+                                     Not not-v
+                                     nil )]
+                    (if (nil? op) nil
+                      (let [v (op ast rhs state)]
+                        (attr! ast 'value v)))))
+                nil)))
+
+
+

src/org/d/compiler/d_type.clj

   absolutely referenced
   "
   (:import 
-    (org.d.model Type MyAST Visitor2 Visitor2$State)
+    (org.d.model MyAST Visitor2 Visitor2$State)
     )
   (:use clojure.test)
   (:use 
-    (org.d.compiler utils ast-utils)))
+    (org.d.compiler utils ast-utils visitor)))
 
 (def *ptr_size* 4)
 (def *size_t_size* 4)
 (def *real_size* 8)
 (def *creal_size* 24)
 
+(defn t-ok! [ast]
+  (attr! ast 't-ok true)
+  ast)
+
 (defn obj-alias [s]
-  (make-ast! (BASIC_TYPE (ID_LIST 
+  (t-ok! (make-ast! (BASIC_TYPE (ID_LIST 
                            {t Identifier s "object"} 
-                           {t Identifier s s}))))
+                           {t Identifier s s})))))
+    
 (defmacro mk-basic-t [t]
-  `(make-ast! ~(list 'BASIC_TYPE t)))
+  `(t-ok! (make-ast! ~(list 'BASIC_TYPE t))))
 
 (def BOOL (mk-basic-t Bool))
 (def BYTE (mk-basic-t Byte))
 (def UINT (mk-basic-t Uint))
 (def LONG (mk-basic-t Long))
 (def ULONG (mk-basic-t Ulong))
+(def CENT (mk-basic-t Cent))
+(def UCENT (mk-basic-t Ucent))
 (def CHAR (mk-basic-t Char))
 (def WCHAR (mk-basic-t Wchar))
 (def DCHAR (mk-basic-t Dchar))
 (def EQUAL_T (obj-alias "equals_t"))
 (def HASH_T (obj-alias "hash_t"))
 
+(defn tcopy [ast]
+  (assert (attr? ast 't-ok))
+  (copy ast :copy-ast 
+        (fn [a] 
+          (let [na (ast-copier a)] 
+            (when (attr? a 't-ok) 
+              (attr! na 't-ok true)) 
+            na))))
+
 (defn make-aarray-t [keyt valt]
-  (make-ast! (AARRAY_DECL {ast (cpTree valt)} {ast (cpTree keyt)})))
+  (t-ok! (make-ast! (AARRAY_DECL {ast (tcopy valt)} {ast (tcopy keyt)}))))
 
 (defn make-darray-t [elt]
-  (make-ast! (DARRAY_DECL {ast elt})))
+  (t-ok! (make-ast! (DARRAY_DECL {ast (tcopy elt)}))))
 
 (defn make-tuple-t [& elts]
-  (let [elts2 (map #(cpTree %) elts)
+  (let [elts2 (map #(tcopy %) elts)
         _ (last (map (fn [[a b]] (.setNextSibling a b)) (partition 2 1 elts2)))
         tupl (make-ast! (TUPLE {ast (first elts2)}))]
-    tupl))
+    (t-ok! tupl)))
+
+(defn make-ptr-t [elt]
+  (t-ok! (make-ast! (POINTER {ast (tcopy elt)}))))
+
+
+(defn type? [ast]
+  (tok-case 
+    ast
+    (POINTER DARRAY_DECL SARRAY_DECL AARRAY_DECL
+             DELEGATE FUNCTION PARAM_SPEC TUPLE TYPE_MOD
+             SLICE_TYPE BASIC_TYPE) true 
+    false))
 
 (defn t-ok? 
   "this is a specification for everything (I hope..) required of a 
                          (PARAM_SPEC {ast-> t1 attr? t-ok} 
                                      {t PARAMETERS ast-> p}
                                      {t? POSTFIX ast/?-> pf})
+                         (all #(matches-any?  % 
+                                             (PARAMETER 
+                                               {t? PARAM_MODIFIER}
+                                               {attr? t-ok}) 
+                                             (PARAMETER Vararg))
+                                   (children p))
                          (TUPLE {ast-> t1})
-                         (all #(attr? % t-ok) (ast&siblings t1))
+                         (all #(attr? % 't-ok) (ast&siblings t1))
                          (TYPE_MOD {ast-> t1 attr? t-ok} {}) true
                          ; rewrite slice type to an actual tuple type
                          (SLICE_TYPE) false
                          )))
         
 
-#_(defn =t= 
+(defn =t= 
   "type equality"
   [a1 a2] 
   (loop [t1 a1 t2 a2]
+    (assert (attr? t1 't-ok))
+    (assert (attr? t2 't-ok))
     (cond 
-      (error? t1) 'error
-      (error? t2) 'error
       (= (.getType t1) (.getType t2) (tok POINTER))
       (recur (getch t1) (getch t2))
       (= (.getType t1) (.getType t2) (tok DARRAY_DECL))
       (match-case 
         t1 (SARRAY_DECL {ast-> c1} {t IntegerLiteral ast-> e1})
         (match-case t2 (SARRAY_DECL {ast-> c2} {t IntegerLiteral ast-> e2})
-                    (do
-                      (when (not (attr? e1 'value)) (type-ded e1 nil))
-                      (when (not (attr? e2 'value)) (type-ded e2 nil))
-                      (cond (error? e1) 'error
-                            (error? e2) 'error
-                            (and (attr  e1 'value)
-                                 (attr  e2 'value)
-                                 (= (attr e1 'value) (attr e2 'value)))
-                            (do (assert (attr? e1 'value))
-                              (assert (attr? e2 'value))
-                              (assert (attr e1 'value
-                              (recur c1 c2))
-                            true 'no)
-                    (if (and (attr? e1 'value) (attr? e2 'value)
-                             (= (attr e1 'value) (attr e2 'value)))
-                      (recur c1 c2)
-                      'unknown)))
+                    (cond (= (attr e1 'value) (attr e2 'value))
+                          (recur c1 c2)
+                          true false)))
       (= (.getType t1) (.getType t2) (tok AARRAY_DECL))
       (match-case t1 (AARRAY_DECL {ast-> k1} {ast-> v1})
-                  (match-case t2 (SARRAY_DECL {ast-> k2} {ast-> v2})
+                  (match-case t2 (AARRAY_DECL {ast-> k2} {ast-> v2})
                               (let [x (=t= k1 k2)]
-                                (cond (= x 'unknown) 'unknown
-                                      (= x 'yes) (recur v1 v2) 
-                                      (= x 'no) 'no))
-                              (if (and (attr? e1 'value) (attr? e2 'value))
-                                (recur c1 c2)
-                                'unknown)))
-      (matches? t1 (SLICE_TYPE))
-      (match-case t1 (SLICE_TYPE {t TUPLE ast-> tu} 
-                                 {t IntegerLiteral ast-> e1} 
-                                 {t IntegerLiteral ast-> e2})
-                  (when (not (attr? e1 'value)) (type-ded e1 nil))
-                  (when (not (attr? e2 'value)) (type-ded e2 nil))
-                  (cond (error? e1) 'error
-                        (error? e2) 'error
-                        true (let [si (attr e1 'value)
-                                   ei (attr e2 'value)]
-                               (if (and (<= 0 si ei (.getNumberOfChildren tu))
-                                        (< si ei))
-                                 (let [ch (take (- ei si) (drop si (children tu)))
-                                       chc (map cpTree ch)]
-                                   (recur (make-ast! (TUPLE {ast (first chc)})) t2))
-
-
-                  (SLICE_TYPE (BASIC_TYPE {t? Dot} ID_LIST))
-      (matches? t2 (SLICE_TYPE))
-      (= (.getType t1) (.getType t2) (tok AARRAY_DECL))
-      (and (not (= (.getType a1) (.getType a2) (tok BASIC_TYPE)))
-           (not (= (.getType a1) (.getType a2))))
-      false))))))))))
+                                (if (not x) false
+                                  (recur v1 v2)))))
+      (= (.getType t1) (.getType t2) (tok TUPLE))
+      (all (fn [[c1,c2]] (=t= c1 c2)) (map list (children t1) (children t2)))
+      (or
+        (= (.getType t1) (.getType t2) (tok DELEGATE))
+        (= (.getType t1) (.getType t2) (tok FUNCTION))
+        (= (.getType t1) (.getType t2) (tok PARAM_SPEC)))
+      ; todo: take postfix parts into account, figure out how to handle properties,
+      ; figure out whether parameter modifiers are allowed with varargs
+      ; figure out if some of the parameter modifiers are type modifiers
+      (match-case t1 ({} {ast-> r1} {t PARAMETERS ast-> ps1} 
+                               {t? POSTFIX ast/?-> pf1})
+                  (match-case t2 ({} {ast-> r2} {t PARAMETERS ast-> ps2} 
+                                           {t? POSTFIX ast/?-> pf2})
+                                (cond (or pf1 pf2) false
+                                  (all (fn [[p1 p2]] 
+                                         (match-case p1 
+                                                     (PARAMETER Vararg)
+                                                     (matches? p2 (PARAMETER Vararg))
+                                                     (PARAMETER {t? PARAM_MODIFIER ast/?-> pm1} {ast-> tt1} {t? Identifier} Vararg)
+                                                     (if pm1? false
+                                                       (match-case p2
+                                                                   (PARAMETER {t? PARAM_MODIFIER ast/?-> pm2} {ast-> tt2} {t? Identifier} Vararg)
+                                                                   (if pm2? false
+                                                                     (=t= tt1 tt2)) 
+                                                                   false))
+                                                     (PARAMETER {t? PARAM_MODIFIER ast/?-> pm1} {ast-> tt1})
+                                                     (match-case p2 (PARAMETER {t? PARAM_MODIFIER ast/?-> pm2} {ast-> tt2})
+                                                                 (cond (not (= (set (children pm1)) (set (children pm2)))) false
+                                                                       true (=t= tt1 tt2)))))
+                                         (map list (children ps1) (children ps2)))
+                                      (recur r1 r2))))
+      (= (.getType t1) (.getType t2) (tok TUPLE))
+      (all (fn [[tt1,tt2]] (=t= tt1 tt2)) (map list (children t1) (children t2)))
+      (= (.getType t1) (.getType t2) (tok TYPE_MOD))
+      ; todo: make sure a specific order is imposed on type modifiers
+      (match-case t1 (TYPE_MOD {ast-> tt1} {t-> m1})
+                  (match-case t2 (TYPE_MOD {ast-> tt2} {t-> m2})
+                              (if (= m1 m2) (recur tt1 tt2)
+                                false)))
+      (= (.getType t1) (.getType t2) (tok BASIC_TYPE))
+      ;todo :symbol lookup!
+      (match-case t1 (BASIC_TYPE ID_LIST)
+                  false
+                  (BASIC_TYPE {t-> bt1})
+                  (match-case t2 (BASIC_TYPE ID_LIST)
+                              false
+                              (BASIC_TYPE {t-> bt2})
+                              (= bt1 bt2)))
+      (or (matches? t1 (BASIC_TYPE ID_LIST))
+          (matches? t2 (BASIC_TYPE ID_LIST)))
+      false
+      true false
+      )))
       
-(defn =t= [a1 a2] (Type/equals a1 a2))
-
-(defn type? 
-  "is ast a type (semantic type; not a raw type)?"
-  [ast]
-  (Type/isType ast))
-
 (defn basic-t? [tipe] 
   (= (.getType tipe) (tok BASIC_TYPE)))
 
-(defn complex-t? [tipe] (Type/isComplex tipe))
+(defn complex-t? [tipe] 
+  (or (=t= tipe CFLOAT)
+      (=t= tipe CDOUBLE)
+      (=t= tipe CREAL))) 
 
-(defn imag-t? [tipe] (Type/isImaginary tipe))
+(defn imag-t? [tipe] 
+  (or (=t= tipe IFLOAT)
+      (=t= tipe IDOUBLE)
+      (=t= tipe IREAL)))
 
-(defn float-t? [tipe] (Type/isFloatingpoint tipe))
+(defn float-t? [tipe] 
+  (or (=t= tipe FLOAT)
+      (=t= tipe DOUBLE)
+      (=t= tipe REAL)))
 
-(defn int-t? [tipe] (Type/isIntegral tipe))
+(defn int-t? [tipe state] 
+  (or (=t= tipe BYTE)
+      (=t= tipe UBYTE)
+      (=t= tipe SHORT)
+      (=t= tipe USHORT)
+      (=t= tipe INT)
+      (=t= tipe UINT)
+      (=t= tipe LONG)
+      (=t= tipe ULONG)
+      (=t= tipe CENT)
+      (=t= tipe UCENT)))
 
 (defn char-t? [tipe] 
-  (Type/isChar tipe))
+  (or (=t= tipe CHAR)
+      (=t= tipe WCHAR)
+      (=t= tipe DCHAR)))
 
 (defn error-or-throw [ast msg]
   (if (nil? ast) (throw (Exception. msg))
                (error-or-throw ast (str (format2 tipe) " not implemented")))))
 
 (defn signed? [tipe & {:keys [ast state] :or {ast nil state nil}}] 
-  (match-case tipe
-              (BASIC_TYPE Byte) true
-              (BASIC_TYPE Short) true
-              (BASIC_TYPE Int) true
-              (BASIC_TYPE Long) true
-              ({}) false))
+  (or (=t= tipe BYTE)
+      (=t= tipe SHORT)
+      (=t= tipe INT)
+      (=t= tipe LONG)
+      (=t= tipe CENT)))
 
 (defn dt-max 
   "the maximum value of a given type"
      (not (basic-t? tipe)) 
      (error-or-throw ast (str "max not defined for " (format2 tipe)))
      (=t= tipe BOOL) true
-     (and (int-t? tipe) (signed? tipe)) 
+     (and (int-t? tipe state) (signed? tipe)) 
      (- (pow 2 (- (* 8 (sizeof tipe ast state)) 1)) 1)
-     (and (int-t? tipe)) 
+     (and (int-t? tipe state)) 
      (- (pow 2 (* 8 (sizeof tipe ast state))) 1)
      (char-t? tipe)
      (- (pow 2 (* 8 (sizeof tipe ast state))) 1) 
      (not (basic-t? tipe)) 
      (error-or-throw ast (str "min not defined for " (format2 tipe)))
      (=t= tipe BOOL) true
-     (and (int-t? tipe) (signed? tipe)) 
+     (and (int-t? tipe state) (signed? tipe)) 
      (- (pow 2 (- (* 8 (sizeof tipe ast state)) 1)))
-     (and (int-t? tipe)) (bigint 0)
+     (and (int-t? tipe state)) (bigint 0)
      (char-t? tipe) (bigint 0)
      (=t= tipe FLOAT) Float/MIN_VALUE
      (=t= tipe DOUBLE) Double/MIN_VALUE
     (=t= lht DOUBLE) true
     true (assert false)))
 
+(defn integer-by [sz, signed?]
+  (case sz
+    1 (if signed? BYTE UBYTE)
+    2 (if signed? SHORT USHORT)
+    4 (if signed? INT UINT)
+    8 (if signed? LONG ULONG)
+    16 (if signed? CENT UCENT)))
+
 (defn int-or-larger 
   "combine two integerish types to produce a common type which
   is at least as large as int"
         [smaller larger] 
         (sort-by (if (= s1 s2) #(not (signed? %)) #(sizeof %)) [lht rht])]
     (if (< sz 4) INT
-      (Type/integer sz (signed? larger)))))
+      (integer-by sz (signed? larger)))))
 
 (defn c-larger 
   "combine two numeric types to produce a common type which is
                                {t IntegerLiteral s "6"}) 
                              {t IntegerLiteral s "5"}))))
          (let [a (parse2 "const(int)[1] i;" type_i)
-               b (normalize! (cpTree a) nil)]
+               b (normalize! (copy a) nil)]
            (is (matches? b (TYPE_MOD 
                              (SARRAY_DECL (BASIC_TYPE Int) 
                                           {t IntegerLiteral s "1"}) 
                              Const))))
          (let [a (parse2 "auto x(int i){ return 1;}" declDef)
-               b (normalize! (cpTree a) nil)]
+               b (normalize! (copy a) nil)]
            (is (matches? b (AUTO_DECL ATTRIBUTES 
                                       (PARAM_SPEC 
                                         (BASIC_TYPE 
                                     (not (.isEmpty (. state stack)))
                                     (matches? (first (. state stack)) 
                                               (AUTO_DECL))))
-                          (rewrite! ast state normalize!))))) ]
+                          (old-rewrite! ast state normalize!))))) ]
     (.visit td ast-root)
     (. (. td getState) t0)))
 

src/org/d/compiler/misc.clj

   (:use (clojure test))
   (:use (clojure.contrib macro-utils ))
   (:use 
-    (org.d.compiler d-type utils ast-utils type-deduce)))
+    (org.d.compiler d-type utils ast-utils visitor type-deduce)))
 
 (defn rewrite-templated-decl! 
   "
                         % 
                         (DECL_ASSIGN {t Identifier ast-> id} 
                                      {t? INITIALIZER})
-                        (make-ast! (DECLARATION {ast (cpTree t)}
+                        (make-ast! (DECLARATION {ast (copy t)}
                                                 {ast id sib ap})))
                      (children dx))]
       (setsib! (if ini? ini i1) nil)
     (AUTO_DECL {t ATTRIBUTES ast-> atrn} 
                {t AUTO_ASSIGN ast-> a1} 
                {t AUTO_ASSIGN ast-> a2})
-    (let [decls (map #(make-ast! (AUTO_DECL {ast (cpTree atrn)} 
+    (let [decls (map #(make-ast! (AUTO_DECL {ast (copy atrn)} 
                                             {ast % sib null})) 
                      (ast&siblings a2))]
       (setsib! a1 nil)
     (Alias {t? ATTRIBUTES ast/?-> atrn} {ast-> t} 
            {t Identifier ast-> i} {t ALIAS_LIST ast-> al})
     (let [decls (map #(if atrn? 
-                        (make-ast! (Alias {ast (cpTree atrn)} 
-                                          {ast (cpTree t)} {ast % sib null}))
-                        (make-ast! (Alias {ast (cpTree t)} {ast % sib null})))
+                        (make-ast! (Alias {ast (copy atrn)} 
+                                          {ast (copy t)} {ast % sib null}))
+                        (make-ast! (Alias {ast (copy t)} {ast % sib null})))
                      (children al))]
       (setsib! i nil)
       (last (map (fn [[a,b]] (setsib! a b)) (partition 2 1 (cons ast decls))))
                         (DECL_ASSIGN {t Identifier ast-> id} 
                                      {t? INITIALIZER})
                         (if atrn? 
-                          (make-ast! (Typedef {ast (cpTree atrn)}
-                                              {ast (cpTree t)} {ast id}))
-                          (make-ast! (Typedef {ast (cpTree t)} {ast id}))))
+                          (make-ast! (Typedef {ast (copy atrn)}
+                                              {ast (copy t)} {ast id}))
+                          (make-ast! (Typedef {ast (copy t)} {ast id}))))
                      (children dx))]
       (setsib! (if ini? ini i) nil)
       (last (map (fn [[a,b]] (setsib! a b)) (partition 2 1 (cons ast decls))))
   (let [td 
         (proxy [Visitor2] [] 
           (onVisit [ast state]
+                   (when (matches? ast (PARENS_EXPRESSION))
+                     (old-rewrite! ast state (fn [ast state] (getch ast))))
                    (when (matches-any? ast
                                        (PLUSPLUSPRE)
                                        (MINUSMINUSPRE))
-                     (rewrite! ast state unop-rewrite))
+                     (old-rewrite! ast state unop-rewrite))
                    (when (or (matches-any? ast (TYPE_I) (TYPE))
                              (and
                                (matches? ast (DECLARATOR))
                                (not (empty? (. state stack)))
                                (matches? (first (. state stack)) (AUTO_DECL))))
-                     (rewrite! ast state normalize!))
+                     (old-rewrite! ast state normalize!))
                    (when (matches-any? 
                            ast 
                            (Class Identifier TEMPLATE_PARAMETERS) 
                            (Interface Identifier TEMPLATE_PARAMETERS) 
                            (Union Identifier TEMPLATE_PARAMETERS) 
                            (Struct Identifier TEMPLATE_PARAMETERS))
-                     (rewrite! ast state rewrite-templated-decl!)))
+                     (old-rewrite! ast state rewrite-templated-decl!)))
           (onAscend [ast state]
                     (when (matches? ast (DECLARATION
                                           (PARAM_SPEC 
                                             {} 
                                             TEMPLATE_PARAMETERS PARAMETERS)))
-                      (rewrite! ast state rewrite-templated-fn!)))) ]
+                      (old-rewrite! ast state rewrite-templated-fn!)))) ]
     (.visit td ast-root)
     (. (. td getState) t0)))
 
     (AUTO_DECL {t ATTRIBUTES ast-> attrs} 
                ({t AUTO_ASSIGN ast-> asg sib? false} 
                 {t Identifier ast-> i} {t INITIALIZER ast-> ini}))
-    (let [t (cpTree (attr ini 'type))]
+    (let [t (copy (attr ini 'type))]
       (make-ast! (DECLARATION {ast t} {ast i})))
     (AUTO_DECL {t ATTRIBUTES ast-> atrn}
                ({t PARAM_SPEC ast-> ps} 
                 PARAMETERS) 
                Identifier
                {t FUNCTION_BODY ast-> f})
-    (let [t (cpTree (attr f 'type))
+    (let [t (copy (attr f 'type))
           a1 (filter #(not (matches? % (Auto))) (children atrn))
           _ (last (map #(setsib! % nil) (children atrn)))
           decl (make-ast! (DECLARATION {ast ps}))]
         (make-ast! (ATTR_DECLDEF ({ast atrn ch null sib null} {ast (first a1)})
                                  (D_BLOCK {ast decl}))))))
     (IF_COND {t Auto ast-> a} {t Identifier ast-> i} {ast-> e})
-    (let [t (cpTree (attr e 'type))]
+    (let [t (copy (attr e 'type))]
       (assert t)
       (setch! ast t)
       (setsib! a nil)
 ; todo: typeof can be parsed but will not be expanded in most cases
 ; in an expression tree. need to find those that aren't and report them
 (defn expand-typeof? [ast]
-  (let [e (match-case 
-            ast
-            (BASIC_TYPE ({t Typeof sib? false} {ast-> e})) e
-            ;(TMIXIN_ID1 (Typeof {ast-> e})) e
-            ({t Dot exp? true} ({t Typeof exp? true sib? true} {ast-> e})) e)]
-    (attr? e 'type)))
+  (match-case 
+    ast
+    (BASIC_TYPE ({t Typeof sib? false} {type/?-> t })) t?
+    ;(TMIXIN_ID1 (Typeof {ast-> e})) e
+    ({t Dot exp? true} (Typeof {type/?-> t} Identifier)) t?
+    false))
 
 (defn expand-typeof-rewrite! [ast state]
   (match-case 
     ast
     (BASIC_TYPE (Typeof {ast-> e})) 
-    (cpTree (attr e 'type))
+    (copy (attr e 'type))
     ({t Dot exp? true} 
      ({t Typeof exp? true ast-> ty} {ast-> e})
      {t Identifier ast-> i}) 
-    (let [t (cpTree (attr e 'type))]
+    (let [t (copy (attr e 'type))]
       (setch! ast t)
       (setsib! t i)
       (setsib! ty nil)
         (proxy [Visitor2] [] 
           (onVisit [ast state]
                    (when (expand-auto-decl? ast)
-                     (rewrite! ast state expand-auto-decl!)
+                     (old-rewrite! ast state expand-auto-decl!)
                      ))
           ) ]
     (.visit td ast-root)
   (let [a (parse2 "immutable x(int i){ return 1;}" declDef)
         b (rewrites-1! a) 
         c (testi a)]
-    (dumpt a)
-    (dumpt b)
     (match-case 
       b
       (AUTO_DECL ATTRIBUTES {} Identifier {t FUNCTION_BODY ast-> f})
       (do
         (attr! f 'type INT)
         (let [x (rewrites-2! b)]
-          (dumpt x))))))
+          (dump-ast x))))))
 
 (defn str-mixin? [ast]
     (match-case 
     ({} {exp? true ast-> e})
     (let [t (attr e 'type)
           v (attr e 'value)]
-      (letfn [bazooka! ([parser mxnstr mxnstrt]
+      (letfn [(bazooka! [parser mxnstr mxnstrt]
                         (match-case 
                           ast
                           (MIXIN_DECLDEF) (. parser declDefs)
                             (attr! mxn 'mixinstr mxnstr)
                             (attr! mxn 'mixinstr-t mxnstrt)
                             (rewrites-1! mxn)
-                            (rewrite! ast state (fn [a,s] mxn)))
+                            (old-rewrite! ast state (fn [a,s] mxn)))
                           ; todo: when error mechanism allows multiple 
                           ; error messages, put them all in!
                           (error! ast (.. parser errors (get 0) toString))))]

src/org/d/compiler/semantic.clj

 (ns org.d.compiler.semantic
-  (:use (org.d.compiler ast-utils misc type-deduce))
+  (:import (java.util HashMap HashSet))
+  (:use (org.d.compiler ast-utils constfold d-type symbol misc type-deduce visitor))
   )
 
 (defn semantic-blast 
   const folding rewrites - todo
   "
   [ast-root]
-  (let [td 
-        (proxy [Visitor2] [] 
-          (onVisit [ast state]
-                   ; instantiate some attributes
-                   (when (and (scoped? ast) (not (attr? ast 'scope)))
-                     (attr! ast 'scope (HashMap.)))
-                   (when (and (decl-scoped? ast) (not (attr? ast 'imports)))
-                     (attr! ast 'imports (HashSet.)))
-                   (when (and (body-scoped? ast) (not (attr? ast 'labels)))
-                     (attr! ast 'labels (HashMap.)))
-                   ; type deduction
-                   (let [descend (all-ded ast state)]
-                         (set! (. state descend) descend))
-                   ; ignore templates
-                   (when (matches? ast (Template))
-                     (set! (. state descend) false))
-                   ; instantiate d language attributes
-                   (when (and (attrble? ast) 
-                              (not (attr? ast 'prot))
-                              (not (attr? ast 'storage))
-                              (not (attr? ast 'align))
-                              (not (attr? ast 'pragma)))
-                     (let [[prot,stor,algn,pragmas] (get-attrs ast state)]
-                       (attr! ast 'prot prot)
-                       (attr! ast 'storage stor)
-                       (attr! ast 'align algn)
-                       (attr! ast 'pragma pragmas)))
-                   ; populate symbol table
-                   (when (not (attr? ast 'scoped))
-                     (let [is (get-symbols ast state)]
-                       (when (not (empty? is))
-                         (push-symbols! ast is state))))
-                   (when (and (matches? ast (IMPORT))
-                              (not (attr? ast 'scoped)))
-                     (push-import! ast state))
-                   ; populate label table
-                   (when (and (matches? ast (LABEL))
-                              (not (attr?  ast 'scoped)))
-                     (push-label! ast state))
-                   (when (expand-typeof? ast)
-                     (rewrite! ast state expand-typeof-rewrite!))
-                   )
-          (onAscend [ast state]
-                    ; more type deduction (in case children were deduced
-                    ; on the way down)
-                    (let [descend (all-ded ast state)])
-                    ; expunge d language attributes, as they should have
-                    ; been entered into all relevant ast attributes on the 
-                    ; way down
-                    (when (matches-any? ast (ATTR_DECLDEF) 
-                                        (PROT_DECLDEF) (ALIGN_DECLDEF))
-                      (rewrite! ast state rm_attrs :skipsibs? true))
-                    )
-          ) ]
-    (.visit td ast-root)
-    (. (. td getState) t0)))
+  (let [v (visitor
+            :onVisit 
+            (fn [ast state]
+              (do-when 
+                ast state
+                ; instantiate some attributes
+                (and (scoped? ast) (not (attr? ast 'scope)))
+                (do (attr! ast 'scope (HashMap.)) state)
+                (and (decl-scoped? ast) (not (attr? ast 'imports)))
+                (do (attr! ast 'imports (HashSet.)) state)
+                (and (body-scoped? ast) (not (attr? ast 'labels)))
+                (do (attr! ast 'labels (HashMap.)) state)
+                ; type instantiation
+                (and (type? ast) 
+                     (not (attr? ast 't-ok))
+                     (t-ok? ast state))
+                (do (attr! ast 't-ok true) state)
+                ; type deduction
+                true (let [descend (all-ded ast state)] state)
+                ; ignore templates
+                (matches? ast (Template))
+                (assoc state :descend? false)
+                ; instantiate d language attributes
+                (and (attrble? ast) 
+                     (not (attr? ast 'prot))
+                     (not (attr? ast 'storage))
+                     (not (attr? ast 'align))
+                     (not (attr? ast 'pragma)))
+                  (let [[prot,stor,algn,pragmas] (get-attrs ast state)]
+                    (attr! ast 'prot prot)
+                    (attr! ast 'storage stor)
+                    (attr! ast 'align algn)
+                    (attr! ast 'pragma pragmas)
+                    state)
+                ; populate symbol table
+                (not (attr? ast 'scoped))
+                (let [is (get-symbols ast state)]
+                  (when (not (empty? is))
+                    (push-symbols! ast is state))
+                  state)
+                (and (matches? ast (IMPORT))
+                     (not (attr? ast 'scoped)))
+                (do (push-import! ast state) state)
+                ; populate label table
+                (and (matches? ast (LABEL))
+                     (not (attr?  ast 'scoped)))
+                (do (push-label! ast state) state)
+                (exp? ast)
+                (do (constfold ast state) state)
+                (expand-typeof? ast)
+                (new-rewrite! ast state expand-typeof-rewrite!)
+                (rewrite-value? ast state)
+                (new-rewrite! ast state rewrite-value!)
+                ))
+            :onAscend
+            (fn [ast state]
+              (do-when 
+                ast state
+                ; more type deduction (in case children were deduced
+                ; on the way down)
+                true (let [descend (all-ded ast state)] state)
+                ; ditto
+                (exp? ast)
+                (do (constfold ast state) state)
+                ; expunge d language attributes, as they should have
+                ; been entered into all relevant ast attributes on the 
+                ; way down
+                (matches-any? ast (ATTR_DECLDEF) 
+                              (PROT_DECLDEF) (ALIGN_DECLDEF))
+                (new-rewrite! ast state rm_attrs :skipsibs? true))
+              ))] 
+    (:ast-root (v ast-root))))
+
+(defn test1 [strxp]
+  (let [a (parse2 strxp exp)]
+    (println "a:")
+    (dump-ast a)
+    (let [aa (rewrites-1! a)
+          b (semantic-blast aa)]
+      (println "b:")
+      (dump-ast b)
+      (let [c (semantic-blast b)]
+        (println "c:")
+        (dump-ast c)
+        c))))

src/org/d/compiler/symbol.clj

           (onAscend [ast state]
                     (when (matches-any? ast (ATTR_DECLDEF) 
                                         (PROT_DECLDEF) (ALIGN_DECLDEF))
-                      (rewrite! ast state rm_attrs :skipsibs? true)
+                      (old-rewrite! ast state rm_attrs :skipsibs? true)
                       )
                     )) ]
     (.visit td ast-root)

src/org/d/compiler/type_deduce.clj

       (and (imag-t? lht) (imag-t? rht)) (i-larger lht rht)
       (or (imag-t? lht) (imag-t? rht)) (c-larger lht rht)
       (or (float-t? lht) (float-t? rht)) (f-larger lht rht)
-      (and (or (int-t? lht) (char-t? lht) (=t= lht BOOL))
-           (or (int-t? rht) (char-t? rht) (=t= rht BOOL))) 
+      (and (or (int-t? lht state) (char-t? lht) (=t= lht BOOL))
+           (or (int-t? rht state) (char-t? rht) (=t= rht BOOL))) 
       (int-or-larger lht rht)
       true (error! ast "unknown how to combine types"))))
 
       (or (imag-t? lht) (imag-t? rht)) 
       (error! ast (err1 "invalid operation"))
       (float-t? lht) 
-      (if (or (float-t? rht) (int-t? rht) (char-t? rht) (=t= rht BOOL)) lht
+      (if (or (float-t? rht) (int-t? rht state) (char-t? rht) (=t= rht BOOL)) lht
         ; f = ?? assume illegal
         (error! ast (err1 "invalid operation")))
-      (and (or (int-t? lht) (char-t? lht))
-           (or (int-t? rht) (char-t? rht) (=t= rht BOOL)))
+      (and (or (int-t? lht state) (char-t? lht))
+           (or (int-t? rht state) (char-t? rht) (=t= rht BOOL)))
       (if (<= (sizeof rht) (sizeof lht)) lht
         ; eg b = i; where b byte, i int
         (error! ast (err1 "invalid operation")))
       (and (imag-t? lht) (imag-t? rht)) lht
       (or (imag-t? lht) (imag-t? rht)) (error! ast (err1 "invalid operation"))
       (float-t? lht) lht
-      (and (or (int-t? lht))
-           (or (int-t? rht) (char-t? rht) (=t= rht BOOL)))
+      (and (or (int-t? lht state))
+           (or (int-t? rht state) (char-t? rht) (=t= rht BOOL)))
       (if (<= (sizeof rht) (sizeof lht)) lht
         (error! ast (err1 "invalid operation")))
       true (error! ast (err1 "unknown operation")))))
       (and (imag-t? lht) (imag-t? rht)) lht
       (or (imag-t? lht) (imag-t? rht)) (error! ast (err1 "invalid operation"))
       (float-t? lht) lht
-      (and (or (int-t? lht))
-           (or (int-t? rht) (char-t? rht) (=t= rht BOOL)))
+      (and (or (int-t? lht state))
+           (or (int-t? rht state) (char-t? rht) (=t= rht BOOL)))
       (if (<= (sizeof rht) (sizeof lht)) lht
         (error! ast (err1 "invalid operation")))
       true (error! ast (err1 "unknown operation")))))
       (error! ast (err1 "invalid operation"))
       (imag-t? lht) lht
       (float-t? lht) lht
-      (and (or (int-t? lht))
-           (or (int-t? rht) (char-t? rht) (=t= rht BOOL)))
+      (and (or (int-t? lht state))
+           (or (int-t? rht state) (char-t? rht) (=t= rht BOOL)))
       (if (<= (sizeof rht) (sizeof lht)) lht
         (error! ast (err1 "invalid operation")))
       true (error! ast (err1 "unknown operation")))))
       (error! ast (err1 "invalid operation"))
       (imag-t? lht) lht
       (float-t? lht) lht
-      (and (or (int-t? lht))
-           (or (int-t? rht) (char-t? rht) (=t= rht BOOL)))
+      (and (or (int-t? lht state))
+           (or (int-t? rht state) (char-t? rht) (=t= rht BOOL)))
       (if (<= (sizeof rht) (sizeof lht)) lht
         (error! ast (err1 "invalid operation")))
       true (error! ast (err1 "unknown operation")))))
       (or (complex-t? rht) (imag-t? rht)) 
       (error! ast (err1 "invalid operation"))
       (float-t? lht) lht
-      (and (or (int-t? lht))
-           (or (int-t? rht) (char-t? rht) (=t= rht BOOL)))
+      (and (or (int-t? lht state))
+           (or (int-t? rht state) (char-t? rht) (=t= rht BOOL)))
       (if (<= (sizeof rht) (sizeof lht)) lht
         (error! ast (err1 "invalid operation")))
       true (error! ast (err1 "unknown operation")))))
       (or (complex-t? lht) (imag-t? lht) (complex-t? rht) (imag-t? rht)) 
       (error! ast (err1 "invalid operation"))
       (and (float-t? lht) (float-t? rht)) lht
-      (and (float-t? lht) (int-t? rht)) lht
-      (and (int-t? lht) (float-t? rht)) rht
-      (and (int-t? lht) 
+      (and (float-t? lht) (int-t? rht state)) lht
+      (and (int-t? lht state) (float-t? rht)) rht
+      (and (int-t? lht state) 
            (<= 4 (sizeof lht)) 
-           (int-t? rht) 
+           (int-t? rht state) 
            (<= (sizeof rht) (sizeof lht))) 
       lht
       true (error! ast (err1 "unknown operation")))))
     (cond
       (not (and (basic-t? lht) (basic-t? rht))) 
       (error! ast (err1 "unknown operation"))
-      (not (or (int-t? lht) (char-t? lht) (=t= lht BOOL))) 
+      (not (or (int-t? lht state) (char-t? lht) (=t= lht BOOL))) 
       (error! ast (err1 "invalid operation"))
-      (not (or (int-t? rht) (char-t? rht) (=t= rht BOOL))) 
+      (not (or (int-t? rht state) (char-t? rht) (=t= rht BOOL))) 
       (error! ast (err1 "invalid operation"))
       (and (=t= lht BOOL) (=t= rht BOOL)) lht
       (=t= lht BOOL) (error! ast (err1 "invalid operation"))
-      (and (or (int-t? lht) (char-t? lht))
-           (or (int-t? rht) (char-t? rht) (=t= rht BOOL)))
+      (and (or (int-t? lht state) (char-t? lht))
+           (or (int-t? rht state) (char-t? rht) (=t= rht BOOL)))
       (if (<= (sizeof rht) (sizeof lht)) lht
         (error! ast (err1 "invalid operation")))
       true (error! ast (err1 "unknown operation")))))
     (cond
       (not (and (basic-t? lht) (basic-t? rht))) 
       (error! ast (err1 "unknown operation"))
-      (not (or (int-t? lht) (char-t? lht) (=t= lht BOOL))) 
+      (not (or (int-t? lht state) (char-t? lht) (=t= lht BOOL))) 
       (error! ast (err1 "invalid operation"))
-      (not (or (int-t? rht) (char-t? rht) (=t= rht BOOL))) 
+      (not (or (int-t? rht state) (char-t? rht) (=t= rht BOOL))) 
       (error! ast (err1 "invalid operation"))
       (and (=t= lht BOOL) (=t= rht BOOL)) lht
       (=t= lht BOOL) (error! ast (err1 "invalid operation"))
-      (and (or (int-t? lht) (char-t? lht))
-           (or (int-t? rht) (char-t? rht) (=t= rht BOOL)))
+      (and (or (int-t? lht state) (char-t? lht))
+           (or (int-t? rht state) (char-t? rht) (=t= rht BOOL)))
       (if (<= (sizeof rht) (sizeof lht)) lht
         (error! ast (err1 "invalid operation")))
       true (error! ast (err1 "unknown operation")))))
     (cond
       (not (and (basic-t? lht) (basic-t? rht))) 
       (error! ast (err1 "unknown operation"))
-      (not (or (int-t? lht) (char-t? lht) (=t= lht BOOL))) 
+      (not (or (int-t? lht state) (char-t? lht) (=t= lht BOOL))) 
       (error! ast (err1 "invalid operation"))
-      (not (or (int-t? rht) (char-t? rht) (=t= rht BOOL))) 
+      (not (or (int-t? rht state) (char-t? rht) (=t= rht BOOL))) 
       (error! ast (err1 "invalid operation"))
       (and (=t= lht BOOL) (=t= rht BOOL)) lht
       (=t= lht BOOL) (error! ast (err1 "invalid operation"))
-      (and (or (int-t? lht) (char-t? lht))
-           (or (int-t? rht) (char-t? rht) (=t= rht BOOL)))
+      (and (or (int-t? lht state) (char-t? lht))
+           (or (int-t? rht state) (char-t? rht) (=t= rht BOOL)))
       (if (<= (sizeof rht) (sizeof lht)) lht
         (error! ast (err1 "invalid operation")))
       true (error! ast (err1 "unknown operation")))))
     (cond
       (not (and (basic-t? lht) (basic-t? rht))) 
       (error! ast (err1 "unknown operation"))
-      (and (or (int-t? lht) (char-t? lht))
-           (or (int-t? rht) (char-t? rht) (=t= rht BOOL))) lht
+      (and (or (int-t? lht state) (char-t? lht))
+           (or (int-t? rht state) (char-t? rht) (=t= rht BOOL))) lht
       true (error! ast (err1 "unknown operation")))))
 
 (defn rshift-asg-t [ast lhs rhs state]
     (cond
       (not (and (basic-t? lht) (basic-t? rht))) 
       (error! ast (err1 "unknown operation"))
-      (and (or (int-t? lht) (char-t? lht))
-           (or (int-t? rht) (char-t? rht) (=t= rht BOOL))) lht
+      (and (or (int-t? lht state) (char-t? lht))
+           (or (int-t? rht state) (char-t? rht) (=t= rht BOOL))) lht
       true (error! ast (err1 "unknown operation")))))
 
 (defn urshift-asg-t [ast lhs rhs state]
     (cond
       (not (and (basic-t? lht) (basic-t? rht))) 
       (error! ast (err1 "unknown operation"))
-      (and (or (int-t? lht) (char-t? lht))
-           (or (int-t? rht) (char-t? rht) (=t= rht BOOL))) lht
+      (and (or (int-t? lht state) (char-t? lht))
+           (or (int-t? rht state) (char-t? rht) (=t= rht BOOL))) lht
       true (error! ast (err1 "unknown operation")))))
 
 (defn or-t [ast lhs rhs state]
       (or (complex-t? rht) (imag-t? rht) (float-t? rht)) 
       (error! ast (err1 "invalid operation"))
       (and (=t= lht BOOL) (=t= rht BOOL)) lht
-      (and (or (int-t? lht) (char-t? lht) (=t= lht BOOL))
-           (or (int-t? rht) (char-t? rht) (=t= rht BOOL)))
+      (and (or (int-t? lht state) (char-t? lht) (=t= lht BOOL))
+           (or (int-t? rht state) (char-t? rht) (=t= rht BOOL)))
       (int-or-larger lht rht)
       true (error! ast (err1 "unknown operation")))))
 
       (or (complex-t? rht) (imag-t? rht) (float-t? rht)) 
       (error! ast (err1 "invalid operation"))
       (and (=t= lht BOOL) (=t= rht BOOL)) lht
-      (and (or (int-t? lht) (char-t? lht) (=t= lht BOOL))
-           (or (int-t? rht) (char-t? rht) (=t= rht BOOL)))
+      (and (or (int-t? lht state) (char-t? lht) (=t= lht BOOL))
+           (or (int-t? rht state) (char-t? rht) (=t= rht BOOL)))
       (int-or-larger lht rht)
       true (error! ast (err1 "unknown operation")))))
 
   (defmacro err1 [msg] `(str (format2 lht) " << " (format2 rht) " " ~msg))
   (let [lht (attr lhs 'type) rht (attr rhs 'type)]
     (cond
-      (and (int-t? lht) (or (int-t? rht) (=t= rht BOOL))) 
+      (and (int-t? lht state) (or (int-t? rht state) (=t= rht BOOL))) 
       (int-or-larger lht BYTE)
       true (error! ast (err1 "invalid operation"))
       )))
   (defmacro err1 [msg] `(str (format2 lht) " >> " (format2 rht) " " ~msg))
   (let [lht (attr lhs 'type) rht (attr rhs 'type)]
     (cond
-      (and (int-t? lht) (or (int-t? rht) (=t= rht BOOL))) 
+      (and (int-t? lht state) (or (int-t? rht state) (=t= rht BOOL))) 
       (int-or-larger lht BYTE)
       true (error! ast (err1 "invalid operation"))
       )))
   (defmacro err1 [msg] `(str (format2 lht) " >>> " (format2 rht) " " ~msg))
   (let [lht (attr lhs 'type) rht (attr rhs 'type)]
     (cond
-      (and (int-t? lht) (or (int-t? rht) (=t= rht BOOL))) 
+      (and (int-t? lht state) (or (int-t? rht state) (=t= rht BOOL))) 
       (int-or-larger lht BYTE)
       true (error! ast (err1 "invalid operation"))
       )))
       (and (imag-t? lht) (imag-t? rht)) (f-larger lht rht)
       (or (imag-t? lht) (imag-t? rht)) (i-larger lht rht)
       (or (float-t? lht) (float-t? rht)) (f-larger lht rht)
-      (and (int-t? lht) (int-t? rht)) (int-or-larger lht rht)
+      (and (int-t? lht state) (int-t? rht state)) (int-or-larger lht rht)
       true (error! ast (err1 "unknown operation")))))
 
 (defn mul-t [ast lhs rhs state]
       (and (imag-t? lht) (imag-t? rht)) (f-larger lht rht)
       (or (imag-t? lht) (imag-t? rht)) (i-larger lht rht)
       (or (float-t? lht) (float-t? rht)) (f-larger lht rht)
-      (and (int-t? lht) (int-t? rht)) (int-or-larger lht rht)
+      (and (int-t? lht state) (int-t? rht state)) (int-or-larger lht rht)
       true (error! ast (err1 "unknown operation")))))
 
 (defn mod-t [ast lhs rhs state]
       (or (imag-t? lht) (imag-t? rht)) 
       (error! ast (err1 "unknown operation"))
       (or (float-t? lht) (float-t? rht)) (f-larger lht rht)
-      (and (int-t? lht) (int-t? rht)) (int-or-larger lht rht)
+      (and (int-t? lht state) (int-t? rht state)) (int-or-larger lht rht)
       true (error! ast (err1 "unknown operation")))))
 
 (defn pow-t [ast lhs rhs state]
       (or (complex-t? lht) (imag-t? lht) (complex-t? rht) (imag-t? rht)) 
       (error! ast (err1 "invalid operation"))
       (and (float-t? lht) (float-t? rht)) (f-larger lht rht) 
-      (and (float-t? lht) (int-t? rht)) lht
-      (and (int-t? lht) (float-t? rht)) rht
-      (and (int-t? lht) (int-t? rht)) (int-or-larger lht rht)
+      (and (float-t? lht) (int-t? rht state)) lht
+      (and (int-t? lht state) (float-t? rht)) rht
+      (and (int-t? lht state) (int-t? rht state)) (int-or-larger lht rht)
       true (error! ast (err1 "unknown operation")))))
 
 (defn and-bitwise-t [ast lhs rhs state]
       (or (complex-t? rht) (imag-t? rht) (float-t? rht))
       (error! ast (err1 "invalid operation"))
       (and (=t= lht BOOL) (=t= rht BOOL)) lht
-      (and (or (int-t? lht) (char-t? lht) (=t= lht BOOL))
-           (or (int-t? rht) (char-t? rht) (=t= rht BOOL)))
+      (and (or (int-t? lht state) (char-t? lht) (=t= lht BOOL))
+           (or (int-t? rht state) (char-t? rht) (=t= rht BOOL)))
       (int-or-larger lht rht)
       true (error! ast (err1 "unknown operation")))))
 
 (defn add-t [ast lhs rhs state]
   (defmacro err1 [msg] `(str (format2 lht) " + " (format2 rht) " " ~msg))
   (let [lht (attr lhs 'type) rht (attr rhs 'type)]
-    (println "waaza")
     (cond
       (not (and (basic-t? lht) (basic-t? rht))) 
       (error! ast (err1 "unknown operation"))
       (and (imag-t? lht) (imag-t? rht)) (i-larger lht rht)
       (or (imag-t? lht) (imag-t? rht)) (c-larger lht rht)
       (or (float-t? lht) (float-t? rht)) (f-larger lht rht)
-      (and (or (int-t? lht) (char-t? lht) (=t= lht BOOL))
-           (or (int-t? rht) (char-t? rht) (=t= rht BOOL))) 
+      (and (or (int-t? lht state) (char-t? lht) (=t= lht BOOL))
+           (or (int-t? rht state) (char-t? rht) (=t= rht BOOL))) 
       (int-or-larger lht rht)
       true (error! ast (err1 "unknown operation")))))
 
       (and (imag-t? lht) (imag-t? rht)) (i-larger lht rht)
       (or (imag-t? lht) (imag-t? rht)) (c-larger lht rht)
       (or (float-t? lht) (float-t? rht)) (f-larger lht rht)
-      (and (or (int-t? lht) (char-t? lht) (=t= lht BOOL))
-           (or (int-t? rht) (char-t? rht) (=t= rht BOOL))) 
+      (and (or (int-t? lht state) (char-t? lht) (=t= lht BOOL))
+           (or (int-t? rht state) (char-t? rht) (=t= rht BOOL))) 
       (int-or-larger lht rht)
       true (error! ast (err1 "unknown operation")))))
 
 
 (defn reference-t [ast rhs state]
   (defmacro err1 [msg] `(str "&" (format2 rht) " " ~msg))
-  (let [rht (attr rhs type)]
+  (let [rht (attr rhs 'type)]
     (cond
       true (error! ast (err1 "unknown operation")))))
 
 (defn positive-t [ast rhs state]
   (defmacro err1 [msg] `(str "+" (format2 rht) " " ~msg))
-  (let [rht (attr rhs type)]
+  (let [rht (attr rhs 'type)]
     (cond
       (complex-t? rht) rht
       (imag-t? rht) rht
       (float-t? rht) rht
-      (int-t? rht) rht
+      (int-t? rht state) rht
       (char-t? rht) rht
       true (error! ast (err1 "unknown operation")))))
 
 (defn negative-t [ast rhs state]
   (defmacro err1 [msg] `(str "-" (format2 rht) " " ~msg))
-  (let [rht (attr rhs type)]
+  (let [rht (attr rhs 'type)]
     (cond
       (complex-t? rht) rht
       (imag-t? rht) rht
       (float-t? rht) rht
-      (int-t? rht) rht
+      (int-t? rht state) rht
       (char-t? rht) rht
       true (error! ast (err1 "unknown operation")))))
 
 (defn bitneg-t [ast rhs state]
   (defmacro err1 [msg] `(str "~" (format2 rht) " " ~msg))
-  (let [rht (attr rhs type)]
+  (let [rht (attr rhs 'type)]
     (cond
-      (or (int-t? rht) (char-t? rht)) (int-or-larger rht BYTE)
+      (or (int-t? rht state) (char-t? rht)) (int-or-larger rht BYTE)
       true (error! ast (err1 "unknown operation")))))
 
 (defn dereference-t [ast rhs state]
   (defmacro err1 [msg] `(str "*" (format2 rht) " " ~msg))
-  (let [rht (attr rhs type)]
+  (let [rht (attr rhs 'type)]
     (cond
       true (error! ast (err1 "unknown operation")))))
 
 (defn plusplus-t [ast rhs state]
   (defmacro err1 [msg] `(str (format2 rht) "++ " ~msg))
-  (let [rht (attr rhs type)]
+  (let [rht (attr rhs 'type)]
     (cond
       (complex-t? rht) rht
       (float-t? rht) rht
-      (int-t? rht) rht
+      (int-t? rht state) rht
       (char-t? rht) rht
       true (error! ast (err1 "unknown operation")))))
 
 (defn minusminus-t [ast rhs state]
   (defmacro err1 [msg] `(str (format2 rht) "-- " ~msg))
-  (let [rht (attr rhs type)]
+  (let [rht (attr rhs 'type)]
     (cond
       (complex-t? rht) rht
       (float-t? rht) rht
-      (int-t? rht) rht
+      (int-t? rht state) rht
       (char-t? rht) rht
       true (error! ast (err1 "unknown operation")))))
 
 (defn not-t [ast rhs state]
   (defmacro err1 [msg] `(str "!" (format2 rht) " " ~msg))
-  (let [rht (attr rhs type)]
+  (let [rht (attr rhs 'type)]
     (cond
       (=t= rht VOID) (error! ast (err1 "invalid operation"))
       (basic-t? rht) BOOL
           (.endsWith s "U") [true,false,1]
           (.endsWith s "L") [false,true,1]
           true [false,false,0])
-        value (bigint (esub s start endoff))]
+        value (BigInteger. (esub s start endoff) radix)]
     (cond
       (>= value (pow 2 64)) 
       (error! ast "integer literal too big for ulong")
 (defn char-lit-t [ast state]
   (let [vt (char-lit-v-t ast state)]
     (if (nil? vt) vt
-      (let [[v t] vt] [t v v]))))
+      (let [[v t] vt] [t v]))))
 
 (defn str-lit-t [ast state]
   (let [s (.getText ast)
       true DOUBLE)))
 
 (defn bool-lit-t [ast state]
-  (match-case ast
-              (True) BOOL
-              (False) BOOL
-              (error! ast (str "why the honk are we thinking " 
-                               "this is boolean literal?"))))
+  (match-case ast (True) [BOOL,true]
+              (False) [BOOL,false]))
 
 (defn assert2-t [ast lhs rhs state]
   (let [lht (attr lhs 'type) rht (attr rhs 'type)
   (cond (nil? res) (assert (error? ast))
         (sequential? res)
         (let [[ret & rng] res]
-          (when (int-t? ret)
+          (when (int-t? ret state)
             (let [[imin imax] rng]
               (attr! ast 'int-max imax)
               (attr! ast 'int-min imin)
               (when (= imax imin) (attr! ast 'value imin))))
+          (when (char-t? ret)
+            (let [[v] rng]
+              (attr! ast 'value v)))
+          (when (=t= ret BOOL)
+            (let [[v] rng]
+              (attr! ast 'value v)))
           (attr! ast 'type ret))
         true (attr! ast 'type res))
   (list false) ; don't descend a deduced or error laden tree
   returns [descend] where descend = true => the subtrees 
   must be deduced before this one can"
   [ast state]
+  (dbg ast)
   (match-case 
     ast
     ; ternary operator
 
     (METHOD_PARAMETERS) 
     (do (error! ast "not implemented") (list false))
+    (ARGUMENTS)
+    (do (error! ast "not implemented") (list false))
 
     (Slice) (do (error! ast "not implemented") (list false))
     (INDEX_EXPRESSION) (do (error! ast "not implemented") (list false))

src/org/d/compiler/utils.clj

 (deftest test-any
          (is (any nil? '(nil nil 1)))
          )
+
+(defn conz [& rst] (reduce #(cons %2 %1) (reverse rst)))
+
+(deftest test-conz
+         (is (= (conz 1 2 3 '(4)) '(1 2 3 4))))

src/org/d/compiler/visitor.clj

 (ns org.d.compiler.visitor
   "playing with yet another variation to visitor"
-  (:use org.d.compiler.ast-utils)
-  (:use clojure.contrib.def))
+  (:import (org.d.model MyAST))
+  (:use (org.d.compiler ast-utils utils))
+  (:use (clojure.contrib def macro-utils))
+  (:use (clojure walk test)))
 
-(defstruct State :ast :stack :descend? :next? :next2? 
-           :ignore-siblings? :lch :ast-root)
+(defstruct State 
+           ; the current ast node being visited
+           :ast 
+           ; the path from :ast to the :ast-root, with 
+           ; (first :stack) being :ast's immediate parent
+           :stack 
+           ; whether to descend from :ast to its first child.
+           ; must be set to false on each visit where no descent 
+           ; is desired.
+           :descend? 
+           ; whether to move from :ast to its next sibling
+           ; (when :ast has no child).
+           ; must be set to false etc
+           :next? 
+           ; whether to move from :ast to its next sibling
+           ; (when :ast has children)
+           ; must be set to false etc
+           :next2? 
+           ; whether to ignore :ast-root's siblings
+           ; defaults to true
+           :ignore-siblings? 
+           ; in onAscend, the last child of :ast (?)
+           :lch 
+           ; the root ast node passed to the visitor
+           :ast-root)
 
 (defnk visitor [:init (fn [ast state] state)
                 :onVisit (fn [ast state] state)
                        (struct-map State :ast ast-root :ast-root ast-root
                                    :stack (list ast-root) :descend? true 
                                    :next? true :next2? true 
-                                   :ignore-siblings? false))
+                                   :ignore-siblings? true))
            ascending? false]
       (cond 
-        (empty? (:stack state)) nil
+        (empty? (:stack state)) state
         ascending?
         (let [state1 (onAscend (first (:stack state))
                                (merge state 
           (cond
             (and (getch (:ast state1)) (:descend? state1))
             (let [state2 (onDescend (:ast state1) state1)]
-              (recur (assoc state2 :stack (cons (getch (:ast state2)) 
-                                                (cons (:ast state2) 
-                                                      (:stack state2))))
+              (recur (assoc state2 :stack (conz (getch (:ast state2)) 
+                                                (:ast state2) (:stack state2)))
                      false))
             (and (not (nil? (getsib (:ast state1))))
                  (:next? state1) 
                             (cons (getsib (:ast state2)) (:stack state2)))
                      false))
             true (recur state1 true)))))))
+
+(defmacro do-when 
+  "take a list of condition-expression pairs
+  and thread the immutable state through them.
+  This of course requires that each expression
+  evaluates to a new state. This will
+  act on all conditions that are true"
+  [ast-sym state-sym & rst]
+  (assert (symbol? ast-sym))
+  (assert (symbol? state-sym))
+  (assert (even? (count rst)))
+  (assert (not (empty? rst)))
+  (loop [pairs (partition 2 rst)
+         t-sym ast-sym  
+         s-sym state-sym
+         code ()]
+    (if (empty? pairs) `(->> ~@(conj code s-sym))
+      (let [[c e] (first pairs)
+            exp (postwalk-replace {ast-sym t-sym state-sym s-sym} e)
+            s1-sym (gensym)
+            t1-sym (gensym)]
+        (recur (rest pairs) t1-sym s1-sym
+               (conj code 
+                     `(let [c# ~c
+                            ~s1-sym (if c# ~exp ~s-sym)
+                            ~t1-sym (if c# (:ast ~s-sym) ~t-sym)]))))))
+
+  )
+
+(deftest test-do-when
+         (let [v (visitor 
+                   :onVisit (fn [t s]
+                              (do-when t s
+                                       (matches? t ({t IntegerLiteral attr? value}))
+                                       (assoc s :v (attr t 'value))
+                                       (matches? t (IntegerLiteral))
+                                       (if (not (attr? t 'value))
+                                         (assoc s :v nil)
+                                         s))))
+               a (make-ast! (IntegerLiteral))
+               b (make-ast! (IntegerLiteral))]
+           (attr! a 'value 5)
+           (is (= 5 (:v (v a)))) 
+           (is (= nil (:v (v b)))))
+         ) 
+
+
+(defn printastx [printer ast indent]
+  (let [a (.toString ast)
+        h (.attributes ast)]
+    (.print printer a)
+    (.print printer "{")
+    (let [kv (drop-last (interleave 
+                          (for [k (keys h)]
+                            (let [kstr (print-str k)
+                                  vstr (cond (= k 'type) (format2 (get h k)) 
+                                             true (print-str (get h k)))]
+                              (str kstr "=" vstr))) 
+                          (repeat ", ")))]
+      (last (for [x kv] (.print printer x))))
+    (.println printer "}")))
+
+
+(defnk dump-ast [ast-root :printer printastx :printstream System/out]  
+  (let [v (visitor
+            :init (fn [t state] (merge state {:ps printstream