From 648110a554a13e1caaf846a60c85cccadcda6e0d Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 3 Jan 2015 01:48:08 -0400 Subject: The language now supports macros. --- src/lang.clj | 181 +++++------------------------------------------------------ 1 file changed, 14 insertions(+), 167 deletions(-) (limited to 'src/lang.clj') diff --git a/src/lang.clj b/src/lang.clj index 5e4316db4..0777812b7 100644 --- a/src/lang.clj +++ b/src/lang.clj @@ -16,7 +16,6 @@ ;; TODO: Adding metadata to global vars. ;; TODO: Add records. ;; TODO: throw, try, catch, finally - ;; TODO: Finish implementing pattern matching. ;; TODO: Tuple8 and Tuple8X (for arbitrary-size tuples). ;; TODO: Add extra arities (apply2, apply3, ..., apply16) ;; TODO: When doing partial application, skip "apply" and just call constructor appropiatedly. @@ -32,176 +31,24 @@ ;; _ (prn 'tokens tokens) syntax (&parser/parse tokens) ;; _ (prn 'syntax syntax) - ann-syntax (&analyser/analyse "test2" syntax) + ;; ann-syntax (&analyser/analyse "test2" syntax) ;; _ (prn 'ann-syntax ann-syntax) - class-data (&compiler/compile "test2" ann-syntax) + ;; class-data (&compiler/compile "test2" ann-syntax) + class-data (&compiler/compile "test2" syntax) ;; _ (prn 'class-data class-data) ] - (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. "test2.class"))] - (.write stream class-data))) - - ;; jar cvf test2.jar *.class test2 && java -cp "test2.jar" test2 - ) - -(comment - ;; (let [branches '([::&parser/case-branch [::&parser/variant "Cons" ([::&parser/variant "Symbol" ([::&parser/string "~"])] [::&parser/variant "Cons" ([::&parser/ident "unquoted"] [::&parser/variant "Nil" ()])])] [::&parser/variant "Cons" ([::&parser/ident "unquoted"] [::&parser/fn-call [::&parser/ident "template"] ([::&parser/ident "tail"])])]] - ;; [::&parser/case-branch [::&parser/variant "Cons" ([::&parser/variant "Symbol" ([::&parser/string "~@"])] [::&parser/variant "Cons" ([::&parser/ident "spliced"] [::&parser/variant "Nil" ()])])] [::&parser/variant "Cons" ([::&parser/variant "Symbol" ([::&parser/string "++"])] [::&parser/variant "Cons" ([::&parser/ident "spliced"] [::&parser/fn-call [::&parser/ident "template"] ([::&parser/ident "tail"])])])]] - ;; [::&parser/case-branch [::&parser/ident "_"] [::&parser/variant "Cons" ([::&parser/ident "head"] [::&parser/fn-call [::&parser/ident "template"] ([::&parser/ident "tail"])])]]) - ;; ;; Step 1: Get all vars - ;; get-vars (fn get-vars [pattern] - ;; (clojure.core.match/match pattern - ;; [::&parser/ident ?name] - ;; (list ?name) - - ;; [::&parser/variant ?tag ?members] - ;; (mapcat get-vars ?members) - - ;; [::&parser/string ?text] - ;; '())) - ;; vars+body (for [branch branches] - ;; (clojure.core.match/match branch - ;; [::&parser/case-branch ?pattern ?body] - ;; [(get-vars ?pattern) ?body])) - ;; ;; _ (prn 'vars+body vars+body) - ;; max-registers (reduce max 0 (map (comp count first) vars+body)) - ;; ;; _ (prn 'max-registers max-registers) - ;; ;; Step 2: Analyse bodies - ;; ;; all-analysis (map (fn [[vars body]] - ;; ;; (reduce #(with-local %2 [::&type/object "java.lang.Object" []] %1) - ;; ;; (analyse-form* body) - ;; ;; (reverse vars))) - ;; ;; vars+body) - ;; ;; Step 3: Extract bodies - ;; [_ branch-mappings branches*] (reduce (fn [[$link links branches*] branch] - ;; (clojure.core.match/match branch - ;; [::&parser/case-branch ?pattern ?body] - ;; [(inc $link) (assoc links $link ?body) (conj branches* [::&parser/case-branch ?pattern $link])])) - ;; [0 {} []] - ;; branches) - ;; ;; Step 4: Pattens -> Instructions - ;; ;; ->instructions (fn ->instructions [locals pattern] - ;; ;; (clojure.core.match/match pattern - ;; ;; [::&parser/variant ?tag ?members] - ;; ;; [::pm-variant ?tag (map (partial ->instructions locals) ?members)] - - ;; ;; [::&parser/ident ?name] - ;; ;; [::pm-local (get locals ?name)] - - ;; ;; [::&parser/string ?text] - ;; ;; [::pm-text ?text] - ;; ;; )) - ;; ;; $scope 0 ;; scope-id - ;; ;; $local 11 ;; next-local-idx - ;; ;; branches** (for [[branch branch-vars] (map vector branches* (map first vars+body)) - ;; ;; :let [[_ locals] (reduce (fn [[$local =locals] $var] - ;; ;; [(inc $local) (assoc =locals $var [::local $scope $local])]) - ;; ;; [$local {}] branch-vars)]] - ;; ;; (clojure.core.match/match branch - ;; ;; [::&parser/case-branch ?pattern ?body] - ;; ;; [(->instructions locals ?pattern) ?body])) - ;; ;; _ (prn branches**) - ;; ;; Step 5: Re-structure branching - ;; ] - ;; ;; [branch-mappings branches**] - ;; branches*) - - - + ;; (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. "test2.class"))] + ;; (.write stream class-data)) + ) + (Class/forName "test2.Variant") - ;; (let [data '([[:lang/pm-variant "Cons" ([:lang/pm-variant "Symbol" ([:lang/pm-text "~"])] [:lang/pm-variant "Cons" ([:lang/pm-local [:lang/local 0 11]] [:lang/pm-variant "Nil" ()])])] 0] - ;; [[:lang/pm-variant "Cons" ([:lang/pm-variant "Symbol" ([:lang/pm-text "~@"])] [:lang/pm-variant "Cons" ([:lang/pm-local [:lang/local 0 11]] [:lang/pm-variant "Nil" ()])])] 1] - ;; [[:lang/pm-local [:lang/local 0 11]] 2]) - ;; classify-outer (fn [struct [branch $body]] - ;; (clojure.core.match/match branch - ;; [::pm-variant ?tag ?members] - ;; (update-in struct [:cases ?tag] conj {:members ?members - ;; :body $body}) - - ;; [::pm-text ?text] - ;; (update-in struct [:tests] conj {:test [::text ?text] - ;; :body $body}) - - ;; [::pm-local ?binding] - ;; (assoc struct :default {:storage ?binding - ;; :body $body}))) - ;; outer-classification (reduce classify-outer - ;; {:cases {} - ;; :tests '() - ;; :default nil} - ;; data) - ;; full-classifier (fn full-classifier [global] - ;; (prn 'full-classifier global) - ;; (let [subcases (:cases global)] - ;; (if (empty? subcases) - ;; global - ;; (let [crossed (sort (fn [x1 x2] (> (-> x1 second :cases count) (-> x2 second :cases count))) - ;; (for [[tag subs] subcases - ;; :let [_ (prn 'subcases tag subs)] - ;; :let [parts (for [cross (apply map list (map :members subs)) - ;; :let [_ (prn 'cross tag cross)] - ;; ;; :let [_ (prn '(map :body subs) (map :body subs))] - ;; ;; :let [_ (prn (class cross) (count cross) - ;; ;; (class (map :body subs)) (count (map :body subs)))] - ;; :let [cross+ (map vector cross (map :body subs))] - ;; ;; :let [_ (prn 'cross+ tag (class cross+) (count cross+))] - ;; ;; :let [_ (prn 'cross+ tag cross+)] - ;; :let [cross++ (reduce classify-outer - ;; {:cases {} - ;; :tests '() - ;; :default nil} - ;; cross+)] - ;; ;; :let [_ (prn 'cross++ tag cross++)] - ;; ] - ;; cross++)] - ;; :let [_ (prn 'parts parts)]] - ;; [tag parts])) - - ;; ] - ;; (assoc global :cases (reduce (fn [tree [tag subcases]] - ;; (update-in tree [tag] #(conj (or % []) (full-classifier subcases)))) - ;; {} - ;; crossed))))))] - ;; (full-classifier outer-classification)) + ;; jar cvf test2.jar *.class test2 && java -cp "test2.jar" test2 ) -(comment - [{2 [:lang.parser/variant "Cons" ([:lang.parser/ident "head"] [:lang.parser/fn-call [:lang.parser/ident "template"] ([:lang.parser/ident "tail"])])], - 1 [:lang.parser/variant "Cons" ([:lang.parser/variant "Symbol" ([:lang.parser/string "++"])] [:lang.parser/variant "Cons" ([:lang.parser/ident "spliced"] [:lang.parser/fn-call [:lang.parser/ident "template"] ([:lang.parser/ident "tail"])])])], - 0 [:lang.parser/variant "Cons" ([:lang.parser/ident "unquoted"] [:lang.parser/fn-call [:lang.parser/ident "template"] ([:lang.parser/ident "tail"])])]} - {:type :lang/adt*, - :patterns {"Cons" ({:type :lang/adt*, - :patterns {"Symbol" ({:type :lang/text-tests, - :patterns {"~@" #{1}, - "~" #{0}}, - :defaults [], - :branches #{0 1}})}, - :default nil, - :branches #{0 1}} - {:type :lang/adt*, - :patterns {"Cons" ({:type :lang/defaults, - :stores {[:lang/local 0 11] #{0 1}}, - :branches #{0 1}} - {:type :lang/adt*, - :patterns {"Nil" ()}, - :default nil, - :branches #{0 1}})}, - :default nil, - :branches #{0 1}})}, - :default [:lang/default [:lang/local 0 11] 2], - :branches #{0 1 2}}] - - (let [data '([[:lang/pm-variant "Cons" ([:lang/pm-variant "Symbol" ([:lang/pm-text "~"])] [:lang/pm-variant "Cons" ([:lang/pm-local [:lang/local 0 11]] [:lang/pm-variant "Nil" ()])])] 0] - [[:lang/pm-variant "Cons" ([:lang/pm-variant "Symbol" ([:lang/pm-text "~@"])] [:lang/pm-variant "Cons" ([:lang/pm-local [:lang/local 0 11]] [:lang/pm-variant "Nil" ()])])] 1] - [[:lang/pm-local [:lang/local 0 11]] 2]) - ] - (generate-branches data)) - - ;; (def (workday? d) - ;; (case d - ;; (or [#Monday #Tuesday #Wednesday #Thursday #Friday] - ;; true) - ;; (or [#Saturday #Sunday] - ;; false))) - - ) +;; (def (workday? d) +;; (case d +;; (or [#Monday #Tuesday #Wednesday #Thursday #Friday] +;; true) +;; (or [#Saturday #Sunday] +;; false))) -- cgit v1.2.3