aboutsummaryrefslogtreecommitdiff
path: root/src/lang.clj
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lang.clj411
1 files changed, 153 insertions, 258 deletions
diff --git a/src/lang.clj b/src/lang.clj
index 4dd8e159c..5e4316db4 100644
--- a/src/lang.clj
+++ b/src/lang.clj
@@ -6,11 +6,6 @@
[compiler :as &compiler])
:reload))
-(defn write-file [file data]
- (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. file))]
- ;; (prn 'write-file 'file file 'stream stream 'data data)
- (.write stream data)))
-
(comment
;; TODO: Add macros.
;; TODO: Re-implement compiler in language.
@@ -32,28 +27,6 @@
;; TODO:
;; TODO:
- (let [test '([:lang.parser/case-branch [:lang.parser/variant "Nil" ()]
- [:lang.parser/ident "yx"]]
- [:lang.parser/case-branch [:lang.parser/variant "Cons" ([:lang.parser/ident "x"] [:lang.parser/ident "xs*"])]
- [:lang.parser/variant "Cons" ([:lang.parser/ident "x"] [:lang.parser/fn-call [:lang.parser/ident "++"] ([:lang.parser/ident "xs*"] [:lang.parser/ident "ys"])])]])
- convert (fn [cases]
- (list (reduce (fn [acc [_ shape body]]
- (clojure.core.match/match shape
- [::&parser/variant ?tag ?elems]
- (let [=elems (map (fn [elem]
- (clojure.core.match/match elem
- [::&parser/ident ?ident]
- [::ident ?ident]))
- ?elems)]
- (conj acc [?tag =elems body]))))
- []
- cases)))]
- (convert test))
-
- (enumerate (list (list '["Nil" [] branch-0]
- '["Cons" [x xs*] branch-1])))
-
-
(let [source-code (slurp "test2.lang")
tokens (&lexer/lex source-code)
;; _ (prn 'tokens tokens)
@@ -64,249 +37,171 @@
class-data (&compiler/compile "test2" ann-syntax)
;; _ (prn 'class-data class-data)
]
- (write-file "test2.class" 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 [data '([::&parser/case-branch [::&parser/variant "Nil" ()]
- [::&parser/ident "ys"]]
- [::&parser/case-branch [::&parser/variant "Cons" ([::&parser/ident "x"] [::&parser/ident "xs*"])]
- [::&parser/variant "Cons" ([::&parser/ident "x"] [::&parser/fn-call [::&parser/ident "++"] ([::&parser/ident "xs*"] [::&parser/ident "ys"])])]])
- ;; count-registers (fn count-registers [pattern]
- ;; (clojure.core.match/match pattern
- ;; [::&parser/ident _]
- ;; 0
-
- ;; [::&parser/variant _ ?members]
- ;; (reduce + (count ?members) (map count-registers ?members))))
- gen-impl (fn gen-impl [offset pattern]
- (clojure.core.match/match pattern
- [::&parser/ident _]
- [1 [::case-bind -1 offset]]
+ ;; (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]
- (let [regs+insns (mapv (fn [idx member]
- (clojure.core.match/match member
- [::&parser/ident _]
- [1 [::case-sub-bind (+ offset (inc idx))]]))
- (range (count ?members))
- ?members)]
- [(reduce + 1 (map first regs+insns)) [::case-try ?tag (mapv second regs+insns)]])
- (reduce + (count ?members) (map gen-impl ?members))))]
- (reduce (fn [accum branch]
- (clojure.core.match/match branch
- [::&parser/case-branch ?pattern ?body]
- (clojure.core.match/match ?pattern
- [::&parser/variant ?tag ?members]
- (let [[extra-registers impl] (gen-impl 0 ?pattern)
- _ (prn 'impl extra-registers impl)
- $branch (get-in accum [:paths :total])]
- (-> accum
- (update-in [:patterns]
- (fn [patterns]
- (if (contains? patterns ?tag)
- (if (= (get patterns [?tag :arity]) (count ?members))
- (update-in patterns [?tag :branches] conj {:test impl
- :link $branch})
- (assert "Pattern arity doesn't match!"))
- (assoc patterns ?tag {:arity (count ?members)
- :branches [{:test impl
- :link $branch}]}))))
- (update-in [:paths]
- (fn [paths]
- (-> paths
- (update-in [:total] inc)
- (assoc-in [:links $branch] ?body))))
- (update-in [:registers] + (dec extra-registers)))))
- ))
- {:registers 1
- :patterns {}
- :paths {:total 0
- :links {}}}
- data))
+ ;; [::&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*)
- '([::&parser/case-branch [::&parser/variant "Nil" ()]
- [::&parser/ident "ys"]]
- [::&parser/case-branch [::&parser/variant "Cons" ([::&parser/ident "x"] [::&parser/ident "xs*"])]
- [::&parser/variant "Cons" ([::&parser/ident "x"] [::&parser/fn-call [::&parser/ident "++"] ([::&parser/ident "xs*"] [::&parser/ident "ys"])])]])
-
- '([:try "Nil" []]
- [:try "Cons" [[:bind 0 1] [:bind 1 2]]])
- (list '["Nil" [] branch-0]
- '["Cons" [x xs*] branch-1])
-
- [:if [% tag "Nil"]
- branch-0
- [:let [%0 %1]
- branch-1]]
- (let [enumerate (fn [xs] (map vector (range (count xs)) xs))
- cases (enumerate (list (list '["Nil" [] branch-0]
- '["Cons" [x xs*] branch-1])))
- classify-cases (fn [[idx cases]]
- [idx (reduce (fn [order [tag members branch]]
- (if-let [{:keys [arity branches] :as sub-struct} (get order tag)]
- (if (= arity (count members))
- (update-in order [tag :branches] conj [members branch])
- (assert (str "Arity doesn't match:" (count members) " != " arity)))
- (assoc order tag {:arity (count members)
- :branches (vector [members branch])})))
- {}
- cases)])
- ;; case->struct (fn [cases]
- ;; (let [struct (classify-case cases)
- ;; struct* (seq struct)]
- ;; (reduce (fn [inner [tag {:keys [arity branches]}]]
- ;; [:if [% tag "Nil"]
- ;; branch-0
- ;; inner])
- ;; (second (last struct*))
- ;; (butlast struct*))
- ;; ))
- ]
- ;; (classify-case cases)
- (let [;; separated (apply map list cases)
- classifications (map classify-cases cases)
- classifications* (sort-by first > classifications)]
- ((fn [[idx struct]]
- (prn idx struct)
- (if-let [default (get struct nil)]
- (reduce (fn [[dbinds dbranch] [tag [binds branch]]]
- [:if tag
- [:let binds
- branch]
- [:let dbinds
- dbranch]])
- (-> default :branches first)
- (seq struct))
- (let [struct* (seq struct)]
- (reduce (fn [[dbinds dbranch] [tag sub-struct]]
- (let [[binds branch] (-> sub-struct :branches first)]
- [:if tag
- [:let binds
- branch]
- [:let dbinds
- dbranch]]))
- (-> struct* last second :branches first)
- (butlast struct*)))))
- (first classifications*))
- ))
- ;; ([0 {"Cons" {:arity 2, :branches [[[x xs*] branch-1]]}, "Nil" {:arity 0, :branches [[[] branch-0]]}}])
+ ;; (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))
+ )
- ;; {"Cons" {:arity 2, :branches [[[x xs*] branch-1]]},
- ;; "Nil" {:arity 0, :branches [[[] branch-0]]}}
-
-
- ;; .........................
-
- ;; (case elems
- ;; #Nil
- ;; elems
-
- ;; (#Cons head tail)
- ;; (case head
- ;; (#Cons (#Symbol "~") (#Cons unquoted #Nil))
- ;; (#Cons unquoted (template tail))
-
- ;; (#Cons (#Symbol "~@") (#Cons spliced #Nil))
- ;; (#Cons (#Symbol "++") (#Cons spliced (template tail)))
-
- ;; _
- ;; (#Cons head (template tail)))
- ;; )
-
- ;; Total registers: 3
- ;; [{:tag "Nil" :data [] :path path-1}
- ;; {:tag "Cons" :data [[:bind head] [:bind tail]] :path path-2}]
-
- ;; {path-0 [:branch "Nil" []]
- ;; path-1 [:branch "Cons" [[:bind head] [:bind tail]]]}
-
- ;; Total registers: 6
- ;; {path-0 [:branch "Cons" [[:adt "Symbol" [[:string-cmp "~"]]] [:adt "Cons" [[:bind unquoted] [:adt "Nil" []]]]]]
- ;; path-1 [:branch "Cons" [[:adt "Symbol" [[:string-cmp "~@"]]] [:adt "Cons" [[:bind spliced] [:adt "Nil" []]]]]]
- ;; path-2 [:default _]}
-
- ;; {"#default#" [:default path-2 _]
- ;; "Cons" [:branches [path-0 path-1]
- ;; [[[:adt "Symbol" [[:string-cmp "~"]]] [:adt "Cons" [[:bind unquoted] [:adt "Nil" []]]]]
- ;; [[:adt "Symbol" [[:string-cmp "~@"]]] [:adt "Cons" [[:bind spliced] [:adt "Nil" []]]]]]]}
-
- ;; [:branches]
+(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}}]
-
- ;; (case elems
- ;; #Nil
- ;; elems
-
- ;; (#Cons (list (' ~) unquoted) tail)
- ;; (list* unquoted (template tail))
-
- ;; (#Cons (list (' ~@) spliced) tail)
- ;; (list* "++" spliced (template tail))
-
- ;; _
- ;; (#Cons head (template tail))
- ;; )
-
- ;; [{:tag "Nil" :data [] :path path-1}
- ;; {:tag "Cons" :data [[:bind head] [:bind tail]] :path path-2}]
-
- ;; [[{:tag "Cons" :data [%0 %1] :path nil
- ;; :sub-cases [[{:tag "Symbol" :data [[:string-cmp "~"]] :path path-1}
- ;; {:tag "Symbol" :data [[:string-cmp "~@"]] :path path-2}]
- ;; [{:tag "Cons" :data [[:bind unquoted] {:tag "Nil" :data []}] :path path-1}
- ;; {:tag "Cons" :data [[:bind spliced] {:tag "Nil" :data []}] :path path-2}]]}
- ;; {:tag ::default :path path-3}]]
-
- ;; [[["Cons" ["Symbol" "~"] ["Cons" unquoted ["Nil"]]]
- ;; ["Cons" ["Symbol" "~@"] ["Cons" spliced ["Nil"]]]
- ;; _]]
-
- ;; [[["Symbol" "~"]
- ;; ["Symbol" "~@"]]
- ;; [["Cons" unquoted ["Nil"]]
- ;; ["Cons" spliced ["Nil"]]]]
-
- ;; (if (= "Cons" (:: % tag))
- ;; (let [%0 (:: % _0)
- ;; %1 (:: % _1)]
- ;; (if (= "Symbol" (:: %0 tag))
- ;; (let [%0|0 (:: %0 _0)]
- ;; (if (= "~" %0|0)
- ;; (if (= "Cons" (:: %1 tag))
- ;; (let [%1|0 (:: %1 _0)
- ;; %1|1 (:: %1 _1)]
- ;; (if (= "Nil" (:: %1|1 tag))
- ;; (let [unquoted %1|0]
- ;; <path-1>)
- ;; <path-3>))
- ;; <path-3>)
- ;; (if (= "@~" %0|0)
- ;; (if (= "Cons" (:: %1 tag))
- ;; (let [%1|0 (:: %1 _0)
- ;; %1|1 (:: %1 _1)]
- ;; (if (= "Nil" (:: %1|1 tag))
- ;; (let [unquoted %1|0]
- ;; <path-2>)
- ;; <path-3>))
- ;; <path-3>)
- ;; <path-3>)))
- ;; <path-3>))
- ;; <path-3>)
-
+ (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)))
-
- ;; (list (list '["Nil" [] ...]
- ;; '["Cons" [head tail] ...]))
-
- ;; (list (list '["Cons" [["Symbol" ["~"]] ["Cons" [unquoted ["Nil" []]]]] ...]
- ;; '["Cons" [["Symbol" ["~@"]] ["Cons" [spliced ["Nil" []]]]] ...]))
)
-