Commits

ariovistus  committed 0170e49

playing with a functional visitor.
beginning general semantic loop
beginning typeof, auto decl, string mixin rewrites

  • Participants
  • Parent commits 45da7ba

Comments (0)

Files changed (9)

 CLOJURE=/home/ellery/Downloads/clojure/clojure.jar
 CLOJURE_CONTRIB=/home/ellery/Downloads/clojure-contrib/target/clojure-contrib-1.2.0.jar
 JLINE=/usr/share/java/jline.jar
-exec java ${JAVA_OPTS} -cp $D_JVM_CC:$CLOJURE:$CLOJURE_CONTRIB:$JLINE:. jline.ConsoleRunner clojure.main "$@"
+for x in $D_JVM_CC $CLOJURE $CLOJURE_CONTRIB $JLINE; do
+	if [ ! -f $x ]; then
+		echo "cannot find $x !"
+		exit 1
+	fi
+done
+exec java ${JAVA_OPTS} -cp $D_JVM_CC:$CLOJURE:$CLOJURE_CONTRIB:$JLINE:`dirname $0`/src jline.ConsoleRunner clojure.main "$@"

File grammars/sem.g

 aliasDecl:
     #(Alias (attributes)? type Identifier (aliasDeclList)? )
 ;
+decl:
+    #(DECLARATION type Identifier 
+	(functionBody
+	|initializer (declaratorIdentifierList)?
+	|declaratorIdentifierList)?)
+;
 unExp:
     // unary or binary
     #(And_bitwise exp (exp)? )

File src/org/d/compiler/ast_utils.clj

         h (.attributes ast)]
     (.print printer a)
     (.print printer "{")
-    (let [kv (drop-last (interleave (for [k (keys h)]
-            (let [kstr (print-str k)
-                  vstr (print-str (get h k))]
-              (str kstr "=" vstr))) (repeat ", ")))]
+    (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 "}")))
 
 
 ;;;; visitor state manipulators ;;;;
 
-(defn stacksz [state] (. (. state stack) size))
+(defn stacksz [state] (.. state stack size))
+
 (defn stacknth [state n] 
   (if (= 0 (stacksz state)) 
     nil
-    (. (. state stack) get n)))
+    (.. state stack (get n))))
 
 (defnk rewrite! 
   "replaces ast with the result of rewriter! and performs any 
   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 "
+  and its siblings, however, it should not modify ast's parents.  "
   [ast state rewriter! :skipsibs? false]
   (let [par (stacknth state 0)
         nxt (.getNextSibling ast)
   (attr! ast 'errmsg msg)
   nil)
 
+(defn move-last-error! [astfr astto]
+  (let [er (.remove (. astfr attributes) 'err)
+        ermsg (.remove (. astfr attributes) 'errmsg)]
+    (when er 
+      (attr! astto 'err true)
+      (attr! astto 'errmsg ermsg))))
+
 ;;;;; The AST MATCHER ;;;;;;;
 
 (defn spec-terminal? [x] (or (symbol? x) (map? x)))
       'Cfloat 'Cdouble 'Creal 'Void 'True 'False 
       'Null 'This 'Super 'Template 'Class 'Interface
       'FUNCTION 'Function 'DELEGATE 'Delegate
-      'Auto } 
+      'Auto 'Alias 'Typedef } 
     (. (str token) toLowerCase)
     'Dot "."
     'Assign "="
   ast EXP - ast to insert into constructed ast
   ch SYMBOL - specifies how to attach children to this node.
   SYMBOL may be:
-  null - discard existing children (default)
+  null - discard existing children 
   pp - prepend constructed children onto existing children
   ap - append constructed children onto existing children 
   sib SYMBOL - specifies how to attach siblings to this node.

File src/org/d/compiler/d_type.clj

 (ns org.d.compiler.d-type
+  "special identifiers used here: __auto - signals a to-be-deduced type for
+  d2 auto functions
+  ast attributes used here:
+  "
   (:import 
     (org.d.model Type MyAST Visitor2 Visitor2$State)
     )
               (do (assert (and (not (.isEmpty (. state stack)))
                                (matches? (.get (. state stack) 0) (AUTO_DECL))))
                 (let [[xsd i] (decl-seq ast) ]
-                  (list xsd (make-ast! (Auto)) i))) ;cheap spoof
+                  ;cheap spoof
+                  (list xsd (make-ast! (BASIC_TYPE 
+                                         (ID_LIST {t Identifier 
+                                                   s "__auto"}))) i))) 
               (BASIC_TYPE) (basic-bop ast state)))
 
 (defn normalize! 
                              {t IntegerLiteral s "5"}))))
          (let [a (parse2 "const(int)[1] i;" type_i)
                b (normalize! (cpTree a) nil)]
-           (is (matches? b (TYPE_MOD (SARRAY_DECL (BASIC_TYPE Int) {t IntegerLiteral s "1"}) Const))))
-         )
+           (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)]
+           (is (matches? b (AUTO_DECL ATTRIBUTES 
+                                      (PARAM_SPEC 
+                                        (BASIC_TYPE 
+                                          (ID_LIST 
+                                            {t Identifier 
+                                             s "__auto" 
+                                             sib? false})) 
+                                        PARAMETERS) 
+                                      Identifier
+                                      FUNCTION_BODY)))
+         ))
 
 (defn normalize-all! [ast-root] 
   (let [td (proxy [Visitor2] [] 

File src/org/d/compiler/misc.clj

 ; some miscellaneous ast rewrites
 ; replace some rewrites which occur[red] in presem.g
 (ns org.d.compiler.misc
+  " ast attributes used here: 
+  'mixinstr - mixin string of a subtree if it was the result of a 
+  string mixin
+  'mixinstr-t - type of 'mixinstr
+  "
   (:import 
     (org.d.model MyAST Visitor2 Visitor2$State)
     (org.d MatchException))
   (:use (clojure test))
   (:use (clojure.contrib macro-utils ))
   (:use 
-    (org.d.compiler d-type utils ast-utils)))
+    (org.d.compiler d-type utils ast-utils type-deduce)))
 
 (defn rewrite-templated-decl! 
   "
               ({t MINUSMINUSPRE nch 1} {ast-> e}) 
               (make-ast! (Minus_assign {ast e} {t IntegerLiteral s "1"}))))
 
-(defn rewrites-1! [ast-root]
+(defn decl-split? [ast]
+  (matches-any? 
+    ast
+    (DECLARATION {} Identifier {t? INITIALIZER} DECL_EXTRAS)
+    (AUTO_DECL ATTRIBUTES AUTO_ASSIGN AUTO_ASSIGN)
+    (Alias {t? ATTRIBUTES} {} Identifier ALIAS_LIST)
+    (Typedef {t? ATTRIBUTES} {} Identifier {t? INITIALIZER} DECL_EXTRAS)
+    ))
+
+(defn decl-split-rewrite!
+  "rewrites type x,y,z as type x; type y; type z;
+  etc"
+  [ast state]
+  (match-case 
+    ast 
+    (DECLARATION {ast-> t} {t Identifier ast-> i1} 
+                 {t? INITIALIZER ast/?-> ini} {t DECL_EXTRAS ast-> dx})
+    (let [decls (map #(match-case 
+                        % 
+                        (DECL_ASSIGN {t Identifier ast-> id} 
+                                     {t? INITIALIZER})
+                        (make-ast! (DECLARATION {ast (cpTree t)}
+                                                {ast id sib ap})))
+                     (children dx))]
+      (setsib! (if ini? ini i1) nil)
+      (last (map (fn [[a,b]] (setsib! a b)) (partition 2 1 (cons ast decls))))
+      ast)
+
+    (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)} 
+                                            {ast % sib null})) 
+                     (ast&siblings a2))]
+      (setsib! a1 nil)
+      (last (map (fn [[a,b]] (setsib! a b)) (partition 2 1 (cons ast decls))))
+      ast)
+
+    (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})))
+                     (children al))]
+      (setsib! i nil)
+      (last (map (fn [[a,b]] (setsib! a b)) (partition 2 1 (cons ast decls))))
+      ast)
+
+    (Typedef {t? ATTRIBUTES ast/?-> atrn} {ast-> t} {t Identifier ast-> i} 
+             {t? INITIALIZER ast/?-> ini} {t DECL_EXTRAS ast-> dx})
+    (let [decls (map #(match-case 
+                        %
+                        (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}))))
+                     (children dx))]
+      (setsib! (if ini? ini i) nil)
+      (last (map (fn [[a,b]] (setsib! a b)) (partition 2 1 (cons ast decls))))
+      ast)))
+
+
+(defn rewrites-1!
+  "any rewrites which occur directly after parsing
+  and before semantic analysis"
+  [ast-root]
   (let [td 
         (proxy [Visitor2] [] 
           (onVisit [ast state]
     (.visit td ast-root)
     (. (. td getState) t0)))
 
-(defn expand-auto-decl-ready? [ast]
+(defn expand-auto-decl? [ast]
   (match-case 
     ast
-    (AUTO_DECL {t ATTRIBUTES ast-> attrs} {t AUTO_ASSIGN ast-> asgs})
-    (assert false)
-    ;(all #(attr? % 'type) (ast&siblings asgs))
-    (AUTO_DECL {t DECLARATOR ast-> d} {t FUNCTION_BODY ast-> f})
-    (assert false)
+    (AUTO_DECL ATTRIBUTES  
+               ({t AUTO_ASSIGN sib? false} 
+                Identifier {t INITIALIZER ast-> ini}))
+    (attr? ini 'type)
+    (AUTO_DECL ATTRIBUTES (PARAM_SPEC (BASIC_TYPE 
+                                          (ID_LIST 
+                                            {t Identifier s "__auto"})) 
+                                      PARAMETERS) 
+               Identifier {t FUNCTION_BODY ast-> f})
+    (attr? f 'type)
+    (IF_COND Auto Identifier {ast-> e})
+    (attr? e 'type)
+    false))
+
+(defn expand-auto-decl!  [ast state]
+  (match-case 
+    ast
+    (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))]
+      (make-ast! (DECLARATION {ast t} {ast i})))
+    (AUTO_DECL {t ATTRIBUTES ast-> atrn}
+               ({t PARAM_SPEC ast-> ps} 
+                ({t BASIC_TYPE ast-> b} (ID_LIST {t Identifier s "__auto"})) 
+                PARAMETERS) 
+               Identifier
+               {t FUNCTION_BODY ast-> f})
+    (let [t (cpTree (attr f 'type))
+          a1 (filter #(not (matches? % (Auto))) (children atrn))
+          _ (last (map #(setsib! % nil) (children atrn)))
+          decl (make-ast! (DECLARATION {ast ps}))]
+      (assert t)
+      (setch! ps t)
+      (setsib! t (getsib b))
+      (setsib! b nil)
+      (if (empty? a1) decl
+        (do
+        (last (map (fn [[a,b]] (setsib! a b)) (partition 2 1 a1)))
+        (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))]
+      (assert t)
+      (setch! ast t)
+      (setsib! a nil)
+      (setsib! t i)
+      ast)
+    ))
+
+; todo: implement expand-typeof for typeof(x).y.z
+; todo: implement expand-typeof for template mixins
+; 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} ({Typeof exp? true sib? true} {ast-> e})) e)]
+    (attr? e 'type)))
+
+(defn expand-typeof-rewrite! [ast state]
+  (match-case 
+    ast
+    (BASIC_TYPE (Typeof {ast-> e})) 
+    (cpTree (attr e 'type))
+    ({t Dot exp? true} 
+     ({Typeof exp? true ast-> ty} {ast-> e})
+     {t Identifier ast-> i}) 
+    (let [t (cpTree (attr e 'type))]
+      (setch! ast t)
+      (setsib! t i)
+      (setsib! ty nil)
+      ast)))
+
+(defn rewrites-2! [ast-root]
+  (let [td 
+        (proxy [Visitor2] [] 
+          (onVisit [ast state]
+                   (when (expand-auto-decl? ast)
+                     (rewrite! ast state expand-auto-decl!)
+                     ))
+          ) ]
+    (.visit td ast-root)
+    (. (. td getState) t0)))
+
+(defn testa []
+  (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))))))
+
+(defn str-mixin? [ast]
+    (match-case 
+      ast
+      ({} {exp? true ast-> e})
+      (and 
+        (matches-any? ast (MIXIN_EXPRESSION) (MIXIN_DECLDEF) (MIXIN_STATEMENT))
+        (attr? e 'type) (attr? e 'value))
+      false))
+
+
+#_(defn str-mixin! 
+    "this is not to be passed to rewrite!. Attempts to parse 
+    the mixin string and replaces ast with the result if 
+    it succeeds"
+    [ast state]
+    (match-case 
+    ast
+    ({} {exp? true ast-> e})
+    (let [t (attr e 'type)
+          v (attr e 'value)]
+      (letfn [bazooka! ([parser mxnstr mxnstrt]
+                        (match-case 
+                          ast
+                          (MIXIN_DECLDEF) (. parser declDefs)
+                          (MIXIN_EXPRESSION) (. parser exp)
+                          (MIXIN_STATEMENT) (. parser statement))
+                        (if (zero? (.errorCount parser))
+                          (let [mxn (.getAst parser)]
+                            (attr! mxn 'mixinstr mxnstr)
+                            (attr! mxn 'mixinstr-t mxnstrt)
+                            (rewrites-1! mxn)
+                            (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))))]
+      (cond 
+        (=t= t STRING)
+        (let [stream (InputStreamReader. (ByteArrayInputStream. v))
+              lexer (D2Lexer. stream)
+              parser (D2Parser. lexer)]
+          (.initWithLines parser)
+          (bazooka! parser v STRING))
+        (=t= t WSTRING)
+        (=t= t DSTRING))
+  )))
+
+(defn testb []
+

File src/org/d/compiler/semantic.clj

+(ns org.d.compiler.semantic
+  (:use (org.d.compiler ast-utils misc type-deduce))
+  )
+
+(defn semantic-blast 
+  "1 round of semantic analysis
+  type deduction - check
+  symbol table population - check
+  auto decl rewrites - todo
+  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)))

File src/org/d/compiler/symbol.clj

 (ns org.d.compiler.symbol
   " ast attributes used in here:
   'scope: { String: #{AST or DPackage} }
+  'scoped: true - receipt that symbols in this subtree have been 
+  entered into the symbol table
   'imports: #{AST<IMPORT>}
   'labels: { String: AST }
   'prot: [AST]
     ; careful here
     (DECLARATION PARAM_SPEC) 
     (AMBIG_DECLARATION PARAM_SPEC) 
-    (AUTO_DECL DECLARATOR)))
+    (AUTO_DECL DECLARATOR)
+    ))
 
 (defn decl-scoped? 
   "these trees have symbol tables and
         (recur (rest stack) prot stor algn pragmas)
         ))))
 
-(defn get-symbols [ast state]
+(defn get-symbols 
+  "retrieve symbols from ast, if any.
+  Avoid retrieving symbols from an ast
+  which is likely to be rewritten."
+  [ast state]
   (match-case
     ast 
     (Enum {t Identifier ast-> i}) [i]
     (Template {t Identifier ast-> i}) [i]
     (ENUM_MEMBER {ast?-> type?} {t Identifier ast-> i}) [i]
     (Typedef {t? ATTRIBUTES} {} {t Identifier ast-> i} 
-             {t? INITIALIZER} {t? DECL_EXTRAS ast/?-> d})
-    (cons i (map getch (if d? (children d) ())))
+             {t? INITIALIZER sib null}) [i]
     (Alias {t Identifier ast-> i} This) [i]
-    (Alias {t? ATTRIBUTES} {} {t Identifier ast-> i}
-           {t? ALIAS_LIST ast/?-> a})
-    (cons i (if a? (children a) ()))
-    (DECLARATION {} {t Identifier ast-> i} 
-                 {t? INITIALIZER} {t? DECL_EXTRAS ast/?-> d})
-    (cons i (map getch (if d? (children d) ())))
-    (AMBIG_DECLARATION {} {t Identifier ast-> i} 
+    (Alias {t? ATTRIBUTES} {} {t Identifier ast-> i sib null}) [i]
+    (DECLARATION {} {t Identifier ast-> i} {t? INITIALIZER sib null}) [i]
+    #_(AMBIG_DECLARATION {} {t Identifier ast-> i} 
                        {t? INITIALIZER} {t? DECL_EXTRAS ast/?-> d})
-    (cons i (map getch (if d? (children d) ())))
-    (AUTO_DECL ATTRIBUTES {} {t Identifier ast-> i})
-    [i]
-    (AUTO_DECL ATTRIBUTES {ast-> a})
-    (map #(match-case % (AUTO_ASSIGN {t Identifier ast-> i}) i) 
+    ;(cons i (map getch (if d? (children d) ())))
+
+    ;(AUTO_DECL ATTRIBUTES {} {t Identifier ast-> i})
+    ;[i]
+    ;(AUTO_DECL ATTRIBUTES {ast-> a})
+    #_(map #(match-case % (AUTO_ASSIGN {t Identifier ast-> i}) i) 
          (ast&siblings a))
     ; not quite correct, but good enough (only D1 has inout)
     (FOREACH_TYPE {t? Ref} {t? Inout} {} {t Identifier ast-> i}) [i]
-    (FOREACH_TYPE {t? Ref} {t? Inout} {t Identifier ast-> i}) [i]
-    (Mixin) 
-    (let [i (last (children ast))]
+    ;(FOREACH_TYPE {t? Ref} {t? Inout} {t Identifier ast-> i}) [i]
+    #_(Mixin) 
+    #_(let [i (last (children ast))]
       (cond (nil? i) []
             (matches? i (Identifier)) [i]
             true []))
     []))
 
 (defn put-sym! [scope sym ast]
+  (attr! ast 'scoped true)
   (if (.containsKey scope sym)
     (.add (get scope sym) ast)
     (let [x (HashSet.)]
                 (LABEL {t Identifier s-> i})
                 (if (get (attr body 'labels) i)
                   (error! ast (str "label " i " already declared"))
-                  (.put (attr body 'labels) i ast)))))
+                  (do
+                    (attr! ast 'scoped true)
+                    (.put (attr body 'labels) i ast))))))
 
 (defn rm_attrs [ast state]
   (let [block (match-case ast
                        (D_C_BLOCK {ast/?-> d}) d)]
     dx))
 
-(defn populate! [ast-root] 
+(defn populate! 
+  "demo of this module"
+  [ast-root] 
   (let [td 
         (proxy [Visitor2] [] 
           (onVisit [ast state]

File src/org/d/compiler/type_deduce.clj

 (ns org.d.compiler.type-deduce
+  " ast attributes used in here:
+  'type AST deduced expression type
+  'initializer _ reports that subtree has nonexpression initializer under it
+  "
   (:import (org.d.model Type Visitor2 MyAST)
            (java.io BufferedWriter OutputStreamWriter ByteArrayOutputStream)
            (java.util Arrays)
 
 (defn wrap-type [tipo]
   (let [x (make-ast! (Dot))]
+    (assert tipo)
     (attr! x 'type tipo)
     x))
 
+(defn toaa 
+  "take an ast whose childrens' types are 2-ary tuples
+  and derive an associative array type V[K], where K is
+  the common type for tuples[0] and V is the common type
+  for tuples[1]."
+  [ast state]
+  (assert (matches-any? ast (ARRAY_LIT) (ARRAY_INITIALIZER)))
+  (let[; list of tuple types
+       tuples (map #(attr % 'type) (children ast))
+       ; list of [bogus] asts containing key types
+       key-ts (map #(wrap-type (match-case % (TUPLE {ast-> t}) t)) tuples)
+       ; list of [bogus] asts containing value types
+       val-ts (map #(wrap-type (match-case % (TUPLE {} {ast-> t}) t)) tuples)
+       ; type combine the key types into ast with type attr
+       key-t (oreduce #(wrap-type (combine-t ast %1 %2 state)) 
+                      #(or (nil? %) (not (attr? % 'type))) key-ts)
+       ; type combine the value types into ast with type attr
+       val-t (oreduce #(wrap-type (combine-t ast %1 %2 state)) 
+                      #(or (nil? %) (not (attr? % 'type))) val-ts)
+       keyt (and key-t (attr key-t 'type))
+       valt (and val-t (attr val-t 'type))]
+    (if (or (nil? keyt) (nil? valt)) nil
+      (make-aarray-t keyt valt))))
+
 (defn arr-lit-t [ast state]
   (cond 
     (empty? (children ast))
     (do )
     (all #(matches? % (KEY_VAL)) (children ast)) 
-    (let[; list of tuple types
-         tuples (map #(attr % 'type) (children ast))
-         ; list of [bogus] asts containing key types
-         key-ts (map #(wrap-type (first (children %))) tuples)
-         ; list of [bogus] asts containing value types
-         val-ts (map #(wrap-type (second (children %))) tuples)
-         ; type combine the key types into ast with type attr
-         key-t (oreduce #(wrap-type (combine-t ast %1 %2 state)) 
-                        #(nil? (attr % 'type)) key-ts)
-         ; type combine the value types into ast with type attr
-         val-t (oreduce #(wrap-type (combine-t ast %1 %2 state)) 
-                        #(nil? (attr % 'type)) key-ts)
-         keyt (attr key-t 'type)
-         valt (attr val-t 'type)]
-      (if (or (nil? keyt) (nil? valt)) nil
-        (make-aarray-t keyt valt)))
+    (let[ aat (toaa ast state)]
+      aat)
 
     (all #(not (matches? % (KEY_VAL))) (children ast)) 
-    (let [rt-wrap (oreduce #(wrap-type (combine-t ast %1  %2 state))
-                           #(nil? (attr % 'type)) (children ast)) ]
+    (let [rt-wrap (oreduce #(wrap-type (combine-t ast %1 %2 state))
+                           #(or (nil? %) (not (attr? % 'type))) (children ast))]
       (if (or (nil? rt-wrap) (nil? (attr rt-wrap 'type))) nil
         (make-darray-t (attr rt-wrap 'type))))
     true (error! ast (str "either your aa is screwed up or you're "
-                     "out of luck because I'm not implementing "
-                     "index spec in array literals just now"))))
+                          "out of luck because I'm not implementing "
+                          "index spec in array literals just now"))))
 
 (defn key-val-t [ast lhs rhs state]
   (let [lht (attr lhs 'type) rht (attr rhs 'type)]
               (map #(not (attr? % 'type)) (children ast)))
       (list true) ; do descend an undeduced tree
       true (put-t! ast (arr-lit-t ast state) state))
-    (KEY_VAL {ast-> lhs} {ast-> rhs})
     ; array-lit-t depends on having a 2-ary tuple type on this node
-    (binop key-val-t)
+    (KEY_VAL {ast-> lhs} {ast-> rhs}) (binop key-val-t)
     (Assert {ast-> lhs} {ast-> rhs}) (binop assert2-t)
     (Assert {ast-> rhs}) (unop assert1-t)
     (MIXIN_EXPRESSION) (do (error! ast "not implemented") (list false))
       (and (not (type? rhs)) (not (attr? rhs 'type)))
       (list true) ; do descend an undeduced tree
       true (put-t! ast (typeid-t ast rhs state) state))
-    (Is) (term is-t-t)
-    (Typeof) (do (error! ast "not implemented") (list false))))
+    (Is) (term is-t-t)))
 
 (defn type-ded-initializer [ast state]
   (match-case 
     ast
     (INITIALIZER Void)
-    (list true)
+    (do 
+      (attr! ast 'initializer true)
+      (list true))
     (INITIALIZER {t ARRAY_INITIALIZER ast-> a})
     (cond
-      (all #(matches? % (Colon {} {})) (children a))
-      (all #(not (matches? % (Colon {} {}))) (children a))
+      ; associative array initializer
+      (all #(and (matches? % (Colon {} {})) (attr? % 'type)) (children a))
+      (let[aat (toaa a state)]
+        (cond 
+          (error? a) 
+          (do (move-last-error! a ast)
+            (list false))
+          aat 
+          (do
+            (attr! ast 'type aat)
+            ; don't descend cuz we found the type
+            (list false))
+          ; don't descend an error laden tree
+          ; this should be the only other alternative
+          (error? ast) (list false)))
+      ; normal array initializer with no subinitializers
+      (all #(and (not (matches? % (Colon))) (attr? % 'type)) (children a))
+      (let [rt-wrap (oreduce #(wrap-type (combine-t ast %1 %2 state))
+                             #(nil? (attr % 'type)) (children ast)) 
+            rt (attr rt-wrap 'type)]
+        (cond 
+          rt 
+          (do
+            (attr! ast 'type rt)
+            ; don't descend a deduced tree
+            (list false))
+          ; don't descend an error laden tree
+          ; this had better be the only other option
+          (error? ast) (list false)))
+      (any #(attr? % 'initializer) (children a))
+      (do 
+        (attr! ast 'initializer true) 
+        ; don't descend this - waste of time
+        (list true))
+      ; do descend tree
+      true (list true))
     (INITIALIZER STRUCT_INITIALIZER)
-  )
+    (do
+      (attr! ast 'initializer true)
+      ; don't descend this - waste of time
+      (list true))
+    (INITIALIZER {exp? true ast-> exp})
+    (if (attr? exp 'type)
+      (do
+        (attr! ast 'type (attr exp 'type))
+        (list false))
+      (list true))))
+
+(defn type-ded-colon [ast state]
+  (match-case ast
+              (Colon {ast-> lhs} {ast-> rhs})
+              (cond
+                (or (attr? lhs 'initializer)
+                    (attr? rhs 'initializer))
+                (do
+                  (attr! ast 'initializer true)
+                  (list true))
+                (and (attr? lhs 'type)
+                     (attr? rhs 'type))
+                (do
+                  (attr! ast 'type (make-tuple-t (attr lhs 'type) 
+                                                 (attr rhs 'type)))
+                  (list false))
+                true (list true))))
+
+(defn all-ded [ast state]
+  (cond
+    (error? ast) false
+    (and (exp? ast) (not (attr? ast 'type)))
+    (let [[descend] (type-ded ast state)]
+      descend)
+    (and (matches? ast (INITIALIZER)) 
+         (not (attr? ast 'type))
+         (not (attr? ast 'initializer)))
+    (let [[descend] (type-ded-initializer ast state)]
+      descend)
+    (and (matches? ast (Colon))
+         (not (attr? ast 'type))
+         (not (attr? ast 'initializer))
+         (> (count (. state stack)) 0)
+         (matches? (.peek (. state stack)) 
+                   (ARRAY_INITIALIZER)))
+    (let [[descend] (type-ded-colon ast state)]
+      descend)
+    true true))
+
 (defn testi [ast] 
   (let [ td (proxy [Visitor2] [] 
               (onVisit [ast state]
-                       (when (exp? ast) 
-                         (set! (. state descend) false)
-                         (when (not (attr? ast 'type))
-                           (let [[descend] (type-ded ast state)]
-                             (set! (. state descend) descend))))
-                       (when (matches? ast (INITIALIZER))
-                         (let [[descend] (type-ded-initializer ast state)]
-                          (set! (. state descend) descend)))
-                       )
+                       (let [descend (all-ded ast state)]
+                         (set! (. state descend) descend)))
               (onAscend [ast state]
-                        (if (and (exp? ast) (not (contains? (.attributes ast) 'type)))
-                          (let [[descend] (type-ded ast state)]))))]
+                        (all-ded ast state)
+                        ))]
     (.visit td ast)))
 

File 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))
+
+(defstruct State :ast :stack :descend? :next? :next2? 
+           :ignore-siblings? :lch :ast-root)
+
+(defnk visitor [:init (fn [ast state] state)
+                :onVisit (fn [ast state] state)
+                :onDescend (fn [ast state] state )
+                :onAscend (fn [ast state] state)
+                :onNext (fn [ast state] state)
+                :onNext2 nil]
+  (fn [ast-root]
+    (loop [state (init ast-root 
+                       (struct-map State :ast ast-root :ast-root ast-root
+                                   :stack (list ast-root) :descend? true 
+                                   :next? true :next2? true 
+                                   :ignore-siblings? false))
+           ascending? false]
+      (cond 
+        (empty? (:stack state)) nil
+        ascending?
+        (let [state1 (onAscend (first (:stack state))
+                               (merge state 
+                                      {:ast (first (:stack state))
+                                       :lch (:ast state)
+                                       :stack (rest (:stack state))
+                                       :next2? true}))]
+          (if (and (getsib (:ast state1))
+                   (:next2? state1)
+                   (not (and (empty? (:stack state1))
+                             (:ignore-siblings? state1))))
+            (let [state2 ((or onNext2 onNext) (:ast state1) state1)]
+              (recur (assoc state2 :stack (cons (getsib (:ast state2)) 
+                                                (:stack state2))) false))
+            (do (recur state1 true))))
+        true
+        (let [state1 (onVisit (first (:stack state)) 
+                              (merge state {:ast (first (:stack state))
+                                            :stack (rest (:stack state))
+                                            :descend? true :next? true}))]
+          (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))))
+                     false))
+            (and (not (nil? (getsib (:ast state1))))
+                 (:next? state1) 
+                 (not (empty? (:stack state1))))
+            (let [state2 (onNext (:ast state1) state1)]
+              (recur (assoc state2 :stack 
+                            (cons (getsib (:ast state2)) (:stack state2)))
+                     false))
+            true (recur state1 true)))))))