Commits

ariovistus committed d503156

why is misc still here?

Comments (0)

Files changed (1)

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)
-    (org.d MatchException))
-  (:use (clojure test))
-  (:use (clojure.contrib macro-utils ))
-  (:use 
-    (org.d.compiler d-type utils ast-utils visitor)))
-
-(defn rewrite-templated-decl! 
-  "
-  rewrites templated aggregate declarations
-  (class, interface, struct, and union)
-  "
-  [ast state]
-  (assert (matches-any? ast (Class) (Interface) (Union) (Struct))) 
-  (match-case ast
-              ({} 
-               {:t Identifier :ast-> i} 
-               {:t TEMPLATE_PARAMETERS :ast-> tpl} 
-               {:t? CONSTRAINT :ast/?-> constr}) 
-              (let [isibl (getsib (if constr? constr tpl))
-                    tbody (make-ast! (TEMPLATE_BODY ({:ast ast :sib null :ch null} 
-                                                     {:ast i :sib null} 
-                                                     {:ast isibl})))
-                    tnext (if (not constr?) tbody 
-                            (make-ast! (null {:ast constr :sib null} 
-                                             {:ast tbody})))
-                    ]
-                (make-ast! (Template 
-                             {:t Identifier :s (.getText i)}
-                             {:ast tpl :sib null}
-                             {:ast tnext})))))
-
-(deftest test-rewrite-templated-decl
-         (let [ 
-               x (make-ast! 
-                   (Class Identifier 
-                          (TEMPLATE_PARAMETERS 
-                            (TEMPLATE_TYPE_PARAMETER Identifier)) 
-                          (CONSTRAINT True) 
-                          CLASS_BODY)) 
-               y (rewrite-templated-decl! x nil)]
-           (is (matches? y (Template Identifier 
-                                     (TEMPLATE_PARAMETERS 
-                                       (TEMPLATE_TYPE_PARAMETER Identifier))
-                                     (CONSTRAINT True)
-                                     (TEMPLATE_BODY 
-                                       (Class Identifier CLASS_BODY)))))))
-
-(defn rewrite-templated-fn! 
-  "rewrites a templated function to template enclosing function"
-  [ast state]
-  (when (matches? ast (DECLARATION TYPE_I))
-    (assert (do 
-              "error: attempted to rewrite templated function before 
-              rewriting function's type" false)))
-  (match-case ast 
-              (DECLARATION 
-                ({:t PARAM_SPEC :ast-> pt} 
-                 {:ast-> subtype}
-                 {:t TEMPLATE_PARAMETERS :ast-> tpl} 
-                 {:t PARAMETERS :ast-> p}
-                 {:t? POSTFIX :ast/?-> post}
-                 {:t? CONSTRAINT :ast/?-> constr}) 
-                {:t Identifier :ast-> i} FUNCTION_BODY)
-              (do
-                (when constr?  (setsib! (if post? post p) nil)
-                  (setsib! constr nil))
-                (setsib! tpl (if constr? constr nil))
-                (setsib! subtype p)
-                (make-ast! (Template 
-                             {:t Identifier :s (.getText i)} 
-                             {:ast tpl} 
-                             (TEMPLATE_BODY {:ast ast :sib null}))))))
-
-#_(deftest test-rewrite-templated-fn
-         (let [a (parse2 "int i(I)(char c){}" declDefs)
-               b (do (normalize-all! a) (rewrite-templated-fn! a nil)) ]
-           (is (matches? b (Template Identifier 
-                                     ({:t TEMPLATE_PARAMETERS :nch 1} 
-                                      (TEMPLATE_TYPE_PARAMETER Identifier)) 
-                                     ({:t TEMPLATE_BODY :nch 1}
-                                      ({:t DECLARATION :nch 3} 
-                                       ({:t PARAM_SPEC :nch 2} 
-                                        (BASIC_TYPE Int)
-                                        PARAMETERS) 
-                                       Identifier {:t FUNCTION_BODY :nsib 0}))))))
-         (let [a (parse2 "int i(I)(char c) pure{}" declDefs)
-               b (do (normalize-all! a) (rewrite-templated-fn! a nil)) ]
-           (is (matches? b (Template Identifier 
-                                     ({:t TEMPLATE_PARAMETERS :nch 1} 
-                                      (TEMPLATE_TYPE_PARAMETER Identifier)) 
-                                     ({t TEMPLATE_BODY nch 1}
-                                      ({t DECLARATION nch 3} 
-                                       ({t PARAM_SPEC nch 3} 
-                                        (BASIC_TYPE Int)
-                                        PARAMETERS 
-                                        (POSTFIX Pure)) 
-                                       Identifier {t FUNCTION_BODY nsib 0}))))))
-         (let [a (parse2 "int i(I)(char c) if(true){}" declDefs)
-               b (do (normalize-all! a) (rewrite-templated-fn! a nil)) ]
-           (is (matches? b (Template Identifier 
-                                     ({t TEMPLATE_PARAMETERS nch 1} 
-                                      (TEMPLATE_TYPE_PARAMETER Identifier)) 
-                                     (CONSTRAINT True) 
-                                     ({t TEMPLATE_BODY nch 1}
-                                      ({t DECLARATION nch 3} 
-                                       ({t PARAM_SPEC nch 2} 
-                                        (BASIC_TYPE Int)
-                                        PARAMETERS) 
-                                       Identifier {t FUNCTION_BODY nsib 0}))))))
-         (let [a (parse2 "int i(I)(char c) pure if(true){}" declDefs)
-               b (do (normalize-all! a) (rewrite-templated-fn! a nil)) ]
-           (is (matches? b (Template Identifier 
-                                     ({t TEMPLATE_PARAMETERS nch 1} 
-                                      (TEMPLATE_TYPE_PARAMETER Identifier)) 
-                                     (CONSTRAINT True) 
-                                     ({t TEMPLATE_BODY nch 1}
-                                      ({t DECLARATION nch 3} 
-                                       ({t PARAM_SPEC nch 3} 
-                                        (BASIC_TYPE Int)
-                                        PARAMETERS 
-                                        (POSTFIX Pure)) 
-                                       Identifier 
-                                       {t FUNCTION_BODY nsib 0})))))))
-
-(defn unop-rewrite! 
-  "rewrites ++a to a+=1 and --a to a-=1"
-  [ast state]
-  (match-case ast
-              ({:t PLUSPLUSPRE :nch 1} {:ast-> e}) 
-              (make-ast! (Add_assign {:ast e} {:t IntegerLiteral :s "1"}))
-              ({:t MINUSMINUSPRE :nch 1} {:ast-> e}) 
-              (make-ast! (Minus_assign {:ast e} {:t IntegerLiteral :s "1"}))))
-
-(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 (copy 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 (copy 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 (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))))
-      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 (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))))
-      ast)))
-
-
-(defn rewrites-1!
-  "any rewrites which occur directly after parsing
-  and before semantic analysis"
-  [ast-root]
-  (let [
-        v (visitor
-            :onVisit
-            (fn [ast state]
-              (do-when ast state
-                       (matches? ast (PARENS_EXPRESSION))
-                       (new-rewrite! ast state (fn [ast state] (getch ast)))
-                       (matches-any? ast
-                                     (PLUSPLUSPRE)
-                                     (MINUSMINUSPRE))
-                       (new-rewrite! ast state unop-rewrite!)
-                       (or (matches-any? ast (TYPE_I) (TYPE))
-                           (and
-                             (matches? ast (DECLARATOR))
-                             (matches? (first (:stack state)) (AUTO_DECL))))
-                       (new-rewrite! ast state normalize!)
-                       (matches? ast ({:t Dot :nch 2}))   
-                       (match-case ast (Dot {} {:t Identifier :ast-> i})
-                                   (do (.unsetExp i)
-                                     state)
-                                   (Dot {:ast-> e} {:t NEW_EXPRESSION :ast-> n})
-                                   (new-rewrite! ast state (fn [t s]
-                                                             (let [x (getch n)]
-                                                               (make-ast! ({:ast n :ch null}
-                                                                           {:ast e :sib null}
-                                                                           {:ast x})))))
-                                   (Dot {:ast-> e} {:t NEW_CLASS_EXPRESSION :ast-> n})
-                                   (new-rewrite! ast state (fn [t s]
-                                                             (let [x (getch n)]
-                                                               (make-ast! ({:ast n :ch null}
-                                                                           {:ast e :sib null}
-                                                                           {:ast x}))))))
-                       (matches-any? 
-                         ast 
-                         (Class Identifier TEMPLATE_PARAMETERS) 
-                         (Interface Identifier TEMPLATE_PARAMETERS) 
-                         (Union Identifier TEMPLATE_PARAMETERS) 
-                         (Struct Identifier TEMPLATE_PARAMETERS))
-                     (new-rewrite! ast state rewrite-templated-decl!)))
-            :onAscend
-            (fn [a state]
-              (do-when a state
-                       (matches? a (DECLARATION
-                                       (PARAM_SPEC 
-                                         {} 
-                                         TEMPLATE_PARAMETERS PARAMETERS)))
-                       (new-rewrite! a state rewrite-templated-fn!))))]
-    (:ast-root (v ast-root))))
-
-(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!  [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)
-    ))
-
-; 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]
-  (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})) 
-    (copy (attr e 'type))
-    ({: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)
-                            (rewrites-1! 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))
-  ))))
-
-