ariovistus avatar ariovistus committed a83797c

* removed ref from statement and decl level declarations
* added a fparse2, which reads directly from a file
* added primitives pushch! and popch!, which insert or remove
the first child of an ast.
* moved misc to preproc and rewrites-1! to preprocess!, as it
is an essential part of semantic analysis. also moved some
stuff to semantic
* added the rewrite thisexp.newexp -> (newexp thisexp ..)
haven't told Formatter about it yet.
* cleaned up normalize! a bit, fixed it for mulidim static arrays
ensured that immutable/const/shared contract as necessary
* type modifiers which end up in storage classes are applied to
declaration types now
* added a find-ast visitor. want a lazy-visitor implementation.
* added Utf32Reader, which is just a wrapper around int[]

Comments (0)

Files changed (15)

grammars/parsed2.g

     |Nothrow
     |Override
     |Pure
-    |Ref
     |Scope
     |(Shared ~(Lparth))=> Shared
     |Static

grammars/postparse2.g

     |Nothrow
     |Override
     |Pure
-    |Ref
     |Scope
     |Shared
     |Static
     |basicType
     |#(TUPLE (type)+)
 ;
+basicType:
+    #(BASIC_TYPE 
+	    (EMPTY_ARR_ELT
+            |baseType
+	    |Dot identifierList
+	    |identifierList
+	    |typeof (Dot identifierList)?))
+;
 templateArgumentList:
     #(TEMPLATE_ARGS (templateArgument)* )
 ;
 	(type Identifier
 	|(exp 
 	    (templateInstance
-	    |newExp
 	    |Identifier)?)))
     |refLiteral
     |literal
     |isExp
     |typeofExp
 ;
+
+newExp:
+    #(NEW_EXPRESSION (exp)? newArguments type (argumentList)?)
+    |#(NEW_CLASS_EXPRESSION (exp)? newArguments classArguments (baseClass)* classBody)
+;
     }
 }
 
+// auto functions get rewritten to 
+// normal functions with ret type __auto
+autoDecl:
+    #(AUTO_DECL attributes (autoAsg)+ )
+;
+
 enumDecl:
     #(Enum 
 	(Identifier type (enumBody)?
     |basicType
     |#(TUPLE (type)+)
 ;
+basicType:
+    #(BASIC_TYPE 
+	(EMPTY_ARR_ELT
+        |baseType
+	|Dot identifierList
+	|identifierList
+	|typeof (Dot identifierList)?))
+;
 constructor:
     #(CTOR 
 	(This|parameters)
 newExpression:
 // type deduction action: go through type and ensure everything instantiated
 // require type deduction of everything in new args and arg list
-    #(NEW_EXPRESSION  newArguments type (argumentList)?)
+    #(NEW_EXPRESSION (exp)? newArguments type (argumentList)?)
 // type deduction action: require type deduction of new args and class args
 // go through base classes and ensure everything instantiated
-    |#(NEW_CLASS_EXPRESSION  newArguments classArguments (baseClass)* classBody) 
+    |#(NEW_CLASS_EXPRESSION (exp)? newArguments classArguments (baseClass)* classBody) 
 ;
 numericLiteral:
     IntegerLiteral

src/org/d/Utf32Reader.java

+package org.d;
+
+import java.io.Reader;
+
+public class Utf32Reader extends Reader{
+    int[] src;
+    int next = 0;
+    public Utf32Reader(int[] src){
+        this.src = src;
+    }
+
+    public int read(){
+        return src[next++];
+    }
+
+    public int read(char[] cbuf, int off, int len){
+        if(next >= src.length) return -1;
+        int i = off;
+        while(true){
+            if( i >= (len-off) || i >= cbuf.length || next >= src.length) break;
+            i += Character.toChars(src[next],cbuf, i);
+            next++;
+        }
+        return i-off;
+    }
+
+    public void close(){}
+}

src/org/d/compiler/ast_utils.clj

 (ns org.d.compiler.ast-utils
   (:import 
     (org.d.model Formatter MyAST)
-    (java.io StringReader)
+    (java.io StringReader FileReader BufferedReader)
     (org.d.generated D2ParserTokenTypes D2Lexer D2Parser))
   (:use (clojure.contrib def macro-utils))
   (:use org.d.compiler.utils)
         (throw (.get (. p# errors) 0))
         (. p# getAST)))))
 
+(defmacro fparse2 
+  "file of d code to ast"
+  ([fnom] `(fparse2 ~fnom module))
+  ([fnom meth]
+   `(let [p# (D2Parser. (D2Lexer. (BufferedReader. (FileReader. ~fnom))))]
+      (. p# initWithLines)
+      (. p# ~meth)
+      (if (> (.errorCount p#) 0) 
+        (throw (.get (. p# errors) 0))
+        (. p# getAST)))))
+
 (declare format2) 
 
 (defn parse-exp [ast]
   (.isExp ast))
 
 (defn getch [ast] (.getFirstChild ast))
+
 (defn setch! [ast ast2] (.setFirstChild ast ast2))
+
 (defn getsib [ast] (.getNextSibling ast))
+
 (defn setsib! [ast ast2] (.setNextSibling ast ast2))
 
+(defn pushch! 
+  "add ch as ast's first child.
+  siblings of ch get hosed."
+  [ast ch]
+  #_(assert (nil? (getsib ch)))
+  (setsib! ch (getch ast))
+  (setch! ast ch)
+  ast)
+
+(defn popch! 
+  "remove ast's first child."
+  [ast]
+  (let [x (getch ast)]
+    (setch! ast (getsib x))
+    (setsib! x nil)
+    x))
+
 (defn ast&siblings 
   "lazy seq of ast and ast's siblings"
   [ast] 
     (let [type-syms (if (contains? tok :type/?->)
                       (let [tsym (get tok :type/?->)]
                         `(~tsym (cond ~(cond2 sym tok) nil 
-                                      (attr? ~sym ~'type) (attr ~sym ~'type) 
+                                      (attr? ~sym ~''type) (attr ~sym ~''type) 
                                       true nil)
                             ~(symbol (str tsym "?")) 
                             (cond ~(cond2 sym tok) false 
-                                  (attr? ~sym ~'type) true
+                                  (attr? ~sym ~''type) true
                                   true false)))
                       ())]
       (when (and (map? tok) (or (contains? tok :ast/?->) 
           Cfloat Cdouble Creal Void True False 
           Null This Super Template Class Interface
           FUNCTION Function DELEGATE Delegate
-          Auto Alias Typedef Cast) 
+          Auto Alias Typedef Cast Const Immutable Shared) 
     (. (str token) toLowerCase)
     Dot "."
     Assign "="

src/org/d/compiler/constfold.clj

   long, ulong                 long
   [i]float,float              float
   [i]double, [i]real          double
+  string                      byte[]
+  wstring                     char[]
+  dstring                     int[]
 
   This is for D code compiled to the JVM. Inside the compiler, 
   things are a bit different:
   ast attributes used here:
   'value for a value known at compile time
   "
-  (:import (java.io BufferedWriter OutputStreamWriter ByteArrayOutputStream)
-           (java.util Arrays))
-  (:use (org.d.compiler ast-utils d-type type-deduce utils visitor d-type misc)
+  (:import (java.io Reader InputStreamReader CharArrayReader 
+                    CharArrayWriter InputStream 
+                    ByteArrayInputStream ByteArrayOutputStream
+                    BufferedWriter OutputStreamWriter )
+           (java.util Arrays)
+           (org.d Utf32Reader))
+  (:use (org.d.compiler ast-utils d-type type-deduce utils visitor d-type preproc)
         (clojure.contrib math macro-utils)
         (clojure test))
 
       (atr!! (make-ast! (Cast {:ast (copy tipo)} 
                               (Minus {:t IntegerLiteral :s (str value)})))))))
 
+(defn str-v2io [ast]
+  (assert (and (attr? ast 'type) 
+               (attr? ast 'value)))
+  (cond (=t= (attr ast 'type) STRING)
+        (InputStreamReader. (ByteArrayInputStream. (attr ast 'value)))
+        (=t= (attr ast 'type) WSTRING)
+        (CharArrayReader. (attr ast 'value))
+        (=t= (attr ast 'type) DSTRING)
+        (Utf32Reader. (attr ast 'value))
+        true (assert false)))
+
+(defn io2str-v [io tipo]
+  (cond (=t= tipo STRING) 
+        (cond (instance? Reader io)
+              (let [c (char-array 1024)
+                    z (ByteArrayOutputStream.)
+                    x (OutputStreamWriter. z "UTF8")]
+                (loop [done? false]
+                  (if done? (.toByteArray z)
+                    (let [i (read c)]
+                      (if (= i -1) (recur true)
+                        (do (.write x c 0 i)
+                          (recur false)))))))
+              (instance? InputStream io)
+              (let [b (byte-array 1024)
+                    x (ByteArrayOutputStream. )]
+                (loop [done? false]
+                  (if done? (.toByteArray x)
+                    (let [i (read b)]
+                      (if (= i -1) (recur true)
+                        (do (.write x b 0 i)
+                          (recur false)))))))
+              true (assert false))
+        (=t= tipo WSTRING)
+        (cond (instance? InputStream io) (io2str-v (InputStreamReader. io) tipo)
+              (instance? Reader io)
+              (let [c (char-array 1024)
+                    x (CharArrayWriter.)]
+                (loop [done? false]
+                  (if done? (.toCharArray x)
+                    (let [i (read c)]
+                      (if (= i -1) (recur true)
+                        (do (.write x c 0 i)
+                          (recur false)))))))
+              true (assert false))
+        (=t= tipo DSTRING) (assert false)
+        true (assert false)))
+
 (defn str-lit-v [ast state]
   (let [s (.getText ast)
         [e1,tipo] (case (last s)
                          (attr! one 'value 1)
                          (attr! two 'value 2)
                          (last (map #(attr! % 'type INT) [a,one,add2,A,two])))]
-           (let [a (rewrites-1! (parse2 "1+(a+2);" exp))]
+           (let [a (preprocess! (parse2 "1+(a+2);" exp))]
              (is (= "1 + a + 2" (format2 a)))
              (is (matches? a (Add IntegerLiteral Add)))
              (match-case a (Add {:ast-> one} ({:ast-> add2} {:ast-> A} {:ast-> two}))
                              (is (= "1 + 2 + a" (format2 b)))
                              (is (matches? b (Add Add Identifier)))
                              ))))
-           (let [a (rewrites-1! (parse2 "1+(2+a);" exp))]
+           (let [a (preprocess! (parse2 "1+(2+a);" exp))]
              (is (= "1 + 2 + a" (format2 a)))
              (is (matches? a (Add IntegerLiteral Add)))
              (match-case a (Add {:ast-> one} ({:ast-> add2} {:ast-> two} {:ast-> A}))
                              (is (= "1 + 2 + a" (format2 b)))
                              (is (matches? b (Add Add Identifier)))
                              ))))
-           (let [a (rewrites-1! (parse2 "(a+1)+2);" exp))]
+           (let [a (preprocess! (parse2 "(a+1)+2);" exp))]
              (is (= "a + 1 + 2" (format2 a)))
              (is (matches? a (Add Add IntegerLiteral)))
              (match-case a (Add ({:ast-> add2} {:ast-> A} {:ast-> one}) {:ast-> two})
                              (is (= "a + 1 + 2" (format2 b)))
                              (is (matches? b (Add Identifier Add)))
                              ))))
-           (let [a (rewrites-1! (parse2 "(1+a)+2);" exp))]
+           (let [a (preprocess! (parse2 "(1+a)+2);" exp))]
              (is (= "1 + a + 2" (format2 a)))
              (is (matches? a (Add Add IntegerLiteral)))
              (match-case a (Add ({:ast-> add2} {:ast-> one} {:ast-> A}) {:ast-> two})

src/org/d/compiler/d_type.clj

               (let [[xsb newbasic] (type-seq tipo state)
                     xs (cons (type-mod-unraw mod) xsb)]
                 (list xs newbasic))
-              (BASIC_TYPE) (list '() basic)))
+              (BASIC_TYPE) (list () basic)))
 
 (defn basic2-bop [basic2 stack dir]
   (match-case basic2
   int[1][2][8][7][3][4][6][5] i;
 
   Other rewrites:
-  Function pointers:  int (*i)(char); -> int function(char) i;
-  static arrays:      const(int)[N] i; -> const(int[N]) i; etc
+  Function pointers:  T (*i)(U); -> T function(U) i;
+  static arrays:      mod(T)[N] -> mod(T[N]) 
+  modifiers:          immutable (const or shared(T)) -> immutable(T), and same when immutable is inner
+                      mod (mod(T)) -> mod(T)
+                      immutable(shared(T)) -> immutable(T)
+                      shared(immutable(T)) -> immutable(T)
+                      const(shared(T))     -> shared(const(T))
 
   parameters:
   ast - an AST rooted at TYPE or TYPE_I as defined in postparse2.g
                       ret))]
       (if (empty? bt2) (put-i! bt)
         (do 
-          (loop [b (first bt2) lst (rest bt2) par nil ret b]
+          (loop [b (first bt2) lst (rest bt2) pars () ret b]
+            (assert (or (empty? pars) (= b (getch (first pars)))))
             (if (empty? lst) 
-              (let [s (getch b)]
-                (setch! b bt)
-                (setsib! bt s)
+              (do
+                (pushch! b bt)
                 (put-i! ret))
               (cond
-                (matches? b (POINTER)) 
+                (and (matches? b (POINTER)) 
+                     (matches? (first lst) (PARAM_SPEC)))
                 (match-case 
                   (first lst)
                   (PARAM_SPEC {:t? TEMPLATE_PARAMETERS :ast?-> tpl?} 
                               {:t PARAMETERS :ast-> p} 
                               {:t? POSTFIX :ast/?-> post})
                   (if tpl?
-                    (let [s (getch b)]
+                    (do
                       (error! b  "Template parameter does not belong here")
-                      (setch! b (first lst))
-                      (setsib! (first lst) s)
-                      (recur (first lst) (rest lst) b ret))
+                      (pushch! b (first lst))
+                      (recur (first lst) (rest lst) (cons b pars) ret))
                     (let [f (do (setsib! (if post? post p) nil)
-                              (make-ast! (FUNCTION {:ast p})))
-                          s (getsib b)]
-                      (if (nil? par) (recur f (rest lst) par f)
-                        (do (assert (= (getch par) b))
-                          (setch! par f)
-                          (setsib! f s)
-                          (recur f (rest lst) par ret)))))
-                  (let [s (getch b)]
-                    (setch! b (first lst))
-                    (setsib! (first lst) s)
-                    (recur (first lst) (rest lst) b ret)))
-                (matches? b (SARRAY_DECL))
-                (match-case 
-                  (first lst)
-                  (TYPE_MOD)
-                  (let [s (getch (first lst))
-                        s2 (getch b)]
-                    (setch! (first lst) b)
-                    (setsib! b s)
-                    (if (nil? par)
-                      (recur b (rest lst) (first lst) (first lst))
-                      (do 
-                        (setch! par (first lst))
-                        (setsib! (first lst) s2)
-                        (recur b (rest lst) (first lst) ret))))
-                  (let [s (getch b)]
-                    (setch! b (first lst))
-                    (setsib! (first lst) s)
-                    (recur (first lst) (rest lst) b ret)))
-                true (let [s (getch b)]
-                       (setch! b (first lst))
-                       (setsib! (first lst) s)
-                       (recur (first lst) (rest lst) b ret))))))))))
+                              (make-ast! (FUNCTION {:ast p}))) ]
+                      (when (not (empty? pars))
+                        (pushch! (first pars) f))
+                      (recur f (rest lst) pars (if (empty? pars) f ret)))))
+                (and (matches? b (SARRAY_DECL))
+                     (matches? (first lst) (TYPE_MOD)))
+                (if (empty? pars) 
+                  (recur (first lst) (cons b (rest lst)) pars (first lst))
+                  (do (popch! (first pars))
+                    (recur (first pars) (conz (first lst) b (rest lst)) (rest pars) ret)))
+                (and (matches-any? b (TYPE_MOD Shared) (TYPE_MOD Const))
+                     (matches? (first lst) (TYPE_MOD Immutable)))
+                (do ;backtrack a bit on this one
+                  (when (not (empty? pars)) 
+                    (popch! (first pars)) 
+                    (pushch! (first pars) (first lst)))
+                  (recur (first lst) (rest lst) pars (if (empty? pars) (first lst) ret)))
+                (and (matches? b (TYPE_MOD Immutable))
+                     (matches-any? (first lst) (TYPE_MOD Shared) (TYPE_MOD Const) (TYPE_MOD Immutable)))
+                (recur b (rest lst) pars ret)
+                (and (matches? b (TYPE_MOD Const))
+                     (matches? (first lst) (TYPE_MOD Const)))
+                (recur b (rest lst) pars ret)
+                (and (matches? b (TYPE_MOD Const))
+                     (matches? (first lst) (TYPE_MOD Shared)))
+                (if (empty? pars) 
+                  (recur (first lst) (cons b (rest lst)) pars (first lst))
+                  (do (popch! (first pars))
+                    (recur (first pars) (conz (first lst) b (rest lst)) (rest pars) ret)))
+                (and (matches? b (TYPE_MOD Shared))
+                     (matches? (first lst) (TYPE_MOD Shared)))
+                (recur b (rest lst) pars ret)
+                true (do 
+                       (pushch! b (first lst))
+                       (recur (first lst) (rest lst) (cons b pars) ret))))))))))
 
 (deftest test-normalize
          (let [a (parse2 "int i[];" type_i)
                b (normalize! a nil)]
+           (is (= (format2 b) "int[]"))
            (is (matches? b (DARRAY_DECL (BASIC_TYPE Int))))
-           (is (matches? (getsib b) ({:t Identifier :s "i"}))))
+           (is (= (format2 (getsib b)) "i")))
          (let [a (parse2 "int (*i)(char) pure;" type_i)
                b (normalize! a nil)]
+           (is (= (format2 b) "int function(char) pure"))
            (is (matches? b (FUNCTION (BASIC_TYPE Int) PARAMETERS POSTFIX)))
-           (is (matches? (getsib b) ({:t Identifier :s "i"}))))
+           (is (= (format2 (getsib b)) "i")))
          (let [a (parse2 "int* function(char) pure i;" type_i)
                b (normalize! a nil)]
+           (is (= (format2 b) "int* function(char) pure"))
            (is (matches? b (FUNCTION (POINTER (BASIC_TYPE Int)) 
                                      PARAMETERS POSTFIX))))
          (let [a (parse2 "int[1][2]([3][4]i[5][6])[7][8];" type_i)
                b (normalize! a nil)]
+           (is (= (format2 b) "int[1][2][8][7][3][4][6][5]"))
            (is (matches? b (SARRAY_DECL 
                              (SARRAY_DECL 
                                (SARRAY_DECL 
                              (SARRAY_DECL (BASIC_TYPE Int) 
                                           {:t IntegerLiteral :s "1"}) 
                              Const))))
-         ; todo: put this in semantic
-         #_(let [a (parse2 "auto x(int i){ return 1;}" declDef)
-               b (normalize! (copy a) nil)]
-           (is (matches? b (AUTO_DECL ATTRIBUTES 
+         (let [a (parse2 "auto x(int i){ return 1;}" declDef)
+               a2 (copy a)
+               d (first (find-ast a2 (fn [t s] (matches? t (DECLARATOR)))))
+               state (struct-map State :stack (list a2) :ast-root a2 :ast d)
+               b (new-rewrite! d state normalize!)]
+           (is (matches? a2 (AUTO_DECL ATTRIBUTES 
                                       (PARAM_SPEC 
                                         (BASIC_TYPE 
                                           (ID_LIST 
                                              :sib? false})) 
                                         PARAMETERS) 
                                       Identifier
-                                      FUNCTION_BODY)))
-           ))
+                                      FUNCTION_BODY))))
+         (let [a (parse2 "immutable(int)[1] j;" type_i)
+               b (normalize! (copy a) (struct State))]
+           (is (= (format2 b) "immutable(int[1])")))
+         (let [a (parse2 "immutable(shared(int)) j;" type_i)
+               b (normalize! (copy a) (struct State))]
+           (is (= (format2 b) "immutable(int)")))
+         (let [a (parse2 "immutable(shared(int))[1] j;" type_i)
+               b (normalize! (copy a) (struct State))]
+           (is (= (format2 b) "immutable(int[1])")))
+         (let [a (parse2 "immutable(int)[1][2] j;" type_i)
+               b (normalize! (copy a) (struct State))]
+           (is (= (format2 b) "immutable(int[1][2])")))
+         (let [a (parse2 "immutable(immutable(int)[1][2]) j;" type_i)
+               b (normalize! (copy a) (struct State))]
+           (is (= (format2 b) "immutable(int[1][2])")))
+         (let [a (parse2 "const(shared(int)) j;" type_i)
+               b (normalize! (copy a) (struct State))]
+           (is (= (format2 b) "shared(const(int))")))
+         (let [a (parse2 "shared(const(int)) j;" type_i)
+               b (normalize! (copy a) (struct State))]
+           (is (= (format2 b) "shared(const(int))")))
+         )
 
 (defn elt-t-of-2 
   "basically get elt type of T1 ~ T2"

src/org/d/compiler/semantic.clj

 (ns org.d.compiler.semantic
   (:import (java.util HashMap HashSet))
-  (:use (org.d.compiler ast-utils constfold d-type symbol misc type-deduce visitor))
+  (:use (org.d.compiler utils ast-utils visitor constfold d-type symbol preproc type-deduce))
+  (:use (clojure test))
   )
 
+(defn re-normalize! [ast state]
+  (loop [t ast]
+    (match-case t (SARRAY_DECL TYPE_MOD)
+                (let [mt (popch! t)
+                      tt (popch! mt)
+                      _ (pushch! t tt)
+                      _2 (pushch! mt t)]
+                  (recur mt))
+                (POINTER (PARAM_SPEC {:t? TEMPLATE_PARAMETERS :ast/?-> tpl} 
+                              {:t PARAMETERS :ast-> p} 
+                              {:t? POSTFIX :ast/?-> post}))
+                (let [ t2_ (popch! t)
+                      new-t (make-ast! (FUNCTION {:ast (if tpl? tpl p)}))
+                      _ (setch! t2_ nil)]
+                  (when tpl? (error! t  "Template parameter does not belong here"))
+                  (recur new-t))
+                (TYPE_MOD (TYPE_MOD {} Shared) Shared)
+                (recur (popch! t))
+                (TYPE_MOD (TYPE_MOD {} Shared) Const)
+                (let [t2 (popch! t)
+                      t3 (popch! t2)]
+                  (pushch! t t3) 
+                  (recur (pushch! t2 t)))
+                (TYPE_MOD (TYPE_MOD {} Const) Const)
+                (recur (popch! t))
+                (TYPE_MOD (TYPE_MOD {} Immutable) {:ast-> tx})
+                (do (assert (matches-any? tx (Immutable) (Const) (Shared)))
+                  (recur (popch! t)))
+                (TYPE_MOD (TYPE_MOD {} {:ast-> tx}) Immutable)
+                (let [t2 (popch! t)
+                      t3 (popch! t2)]
+                  (assert (matches-any? tx (Const) (Shared)))
+                  (recur (pushch! t t3)))
+                t)))
+
+(deftest test-re-normalize!
+         (let [a (parse2 "shared(int);" type)
+               b (preprocess! (copy a))
+               c (make-ast! (TYPE_MOD {:ast b} Shared))
+               d (re-normalize! c (struct State))]
+           (is (= (format2 d) "shared(int)")))
+         (let [a (parse2 "shared(int) i;" type)
+               b (preprocess! (copy a))
+               c (make-ast! (TYPE_MOD {:ast b} Const))
+               d (re-normalize! c (struct State))]
+           (is (= (format2 d) "shared(const(int))")))
+         (let [a (parse2 "shared(int) i;" type)
+               b (preprocess! (copy a))
+               c (make-ast! (TYPE_MOD {:ast b} Immutable))
+               d (re-normalize! c (struct State))]
+           (is (= (format2 d) "immutable(int)")))
+         (let [a (parse2 "immutable(int) i;" type)
+               b (preprocess! (copy a))
+               c (make-ast! (TYPE_MOD {:ast b} Immutable))
+               d (re-normalize! c (struct State))]
+           (is (= (format2 d) "immutable(int)")))
+         (let [a (parse2 "const(int) i;" type)
+               b (preprocess! (copy a))
+               c (make-ast! (TYPE_MOD {:ast b} Immutable))
+               d (re-normalize! c (struct State))]
+           (is (= (format2 d) "immutable(int)")))
+         (let [a (parse2 "const(int) i;" type)
+               b (preprocess! (copy a))
+               c (make-ast! (TYPE_MOD {:ast b} Const))
+               d (re-normalize! c (struct State))]
+           (is (= (format2 d) "const(int)")))
+         (let [a (parse2 "int i;" type)
+               b (preprocess! (copy a))
+               c (make-ast! (TYPE_MOD {:ast b} Const))
+               d (re-normalize! c (struct State))]
+           (is (= (format2 d) "const(int)")))
+         )
+
+; 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]
+  (if (type? ast)
+    (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)
+    false))
+
+(defn expand-typeof-rewrite! [ast state]
+  (match-case 
+    ast
+    ({} (BASIC_TYPE (Typeof {:ast-> e}))) 
+    (do 
+      (popch! ast)
+      (pushch! ast (copy (attr e 'type)))
+      (re-normalize! ast state))
+    ({:t Dot :exp? true} 
+     ({:t Typeof :exp? true :ast-> ty} {:ast-> e})
+     {:t Identifier :ast-> i}) 
+    (let [t (copy (attr e 'type))]
+      (setch! ast t)
+      (setsib! t i)
+      (setsib! ty nil)
+      ast)))
+
+(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)
+                            (preprocess! 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))))]
+      (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 expand-auto-decl? [ast]
+  (match-case 
+    ast
+    (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! 
+  "this is a rewrite"
+  [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 (copy (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 (copy (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 (copy (attr e 'type))]
+      (assert t)
+      (setch! ast t)
+      (setsib! a nil)
+      (setsib! t i)
+      ast)))
+
+(defn attrs-flags-2 [attrs]
+  (assert (seq? attrs))
+  (loop [atrs attrs mapa {:const? false 
+                          :immutable? false
+                          :shared? false
+                              }]
+    (if (empty? atrs) mapa
+      (match-case (first atrs)
+                  (Immutable)
+                  (recur (rest atrs) (assoc mapa :immutable? true :const? false :shared? false))
+                  (Const)
+                  (recur (rest atrs) (assoc mapa :const? true :immutable? false))
+                  (Shared)
+                    (recur (rest atrs) (assoc mapa :shared? true :immutable? false))
+                  (recur (rest atrs) mapa)))))
+
 (defn semantic-blast 
   "1 round of semantic analysis
   type deduction - check
   symbol table population - check
   auto decl rewrites - todo
-  const folding rewrites - todo
+  const folding rewrites - partial check
   "
   [ast-root]
   (let [v (visitor
                      (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)
+                (let [[prot,stor,algn,pragmas] (get-attrs ast state)
+                      flags (attrs-flags-2 stor)]
+                  (attr! ast 'prot prot)
+                  (attr! ast 'storage stor)
+                  (letfn [(rm-ics [decl]
+                                  (attr! decl 'storage 
+                                         (filter #(not (matches-any? % (Immutable) (Const) (Shared)))
+                                                 (attr decl 'storage))))]
+                    (match-case ast
+                                (DECLARATION {} Identifier)
+                                (cond (:immutable? flags)
+                                      (let [t (popch! ast)
+                                            t2 (make-ast! (TYPE_MOD {:ast t} Immutable))
+                                            t3 (re-normalize! t2 (struct State))]
+                                        (when (attr? t 't-ok) (attr! t3 't-ok true))
+                                        (pushch! ast t3)
+                                        (rm-ics ast))
+                                      (or (:shared? flags)
+                                          (:const? flags))
+                                      (do
+                                        (when (:const? flags)
+                                          (let [t (popch! ast)
+                                                t2 (make-ast! (TYPE_MOD {:ast t} Const))
+                                                t3 (re-normalize! t2 (struct State))]
+                                            (when (attr? t 't-ok) (attr! t3 't-ok true))
+                                            (pushch! ast t3)))
+                                        (when (:shared? flags)
+                                          (let [t (popch! ast)
+                                                t2 (make-ast! (TYPE_MOD {:ast t} Shared))
+                                                t3 (re-normalize! t2 (struct State))]
+                                            (when (attr? t 't-ok) (attr! t3 't-ok true))
+                                            (pushch! ast t3)))
+                                        (rm-ics ast)))
+                                ({}) (do)))
+                  (attr! ast 'align algn)
+                  (attr! ast 'pragma pragmas)
+                  state)
                 ; populate symbol table
                 (not (attr? ast 'scoped))
                 (let [is (get-symbols ast state)]
             (fn [ast state]
               (do-when 
                 ast state
+                ; type instantiation
+                (and (type? ast) 
+                     (not (attr? ast 't-ok))
+                     (t-ok? ast state))
+                (do (attr! ast 't-ok true) state)
                 ; more type deduction (in case children were deduced
                 ; on the way down)
                 true (let [descend (all-ded ast state)] state)
     (:ast-root (v ast-root))))
 
 (def pxx false)
-(defn test1 [strxp]
-  (let [a (parse2 strxp exp)
+(defn test-file [fnom]
+  (let [a (fparse2 fnom)
         *1* (when pxx 
               (println "(raw):")
               (dump-ast a))
-        b (rewrites-1! a)
+        b (preprocess! a)
         *2* (when pxx 
               (println "(rewrites-1):")
               (dump-ast b))
               (dump-ast d))]
     c))
 
-(defn test1 [strxp]
-  (let [a (parse2 strxp module)
-        *1* (when pxx 
-              (println "(raw):")
-              (dump-ast a))
-        b (rewrites-1! a)
-        *2* (when pxx 
-              (println "(rewrites-1):")
-              (dump-ast b))
-        c (semantic-blast b)
-        *3* (when pxx
-              (println "(semantic [1]):")
-              (dump-ast c))
-        d (semantic-blast c)
-        *4* (when pxx 
-              (println "semantic [2]:")
-              (dump-ast d))]
-    c))
-(defn test2 [strxp]
+(defn test-exp [strxp]
   (let [a (parse2 strxp exp)
         *1* (when pxx 
               (println "(raw):")
               (dump-ast a))
-        b (rewrites-1! a)
+        b (preprocess! a)
         *2* (when pxx 
               (println "(rewrites-1):")
               (dump-ast b))
     c))
 
 #_(deftest test-populate 
-         (let [a (parse2 "static{ shared int i;}" declDefs)
-               b (rewrites-1! a)
-               c (semantic-blast (semantic-blast b))]
-           (is (matches? c (DECLARATION)))
-           (let [ts (map #(.getType %) (attr c 'storage))]
-             (is (= ts (list (tok Shared) (tok Static)))))
+           (let [a (parse2 "static{ shared int i;}" declDefs)
+                 b (preprocess! a)
+                 c (semantic-blast (semantic-blast b))]
+             (is (matches? c (DECLARATION)))
+             (let [ts (map #(.getType %) (attr c 'storage))]
+               (is (= ts (list (tok Shared) (tok Static)))))
 
+             )
            )
-)

src/org/d/compiler/symbol.clj

     (STATIC_DTOR)
     (AMBIG_DECLARATION)))
 
+(defn attrs-flags-1 [attrs]
+  (assert (seq? attrs))
+  (loop [atrs attrs mapa {:const? false 
+                          :immutable? false
+                          :shared? false
+                          }]
+    (if (empty? atrs) mapa
+      (match-case (first atrs)
+                  (Immutable)
+                  (do
+                    (when (:const? mapa)
+                      (error! (first atrs) "conflicting storage classes const, immutable"))
+                    (when (:immutable? mapa)
+                      (error! (first atrs) "redundant storage classes immutable"))
+                    (recur (rest atrs) (assoc mapa :immutable? true)))
+                  (Const)
+                  (do
+                    (when (:const? mapa)
+                      (error! (first atrs) "redundant storage classes const"))
+                    (when (:immutable? mapa)
+                      (error! (first atrs) "conflicting storage classes immutable, const"))
+                    (recur (rest atrs) (assoc mapa :const? true)))
+                  (Shared)
+                  (do
+                    (when (:shared? mapa)
+                      (error! (first atrs) "redundant storage classes shared"))
+                    (recur (rest atrs) (assoc mapa :shared? true)))
+                  (recur (rest atrs) mapa)))))
+
 (defn get-attrs 
   " 
   look up through the stack for attributes that affect the symbol
   on topLevel)
   "
   [ast state ]
-  (loop [stack (reverse (:stack state)) 
+  (loop [stack (:stack state) 
          prot () 
          stor () 
          algn ()
          pragmas ()]
     (if (or (empty? stack)
             (attrble? (first stack))) [prot,stor,algn,pragmas]
+      (do
       (match-case 
         (first stack)
         (PRAGMA_DECL {:t Pragma :ast-> p})
         (PRAGMA_STMT {:t Pragma :ast-> p})
         (recur (rest stack) prot stor algn (cons p pragmas))
         (ATTR_DECLDEF {:t ATTRIBUTES :ast-> a})
-        (recur (rest stack) prot (concat (children a) stor) algn pragmas)
+        (let [flags (attrs-flags-1 (children a))
+              a1 (filter (if (:immutable? flags) 
+                           (fn [a] (not (matches-any? a (Shared) (Const))))
+                           (constantly true))
+                         (children a))
+                            ]
+          (recur (rest stack) prot (concat a1 stor) algn pragmas))
         (recur (rest stack) prot stor algn pragmas)
-        ))))
+        )))))
 
 (defn get-symbols 
   "retrieve symbols from ast, if any.
   (assert (matches? mn (MODULE_NAME)))
   (assert (matches-any? ast (IMPORT) (Module)))
   (assert (decl-scoped? decl))
+  (attr! ast 'scoped true)
   (loop [chm (children mn) sct decl]
     (match-case 
       (first chm) 
       (cond 
         ; let's allow crap like `import a.b; import a;`
         (and (empty? (rest chm))
-             (apply #(and % (= 1 (count %)) (matches? (first %) (PACKAGE)))
-                    (list (get (attr sct 'scope) mi))))
+             (let [zz (get (attr sct 'scope) mi)]
+               (and zz (= 1 (count zz)) (matches? (first zz) (PACKAGE)))))
         (let [mst (make-ast! (MODULE))]
           (put-sym! (attr sct 'scope) mi mst)
           true)

src/org/d/compiler/type_deduce.clj

     (Slice) (do (error! ast "not implemented") [false])
     (INDEX_EXPRESSION {:ast-> lhs} {:ast-> rhs}) (binop index-t)
     ({:t Dot :nch 1} Identifier) (do (error! ast "not implemented") [false])
-    ({:t Dot :nch 2} Identifier) (do (error! ast "not implemented") [false])
+    ({:t Dot :nch 2} {} Identifier) (do (error! ast "not implemented") [false])
     (TEMPL_INST) (do (error! ast "not implemented") [false])
     (Identifier) 
     (let [[category, ready? xst] (lookup ast state)]
+      (when ready? (attr! ast 'category category))
       (cond (= category 'not-found) [false]
             (and (not (= category 'val-decl)) 
                  (not (= category 'function)))
       [true] ; do descend an undeduced tree
       true (put-t! ast (typeid-t ast rhs state) state))
     (Is) (term is-t-t)
+    (Typeof) [true]
     (do
       (dump-ast ast :printer printastx)
       (error! ast "wtf?!") 

src/org/d/compiler/visitor.clj

 (defnk copy&siblings [ast-root :copy-ast ast-copier]
   (:ret ((copier copy-ast false) ast-root)))
 
+(defn find-ast [ast-root match?]
+  (let [v (visitor
+            :init (fn [t s]
+                    (assoc s :res []))
+            :onVisit (fn [t s]
+                       (if (match? t s) (assoc s :res (conj (:res s) t)) 
+                         s)))]
+    (:res (v ast-root))))

src/org/d/model/Formatter.java

 		AST P = stack.peek();
 		int p = P == null ? -1 : P.getType();
 		switch(n){
+                    case POSTFIX:
+                        sp(true);
+                        break;
 			case INITIALIZER:
 				if(p == AUTO_ASSIGN
 						|| p == DECLARATION

Binary file modified.

-module tok;
-import std.algorithm;
-import std.stdio;
-
-void main(){
-    int i;
-    int[] j = [0];
-    i=6+7+i+i+1+2;
-    j = 1 ~ [2,3];
-    j = [1,2] ~ 1;
-    j = [] ~ [4,5] ~ j  ~ [6,7] ~ [8];
-    //string s;
-    //s = "abc" ~ "d" ~ s ~ "e" ~ "f";
-}
+void main(){}
+immutable typeof(i) j;
+pragma(msg, typeof(j));
+immutable:
+shared const int i;
+pragma(msg, typeof(i).stringof);
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.