aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/example/test1.lux38
-rw-r--r--src/lux.clj3
-rw-r--r--src/lux/analyser.clj294
-rw-r--r--src/lux/compiler.clj423
-rw-r--r--src/lux/lexer.clj32
-rw-r--r--src/lux/parser.clj16
6 files changed, 202 insertions, 604 deletions
diff --git a/src/example/test1.lux b/src/example/test1.lux
deleted file mode 100644
index 8e740eabd..000000000
--- a/src/example/test1.lux
+++ /dev/null
@@ -1,38 +0,0 @@
-
-(* 5 6)
-
-## My first function definition!
-(def (repeat n val)
- (if (<=' n 0)
- (#Nil [])
- (#Cons [val (repeat (-' n 1) val)])))
-
-## Testing one, two, three...
-(repeat 5 5)
-
-(def (fold f init inputs)
- (case inputs
- #( Outer comment #( Inner comment )# )#
- (#Nil []) init
- (#Cons [head tail]) (fold f (f init head) tail)))
-
-## It's alive!
-(fold * 1 (repeat 5 5))
-
-3.14
-
-(def pi 3.14)
-
-pi
-
-(def (foo x)
- (let [y (*' 2 x)]
- (+' x y)))
-
-(foo 10)
-
-(def bar {#x 10 #y 20})
-bar
-(get@ #x bar)
-(set@ #z 30 bar)
-(remove@ #y bar)
diff --git a/src/lux.clj b/src/lux.clj
index dca7034c3..7553e1845 100644
--- a/src/lux.clj
+++ b/src/lux.clj
@@ -22,8 +22,9 @@
;; TODO: Add "new". Allow setting fields.
;; TODO: monitor enter & monitor exit.
;; TODO: Reinplement "if" as a macro on top of case.
+ ;; TODO: Remember to optimized calling global functions.
;; TODO:
-
+
(&compiler/compile-all ["lux" "test2"])
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 179d2089e..ce84c7310 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -46,12 +46,6 @@
(defn ^:private is-macro? [module name]
(fn [state]
- ;; (prn 'is-macro? (nth name 1)
- ;; (get-in state [:defs (:name state) (nth name 1) :mode])
- ;; (= (get-in state [:defs (:name state) (nth name 1) :mode]) ::macro))
- ;; (prn 'is-macro? name (get-in state [:modules module name :mode])
- ;; (get-in state [:modules module])
- ;; (get-in state [:modules]))
[::&util/ok [state (= (get-in state [:modules module name :mode]) ::macro)]]))
(def ^:private next-local-idx
@@ -68,12 +62,7 @@
(defn ^:private in-scope? [module name]
(fn [state]
- (do ;; (prn 'in-scope?
- ;; ?macro-name
- ;; (get-in state [:lambda-scope 0])
- ;; (some (partial = ?macro-name) (get-in state [:lambda-scope 0])))
- [::&util/ok [state (some (partial = name) (get-in state [:lambda-scope 0]))]])
- ))
+ [::&util/ok [state (some (partial = name) (get-in state [:lambda-scope 0]))]]))
(defn with-scope [scope body]
(fn [state]
@@ -103,17 +92,14 @@
(defn ^:private with-lambda-scope [body]
(fn [state]
- (let [;; _ (prn 'with-lambda-scope (get-in state [:lambda-scope 0]) (get-in state [:lambda-scope 1]))
- =return (body (-> state
+ (let [=return (body (-> state
(update-in [:lambda-scope 0] conj (get-in state [:lambda-scope 1]))
(assoc-in [:lambda-scope 1] 0)))]
(match =return
[::&util/ok [?state ?value]]
- [::&util/ok [(do ;; (prn [:lambda-scope 0] (get-in ?state [:lambda-scope 0]))
- ;; (prn [:lambda-scope 1] (get-in ?state [:lambda-scope 1]))
- (-> ?state
- (update-in [:lambda-scope 0] pop)
- (assoc-in [:lambda-scope 1] (inc (get-in state [:lambda-scope 1])))))
+ [::&util/ok [(-> ?state
+ (update-in [:lambda-scope 0] pop)
+ (assoc-in [:lambda-scope 1] (inc (get-in state [:lambda-scope 1]))))
?value]]
_
@@ -130,18 +116,13 @@
(update-in [:counter] inc)
(assoc-in [:mappings name] (annotated [::local (:id (first %)) (:counter (first %))] type)))
(rest %))))]
- ;; =return
(match =return
[::&util/ok [?state ?value]]
- (do ;; (prn 'POST-WITH-LOCAL name (-> ?state :env first))
- [::&util/ok [(update-in ?state [:env] #(cons (-> (first %)
- (update-in [:counter] dec)
- (update-in [:mappings] dissoc name))
- (rest %)))
- ;; (update-in ?state [:env] (fn [[top & oframes]]
- ;; (prn 'NEW-FRAMES name (cons (-> state :env first (assoc :closure (-> top :closure))) oframes))
- ;; (cons (-> state :env first (assoc :closure (-> top :closure))) oframes)))
- ?value]])
+ [::&util/ok [(update-in ?state [:env] #(cons (-> (first %)
+ (update-in [:counter] dec)
+ (update-in [:mappings] dissoc name))
+ (rest %)))
+ ?value]]
_
=return)
@@ -153,10 +134,9 @@
(rest %))))]
(match =return
[::&util/ok [?state ?value]]
- (do ;; (prn 'POST-WITH-LOCAL name (-> ?state :env first))
- [::&util/ok [(update-in ?state [:env] #(cons (update-in (first %) [:mappings] (fn [m] (apply dissoc m (keys mappings))))
- (rest %)))
- ?value]])
+ [::&util/ok [(update-in ?state [:env] #(cons (update-in (first %) [:mappings] (fn [m] (apply dissoc m (keys mappings))))
+ (rest %)))
+ ?value]]
_
=return))))
@@ -164,7 +144,6 @@
(defn ^:private with-fresh-env [[args-vars args-types] body]
(with-lambda-scope
(fn [state]
- ;; (prn '(:env state) (:env state) (-> state :env first :id inc))
(let [state* (update-in state [:env]
(fn [outer]
(let [frame-id (-> outer first :id inc)
@@ -175,22 +154,13 @@
(update-in (fresh-env frame-id) [:counter] inc)
(map vector args-vars args-types))]
(conj outer new-top))))
- =return (body state*)
- ;; _ (prn '=return =return)
- ]
+ =return (body state*)]
(match =return
[::&util/ok [?state ?value]]
- (do ;; (prn 'PRE-LAMBDA (:env state))
- ;; (prn 'POST-LAMBDA (:env ?state) ?value)
- ;; (prn 'POST-LAMBDA1 (get-in ?state [:lambda-scope 0]) (-> ?state :env first :mappings))
- ;; (prn 'POST-LAMBDA2 (get-in ?state [:lambda-scope 0]) (-> ?state :env first (update-in [:mappings] #(reduce dissoc % args-vars)) :mappings))
- [::&util/ok [(-> ?state
- (update-in [:env] rest)
- ;; (update-in [:lambda-scope 1] inc)
- )
- [(get-in ?state [:lambda-scope 0])
- (-> ?state :env first (update-in [:mappings] #(reduce dissoc % args-vars)))
- ?value]]])
+ [::&util/ok [(update-in ?state [:env] rest)
+ [(get-in ?state [:lambda-scope 0])
+ (-> ?state :env first (update-in [:mappings] #(reduce dissoc % args-vars)))
+ ?value]]]
_
=return)))))
@@ -208,7 +178,6 @@
nil]]))
(defn ^:private close-over [scope ident register frame]
- ;; (prn 'close-over scope ident register)
(let [register* (annotated [::captured scope (:closure/id frame) register] (:type register))]
[register* (-> frame
(update-in [:closure/id] inc)
@@ -218,38 +187,29 @@
(fn [state]
(or (if-let [[_ ?alias ?binding] (re-find #"^(.*)/(.*)$" ident)]
(if-let [?module (get-in state [:deps ?alias])]
- (do (prn 'resolve '[_ ?alias ?binding] ident [:global ?module ?binding])
- [::&util/ok [state (annotated [::global ?module ?binding] ::&type/nothing)]])))
+ [::&util/ok [state (annotated [::global ?module ?binding] ::&type/nothing)]]))
(let [[inner outer] (split-with #(nil? (get-in % [:mappings ident])) (:env state))]
(cond (empty? inner)
- (do ;; (prn 'resolve/inner ident (get-in state [:lambda-scope 0]))
- (prn 'resolve/env ident (-> state :env first :mappings (get ident)))
- [::&util/ok [state (-> state :env first :mappings (get ident))]])
+ [::&util/ok [state (-> state :env first :mappings (get ident))]]
(empty? outer)
- (do ;; (prn 'resolve/outer ident (get-in state [:lambda-scope 0]))
- (if-let [global|import (or (get-in state [:defs-env ident])
- (get-in state [:imports ident]))]
- (do (prn 'resolve/global|import ident global|import)
- [::&util/ok [state global|import]])
- (do (prn 'resolve/UNRESOLVED (str "Unresolved identifier: " ident))
- [::&util/failure (str "Unresolved identifier: " ident)])))
+ (if-let [global|import (or (get-in state [:defs-env ident])
+ (get-in state [:imports ident]))]
+ [::&util/ok [state global|import]]
+ [::&util/failure (str "Unresolved identifier: " ident)])
:else
- (do ;; (prn 'resolve/:else ident (get-in state [:lambda-scope 0]))
- (let [[=local inner*] (reduce (fn [[register new-inner] [frame scope]]
- (let [[register* frame*] (close-over scope ident register frame)]
- [register* (cons frame* new-inner)]))
- [(-> outer first :mappings (get ident)) '()]
- (map vector
- (reverse inner)
- (->> (get-in state [:lambda-scope 0])
- (iterate pop)
- (take (count inner))
- reverse)))]
- ;; (prn 'resolve/inner* inner*)
- (prn 'resolve/=local ident =local)
- [::&util/ok [(assoc state :env (concat inner* outer)) =local]])))))))
+ (let [[=local inner*] (reduce (fn [[register new-inner] [frame scope]]
+ (let [[register* frame*] (close-over scope ident register frame)]
+ [register* (cons frame* new-inner)]))
+ [(-> outer first :mappings (get ident)) '()]
+ (map vector
+ (reverse inner)
+ (->> (get-in state [:lambda-scope 0])
+ (iterate pop)
+ (take (count inner))
+ reverse)))]
+ [::&util/ok [(assoc state :env (concat inner* outer)) =local]]))))))
(defmacro ^:private defanalyser [name match return]
`(def ~name
@@ -261,19 +221,15 @@
(fail* (str "Unmatched token: " token#))))))
(defn analyse-form* [form]
- ;; (prn 'analyse-form* form)
(fn [state]
(let [old-forms (:forms state)
- =return (analyse-form (assoc state :forms (list form)))
- ;; _ (prn 'analyse-form*/=return =return)
- ]
+ =return (analyse-form (assoc state :forms (list form)))]
(match =return
[::&util/ok [?state ?value]]
[::&util/ok [(assoc ?state :forms old-forms) ?value]]
[::&util/failure ?message]
- (do ;; (prn 'analyse-form* ?message)
- [::&util/failure ?message])))))
+ [::&util/failure ?message]))))
(do-template [<name> <tag> <class>]
(defanalyser <name>
@@ -307,18 +263,7 @@
(defanalyser analyse-ident
[::&parser/ident ?ident]
- ;; (exec [_env (fn [state] [::&util/ok [state (:env state)]])
- ;; ;; :let [_ (prn 'analyse-ident ?ident _env)]
- ;; ]
- ;; (resolve ?ident))
- (exec [;; :let [_ (prn 'analyse-ident '?ident ?ident)]
- =ident (resolve ?ident)
- ;; :let [_ (prn 'analyse-ident '=ident =ident)]
- ;; :let [_ (prn 'analyse-ident ?ident =ident)]
- ;; state &util/get-state
- ;; :let [_ (prn 'analyse-ident ?ident (:form =ident) (:env state))]
- ]
- (return =ident)))
+ (resolve ?ident))
(defanalyser analyse-access
[::&parser/static-access ?target ?member]
@@ -336,7 +281,6 @@
(fail "")))
(defn full-class [class]
- ;; (prn 'full-class-name class)
(case class
"boolean" (return Boolean/TYPE)
"byte" (return Byte/TYPE)
@@ -349,9 +293,7 @@
;; else
(if (.contains class ".")
(return (Class/forName class))
- (try-all-m [(exec [=class (resolve class)
- ;; :let [_ (prn '=class =class)]
- ]
+ (try-all-m [(exec [=class (resolve class)]
(match (:form =class)
[::class ?full-name]
(return (Class/forName ?full-name))
@@ -371,11 +313,7 @@
(full-class ?ident)
[::&parser/form ([[::&parser/ident "Array"] [::&parser/ident ?inner]] :seq)]
- (exec [;; :let [_ (prn '?inner ?inner)]
- =inner (full-class ?inner)
- ;; :let [_ (prn '=inner =inner)
- ;; _ (prn '(.getName =inner) (.getName =inner))]
- ]
+ (exec [=inner (full-class ?inner)]
(return (Class/forName (str "[L" (.getName =inner) ";"))))
_
@@ -398,11 +336,7 @@
(fail "")))
(defn lookup-field [mode target field]
- ;; (prn 'lookup-field mode target field)
(if-let [[[owner type]] (seq (for [=field (.getFields (Class/forName target))
- ;; :let [_ (prn target (.getName =field) (if (java.lang.reflect.Modifier/isStatic (.getModifiers =field))
- ;; :static
- ;; :dynamic))]
:when (and (= field (.getName =field))
(case mode
:static (java.lang.reflect.Modifier/isStatic (.getModifiers =field))
@@ -413,11 +347,7 @@
(fail (str "Field does not exist: " target field mode))))
(defn lookup-method [mode target method args]
- ;; (prn 'lookup-method mode target method args)
(if-let [methods (seq (for [=method (.getMethods (Class/forName target))
- ;; :let [_ (prn target (.getName =method) (if (java.lang.reflect.Modifier/isStatic (.getModifiers =method))
- ;; :static
- ;; :dynamic))]
:when (and (= method (.getName =method))
(case mode
:static (java.lang.reflect.Modifier/isStatic (.getModifiers =method))
@@ -440,25 +370,19 @@
(fail (str "Field does not exist: " target field))))
(defn lookup-virtual-method [target method-name args]
- ;; (prn 'lookup-virtual-method target method-name args)
(if-let [method (first (for [=method (.getMethods target)
:when (and (= target (.getDeclaringClass =method))
(= method-name (.getName =method))
(not (java.lang.reflect.Modifier/isStatic (.getModifiers =method))))]
=method))]
- (do ;; (prn 'lookup-virtual-method 'method method)
- (exec [=method (&type/method->type method)]
- (&type/return-type =method)))
- (do ;; (prn 'lookup-virtual-method (str "Virtual method does not exist: " target method-name))
- (fail (str "Virtual method does not exist: " target method-name)))))
+ (exec [=method (&type/method->type method)]
+ (&type/return-type =method))
+ (fail (str "Virtual method does not exist: " target method-name))))
(defn full-class-name [class]
- ;; (prn 'full-class-name class)
(if (.contains class ".")
(return class)
- (try-all-m [(exec [=class (resolve class)
- ;; :let [_ (prn '=class =class)]
- ]
+ (try-all-m [(exec [=class (resolve class)]
(match (:form =class)
[::class ?full-name]
(return ?full-name)
@@ -483,8 +407,6 @@
(exec [=class (full-class-name ?class)
=classes (map-m extract-jvm-param ?classes)
=return (lookup-virtual-method (Class/forName =class) ?method =classes)
- ;; :let [_ (prn 'analyse-jvm-invokevirtual ?class ?method =classes '-> =return)]
- ;; =return =return
=object (analyse-form* ?object)
=args (map-m analyse-form* ?args)]
(return (annotated [::jvm-invokevirtual =class ?method (map #(.getName %) =classes) =object =args] =return))))
@@ -512,45 +434,7 @@
(exec [=array (analyse-form* ?array)]
(return (annotated [::jvm-aaload =array ?idx] (-> =array :type (nth 1))))))
-;; (defanalyser analyse-access
-;; [::&parser/access ?object ?member]
-;; (match ?member
-;; [::&parser/ident ?field] ;; Field
-;; (try-all-m [(exec [?target (extract-ident ?object)
-;; =target (resolve ?target)
-;; ?class (extract-class (:form =target))
-;; [=owner =type] (lookup-field :static ?class ?field)
-;; ;; :let [_ (prn '=type =type)]
-;; ]
-;; (return (annotated [::static-field =owner ?field] =type)))
-;; (exec [=target (analyse-form* ?object)
-;; ?class (class-type (:type =target))
-;; [=owner =type] (lookup-field :dynamic ?class ?field)
-;; ;; :let [_ (prn '=type =type)]
-;; ]
-;; (return (annotated [::dynamic-field =target =owner ?field] =type)))])
-;; [::&parser/fn-call [::&parser/ident ?method] ?args] ;; Method
-;; (exec [=args (map-m analyse-form* ?args)]
-;; (try-all-m [(exec [?target (extract-ident ?object)
-;; =target (resolve ?target)
-;; ?class (extract-class (:form =target))
-;; =methods (lookup-method :static ?class ?method (map :type =args))
-;; ;; :let [_ (prn '=methods =methods)]
-;; [=owner =method] (within :types (&type/pick-matches =methods (map :type =args)))
-;; ;; :let [_ (prn '=method =owner ?method =method)]
-;; ]
-;; (return (annotated [::static-method =owner ?method =method =args] (&type/return-type =method))))
-;; (exec [=target (analyse-form* ?object)
-;; ?class (class-type (:type =target))
-;; =methods (lookup-method :dynamic ?class ?method (map :type =args))
-;; ;; :let [_ (prn '=methods =methods)]
-;; [=owner =method] (within :types (&type/pick-matches =methods (map :type =args)))
-;; ;; :let [_ (prn '=method =owner ?method =method)]
-;; ]
-;; (return (annotated [::dynamic-method =target =owner ?method =method =args] (&type/return-type =method))))]))))
-
(defn ->token [x]
- ;; (prn '->token x)
(match x
[::&parser/bool ?bool]
(doto (.newInstance (.loadClass @loader "lux.Variant1"))
@@ -592,7 +476,6 @@
(defn ->tokens [xs]
(reduce (fn [tail x]
- ;; (prn 'tail (.-tag tail) 'x x)
(doto (.newInstance (.loadClass @loader "lux.Variant2"))
(-> .-tag (set! "Cons"))
(-> .-_1 (set! (->token x)))
@@ -602,7 +485,6 @@
(reverse xs)))
(defn ->clojure-token [x]
- ;; (prn '->clojure-token x (.-tag x))
(case (.-tag x)
"Bool" [::&parser/bool (-> x .-_1)]
"Int" [::&parser/int (-> x .-_1)]
@@ -615,7 +497,6 @@
"Form" [::&parser/form (-> x .-_1 tokens->clojure)]))
(defn tokens->clojure [xs]
- ;; (prn 'tokens->clojure xs (.-tag xs))
(case (.-tag xs)
"Nil" '()
"Cons" (cons (->clojure-token (.-_1 xs))
@@ -624,25 +505,17 @@
(defanalyser analyse-call
[::&parser/form ([?fn & ?args] :seq)]
- (exec [=fn (analyse-form* ?fn)
- ;; :let [_ (prn 'analyse-call/=fn =fn)]
- ]
+ (exec [=fn (analyse-form* ?fn)]
(match (:form =fn)
[::global-fn ?module ?name]
(exec [macro? (is-macro? ?module ?name)
- scoped? (in-scope? ?module ?name)
- :let [_ (prn 'analyse-call [:global-fn ?module ?name] macro? scoped?)]
- ;; :let [_ (prn 'analyse-call [:global-fn ?module ?name] macro? scoped?)]
- ]
+ scoped? (in-scope? ?module ?name)]
(if (and macro? (not scoped?))
(let [macro-class (str ?module "$" (normalize-ident ?name))
transformed (-> (.loadClass @loader macro-class)
.newInstance
(.apply (->tokens ?args))
- ->clojure-token)
- _ (prn 'analyse-call/macro-raw ?args)
- _ (prn 'analyse-call/transformed transformed)
- ]
+ ->clojure-token)]
(-> transformed
analyse-form*))
(exec [=args (map-m analyse-form* ?args)
@@ -652,9 +525,7 @@
provides-num (count =args)]
(if (> needs-num provides-num)
[needs-num [::&type/function (drop provides-num ?fargs) ?freturn]]
- [needs-num [::&type/object "java.lang.Object" []]])))
- ;; _ (prn '[needs-num =return-type] [needs-num =return-type])
- ]]
+ [needs-num [::&type/object "java.lang.Object" []]])))]]
(return (annotated [::static-call needs-num =fn =args] =return-type)))))
_
@@ -665,13 +536,8 @@
(defanalyser analyse-if
[::&parser/form ([[::&parser/ident "if"] ?test ?then ?else] :seq)]
(exec [=test (analyse-form* ?test)
- ;; :let [_ (prn '=test =test)]
- ;; :let [_ (prn 'PRE '?then ?then)]
=then (analyse-form* ?then)
- ;; :let [_ (prn '=then =then)]
- =else (analyse-form* ?else)
- ;; :let [_ (prn '=else =else)]
- ]
+ =else (analyse-form* ?else)]
(return (annotated [::if =test =then =else] ::&type/nothing))))
(defanalyser analyse-do
@@ -754,18 +620,12 @@
:branches #{}}
generate-branches (fn generate-branches [data]
(let [branches* (reduce fold-branch base-struct data)]
- ;; (prn 'generate-branches data)
- ;; (prn 'branches* branches*)
- ;; (.print System/out (prn-str 'branches* branches*))
- ;; (.print System/out (prn-str '(:type branches*) (:type branches*)))
(clojure.core.match/match (:type branches*)
::char-tests branches*
::text-tests branches*
::tuple (do (assert (<= (count (:defaults branches*)) 1))
{:type ::tuple*
- :patterns (into {} (for [[?tag ?struct] {nil (:patterns branches*)}
- ;; :let [_ (prn '(:patterns branches*) ?tag ?struct)]
- ]
+ :patterns (into {} (for [[?tag ?struct] {nil (:patterns branches*)}]
[?tag {:parts (let [grouped-parts (apply map list (for [{:keys [case body]} (:cases ?struct)]
(map #(vector % body) case)))]
(map generate-branches grouped-parts))
@@ -774,9 +634,7 @@
:branches (:branches branches*)})
::adt (do (assert (<= (count (:defaults branches*)) 1))
{:type ::adt*
- :patterns (into {} (for [[?tag ?struct] (:patterns branches*)
- ;; :let [_ (prn '(:patterns branches*) ?tag ?struct)]
- ]
+ :patterns (into {} (for [[?tag ?struct] (:patterns branches*)]
[?tag {:parts (let [grouped-parts (apply map list (for [{:keys [case body]} (:cases ?struct)]
(map #(vector % body) case)))]
(map generate-branches grouped-parts))
@@ -860,7 +718,6 @@
(clojure.core.match/match branch
[::case-branch ?pattern ?body]
[(->instructions locals ?pattern) ?body]))
- ;; _ (prn branches**)
;; Step 5: Re-structure branching
]
[max-registers branch-mappings (generate-branches branches**)])))
@@ -883,13 +740,9 @@
(defanalyser analyse-case
[::&parser/form ([[::&parser/ident "case"] ?variant & ?branches] :seq)]
(exec [=variant (analyse-form* ?variant)
- ;; :let [_ (prn 'analyse-case '=variant =variant)]
$scope scope-id
- ;; :let [_ (prn 'analyse-case '$scope $scope)]
$base next-local-idx
- ;; :let [_ (prn 'analyse-case '$base $base)]
[registers mappings tree] (exec [=branches (map-m (fn [[?pattern ?body]]
- ;; (prn '?branch ?branch)
(match ?pattern
[::&parser/char ?token]
(exec [=body (analyse-form* ?body)]
@@ -910,26 +763,18 @@
[::&parser/tuple ?members]
(exec [[_ locals+] (reduce-m (locals-getter $scope) [$base {}] ?members)
- ;; :let [_ (prn 'analyse-case 'locals+ locals+)]
=body (with-locals locals+
- (analyse-form* ?body))
- ;; :let [_ (prn 'analyse-case '=body =body)]
- ]
+ (analyse-form* ?body))]
(return [::case-branch [::&parser/tuple ?members] =body]))
[::&parser/form ([[::&parser/tag ?tag] & ?members] :seq)]
(exec [[_ locals+] (reduce-m (locals-getter $scope) [$base {}] ?members)
- ;; :let [_ (prn 'analyse-case 'locals+ locals+)]
=body (with-locals locals+
- (analyse-form* ?body))
- ;; :let [_ (prn 'analyse-case '=body =body)]
- ]
+ (analyse-form* ?body))]
(return [::case-branch [::&parser/variant ?tag ?members] =body]))
))
(partition 2 ?branches))]
- (return (->decision-tree $scope $base =branches)))
- ;; :let [_ (prn 'analyse-case '[registers mappings tree] [registers mappings tree])]
- ]
+ (return (->decision-tree $scope $base =branches)))]
(return (annotated [::case (dec $base) =variant registers mappings tree] ::&type/nothing)))))
(defanalyser analyse-let
@@ -942,8 +787,7 @@
(defanalyser analyse-defclass
[::&parser/form ([[::&parser/ident "jvm/defclass"] [::&parser/ident ?name] [::&parser/ident ?super-class] [::&parser/tuple ?fields]] :seq)]
- (exec [;; :let [_ (prn 'analyse-defclass/?fields ?fields)]
- ?fields (map-m (fn [?field]
+ (exec [?fields (map-m (fn [?field]
(match ?field
[::&parser/tuple ([[::&parser/ident ?class] [::&parser/ident ?field-name]] :seq)]
(return [?class ?field-name])
@@ -951,8 +795,7 @@
_
(fail "")))
?fields)
- :let [;; _ (prn 'analyse-defclass/?fields ?fields)
- =members {:fields (into {} (for [[class field] ?fields]
+ :let [=members {:fields (into {} (for [[class field] ?fields]
[field {:access ::public
:type class}]))}]
name module-name]
@@ -960,22 +803,17 @@
(defanalyser analyse-definterface
[::&parser/form ([[::&parser/ident "jvm/definterface"] [::&parser/ident ?name] & ?members] :seq)]
- (exec [;; :let [_ (prn 'analyse-definterface/?members ?members)]
- ?members (map-m #(match %
+ (exec [?members (map-m #(match %
[::&parser/form ([[::&parser/ident ":"] [::&parser/ident ?member-name]
[::&parser/form ([[::&parser/ident "->"] [::&parser/tuple ?inputs] [::&parser/ident ?output]] :seq)]]
:seq)]
- (exec [;; :let [_ (prn '[?member-name ?inputs ?output] [?member-name ?inputs ?output])]
- ?inputs (map-m extract-ident ?inputs)
- ;; :let [_ (prn '[?member-name ?inputs ?output] [?member-name ?inputs ?output])]
- ]
+ (exec [?inputs (map-m extract-ident ?inputs)]
(return [?member-name [?inputs ?output]]))
_
(fail ""))
?members)
- :let [;; _ (prn '?members ?members)
- =members {:methods (into {} (for [[method [inputs output]] ?members]
+ :let [=members {:methods (into {} (for [[method [inputs output]] ?members]
[method {:access ::public
:type [inputs output]}]))}
=interface [::interface ?name =members]]
@@ -995,23 +833,15 @@
[::&parser/form ([[::&parser/ident ?name] & ?args] :seq)]
(exec [args (map-m extract-ident ?args)
- ;; :let [_ (prn 'analyse-def/args args)]
[=function =args =return] (within :types (&type/fresh-function (count args)))
- ;; :let [_ (prn '[=function =args =return] [=function =args =return])]
- ;; :let [env (-> {}
- ;; (assoc ?name =function)
- ;; (into (map vector args =args)))
- ;; _ (prn 'env env)]
=value (with-scope ?name
(with-scoped-name ?name =function
(reduce (fn [inner [label type]]
(with-local label type inner))
(analyse-form* ?value)
(reverse (map vector args =args)))))
- ;; :let [_ (prn '=value =value)]
=function (within :types (exec [_ (&type/solve =return (:type =value))]
(&type/clean =function)))
- ;; :let [_ (prn '=function =function)]
_ (define-fn ?name {:mode ::function
:access ::public
:type =function})]
@@ -1021,19 +851,15 @@
(defanalyser analyse-defmacro
[::&parser/form ([[::&parser/ident "defmacro"] [::&parser/form ([[::&parser/ident ?name] [::&parser/ident ?tokens]] :seq)] ?value] :seq)]
(exec [[=function =tokens =return] (within :types (&type/fresh-function 1))
- :let [_ (prn 'analyse-defmacro/_1 ?name)]
=value (with-scope ?name
(with-scoped-name ?name =function
(with-local ?tokens =tokens
(analyse-form* ?value))))
- :let [_ (prn 'analyse-defmacro/_2 ?name)]
=function (within :types (exec [_ (&type/solve =return (:type =value))]
(&type/clean =function)))
- :let [_ (prn 'analyse-defmacro/_3 ?name)]
_ (define-fn ?name {:mode ::macro
:access ::public
- :type =function})
- :let [_ (prn 'analyse-defmacro/_4 ?name)]]
+ :type =function})]
(return (annotated [::def [?name (list ?tokens)] =value] ::&type/nothing))))
(defanalyser analyse-lambda
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 07a1df1a4..9f6a6cd6c 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -26,11 +26,8 @@
;; [Utils/General]
(defn ^:private write-file [file data]
- ;; (println 'write-file file (alength data))
(with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. file))]
- (.write stream data))
- ;; (Thread/sleep 2000)
- )
+ (.write stream data)))
(defn ^:private write-class [name data]
(write-file (str "output/" name ".class") data))
@@ -47,7 +44,6 @@
~'*writer* (:writer ~'*state*)
~'*parent* (:parent ~'*state*)
~'*type* (:type (:form ~'*state*))]
- ;; (prn '~name (:form (:form ~'*state*)))
(match (:form (:form ~'*state*))
~match
(do ~body
@@ -146,9 +142,7 @@
(instance? java.lang.Boolean ?literal)
(if ?literal
- ;; (.visitLdcInsn *writer* (int 1))
(.visitFieldInsn *writer* Opcodes/GETSTATIC (->class "java.lang.Boolean") "TRUE" (->type-signature "java.lang.Boolean"))
- ;; (.visitLdcInsn *writer* (int 0))
(.visitFieldInsn *writer* Opcodes/GETSTATIC (->class "java.lang.Boolean") "FALSE" (->type-signature "java.lang.Boolean")))
(string? ?literal)
@@ -159,8 +153,7 @@
(defcompiler ^:private compile-tuple
[::&analyser/tuple ?elems]
- (let [;; _ (prn 'compile-tuple (count ?elems))
- num-elems (count ?elems)]
+ (let [num-elems (count ?elems)]
(let [tuple-class (str (str +prefix+ "/Tuple") num-elems)]
(doto *writer*
(.visitTypeInsn Opcodes/NEW tuple-class)
@@ -173,112 +166,85 @@
(defcompiler ^:private compile-local
[::&analyser/local ?env ?idx]
- (do ;; (prn 'LOCAL ?idx)
- (doto *writer*
- (.visitVarInsn Opcodes/ALOAD (int ?idx)))))
+ (doto *writer*
+ (.visitVarInsn Opcodes/ALOAD (int ?idx))))
(defcompiler ^:private compile-captured
[::&analyser/captured ?scope ?captured-id ?source]
- (do ;; (prn 'CAPTURED [?scope ?captured-id])
- (doto *writer*
- (.visitVarInsn Opcodes/ALOAD 0)
- (.visitFieldInsn Opcodes/GETFIELD
- (apply str (interpose "$" (map (comp normalize-ident str) ?scope)))
- (str "__" ?captured-id)
- "Ljava/lang/Object;"))))
+ (doto *writer*
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitFieldInsn Opcodes/GETFIELD
+ (apply str (interpose "$" (map (comp normalize-ident str) ?scope)))
+ (str "__" ?captured-id)
+ "Ljava/lang/Object;")))
(defcompiler ^:private compile-global
[::&analyser/global ?owner-class ?name]
- (do ;; (prn 'GLOBAL ?owner-class ?name *type*)
- ;; (prn 'compile-global (->class (str ?owner-class "$" ?name)) "_datum")
- (doto *writer*
- (.visitFieldInsn Opcodes/GETSTATIC (->class (str ?owner-class "$" (normalize-ident ?name))) "_datum" "Ljava/lang/Object;" ;; (->java-sig *type*)
- ))))
+ (doto *writer*
+ (.visitFieldInsn Opcodes/GETSTATIC (->class (str ?owner-class "$" (normalize-ident ?name))) "_datum" "Ljava/lang/Object;")))
(defcompiler ^:private compile-global-fn
[::&analyser/global-fn ?owner-class ?name]
(let [fn-class (str ?owner-class "$" (normalize-ident ?name))]
(.visitFieldInsn *writer* Opcodes/GETSTATIC (->class fn-class) "_datum" (->type-signature fn-class))))
-;; (defcompiler ^:private compile-call
-;; [::&analyser/call ?fn ?args]
-;; (do (prn 'compile-call (:form ?fn) ?fn ?args)
-;; (doseq [arg (reverse ?args)]
-;; (compile-form (assoc *state* :form arg)))
-;; (match (:form ?fn)
-;; [::&analyser/global ?owner-class ?fn-name]
-;; (let [signature (str "(" (apply str (repeat (count ?args) "Ljava/lang/Object;")) ")" "Ljava/lang/Object;")]
-;; (doto *writer*
-;; (.visitMethodInsn Opcodes/INVOKESTATIC (->class ?owner-class) ?fn-name signature))))))
-
(defcompiler ^:private compile-call
[::&analyser/call ?fn ?args]
- (do ;; (prn 'compile-call (:form ?fn) ?fn ?args)
- (do (compile-form (assoc *state* :form ?fn))
- (let [apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;"]
- (doseq [arg ?args]
- (compile-form (assoc *state* :form arg))
- (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE (str +prefix+ "/Function") "apply" apply-signature))))))
+ (do (compile-form (assoc *state* :form ?fn))
+ (let [apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;"]
+ (doseq [arg ?args]
+ (compile-form (assoc *state* :form arg))
+ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE (str +prefix+ "/Function") "apply" apply-signature)))))
(defcompiler ^:private compile-static-call
[::&analyser/static-call ?needs-num ?fn ?args]
- (do ;; (prn 'compile-call (:form ?fn) ?fn ?args)
- (match (:form ?fn)
- [::&analyser/global-fn ?owner-class ?fn-name]
- (let [arg-sig (->type-signature "java.lang.Object")
- call-class (str (->class ?owner-class) "$" (normalize-ident ?fn-name))
- provides-num (count ?args)]
- (if (>= provides-num ?needs-num)
- (let [apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;"
- impl-sig (str "(" (reduce str "" (repeat ?needs-num arg-sig)) ")" arg-sig)]
- (doto *writer*
- (-> (do (compile-form (assoc *state* :form arg)))
- (->> (doseq [arg (take ?needs-num ?args)])))
- (.visitMethodInsn Opcodes/INVOKESTATIC call-class "impl" impl-sig)
- (-> (doto (do (compile-form (assoc *state* :form arg)))
- (.visitMethodInsn Opcodes/INVOKEINTERFACE (str +prefix+ "/Function") "apply" apply-signature))
- (->> (doseq [arg (drop ?needs-num ?args)])))))
- (let [counter-sig "I"
- init-signature (str "(" (apply str counter-sig (repeat (dec ?needs-num) arg-sig)) ")" "V")]
- (doto *writer*
- (.visitTypeInsn Opcodes/NEW call-class)
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int provides-num))
- (-> (do (compile-form (assoc *state* :form arg)))
- (->> (doseq [arg ?args])))
- (-> (.visitInsn Opcodes/ACONST_NULL)
- (->> (dotimes [_ (dec (- ?needs-num provides-num))])))
- (.visitMethodInsn Opcodes/INVOKESPECIAL call-class "<init>" init-signature)))
- ))
- )))
+ (match (:form ?fn)
+ [::&analyser/global-fn ?owner-class ?fn-name]
+ (let [arg-sig (->type-signature "java.lang.Object")
+ call-class (str (->class ?owner-class) "$" (normalize-ident ?fn-name))
+ provides-num (count ?args)]
+ (if (>= provides-num ?needs-num)
+ (let [apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;"
+ impl-sig (str "(" (reduce str "" (repeat ?needs-num arg-sig)) ")" arg-sig)]
+ (doto *writer*
+ (-> (do (compile-form (assoc *state* :form arg)))
+ (->> (doseq [arg (take ?needs-num ?args)])))
+ (.visitMethodInsn Opcodes/INVOKESTATIC call-class "impl" impl-sig)
+ (-> (doto (do (compile-form (assoc *state* :form arg)))
+ (.visitMethodInsn Opcodes/INVOKEINTERFACE (str +prefix+ "/Function") "apply" apply-signature))
+ (->> (doseq [arg (drop ?needs-num ?args)])))))
+ (let [counter-sig "I"
+ init-signature (str "(" (apply str counter-sig (repeat (dec ?needs-num) arg-sig)) ")" "V")]
+ (doto *writer*
+ (.visitTypeInsn Opcodes/NEW call-class)
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int provides-num))
+ (-> (do (compile-form (assoc *state* :form arg)))
+ (->> (doseq [arg ?args])))
+ (-> (.visitInsn Opcodes/ACONST_NULL)
+ (->> (dotimes [_ (dec (- ?needs-num provides-num))])))
+ (.visitMethodInsn Opcodes/INVOKESPECIAL call-class "<init>" init-signature)))
+ ))
+ ))
(defcompiler ^:private compile-jvm-getstatic
[::&analyser/jvm-getstatic ?owner ?field]
- (do ;; (prn 'compile-static-field ?owner ?field)
- ;; (assert false)
- (doto *writer*
- (.visitFieldInsn Opcodes/GETSTATIC (->class ?owner) ?field (->java-sig *type*)))
- ))
+ (doto *writer*
+ (.visitFieldInsn Opcodes/GETSTATIC (->class ?owner) ?field (->java-sig *type*))))
(defcompiler ^:private compile-dynamic-field
[::&analyser/dynamic-field ?target ?owner ?field]
- (do ;; (prn 'compile-static-field ?owner ?field)
- ;; (assert false)
- (compile-form (assoc *state* :form ?target))
+ (do (compile-form (assoc *state* :form ?target))
(doto *writer*
- (.visitFieldInsn Opcodes/GETFIELD (->class ?owner) ?field (->java-sig *type*)))
- ))
+ (.visitFieldInsn Opcodes/GETFIELD (->class ?owner) ?field (->java-sig *type*)))))
(defcompiler ^:private compile-static-method
[::&analyser/static-method ?owner ?method-name ?method-type ?args]
- (do ;; (prn 'compile-dynamic-access ?target ?owner ?method-name ?method-type ?args)
- ;; (assert false)
- (do (doseq [arg ?args]
- (compile-form (assoc *state* :form arg)))
- (doto *writer*
- (.visitMethodInsn Opcodes/INVOKESTATIC (->class ?owner) ?method-name (method->sig ?method-type))
- (.visitInsn Opcodes/ACONST_NULL)))
- ))
+ (do (doseq [arg ?args]
+ (compile-form (assoc *state* :form arg)))
+ (doto *writer*
+ (.visitMethodInsn Opcodes/INVOKESTATIC (->class ?owner) ?method-name (method->sig ?method-type))
+ (.visitInsn Opcodes/ACONST_NULL))))
(defn prepare-arg! [*writer* class-name]
(condp = class-name
@@ -339,8 +305,7 @@
(defcompiler ^:private compile-jvm-invokevirtual
[::&analyser/jvm-invokevirtual ?class ?method ?classes ?object ?args]
- (let [;; _ (prn 'compile-jvm-invokevirtual [?class ?method ?classes] '-> *type*)
- method-sig (str "(" (reduce str "" (map ->type-signature ?classes)) ")" (->java-sig *type*))]
+ (let [method-sig (str "(" (reduce str "" (map ->type-signature ?classes)) ")" (->java-sig *type*))]
(compile-form (assoc *state* :form ?object))
(.visitTypeInsn *writer* Opcodes/CHECKCAST (->class ?class))
(doseq [[class-name arg] (map vector ?classes ?args)]
@@ -391,20 +356,16 @@
[::&analyser/if ?test ?then ?else]
(let [else-label (new Label)
end-label (new Label)]
- ;; (println "PRE")
(compile-form (assoc *state* :form ?test))
(doto *writer*
(.visitTypeInsn Opcodes/CHECKCAST +bool-class+)
(.visitMethodInsn Opcodes/INVOKEVIRTUAL +bool-class+ "booleanValue" "()Z")
(.visitJumpInsn Opcodes/IFEQ else-label))
- ;; (prn 'compile-if/?then (:form ?then))
(compile-form (assoc *state* :form ?then))
- ;; (.visitInsn *writer* Opcodes/POP)
(doto *writer*
(.visitJumpInsn Opcodes/GOTO end-label)
(.visitLabel else-label))
(compile-form (assoc *state* :form ?else))
- ;; (.visitInsn *writer* Opcodes/POP)
(.visitLabel *writer* end-label))))
(defcompiler ^:private compile-do
@@ -421,7 +382,6 @@
+variant-field-sig+ (->type-signature "java.lang.Object")
equals-sig (str "(" (->type-signature "java.lang.Object") ")Z")]
(defn compile-decision-tree [writer mappings default-label decision-tree]
- ;; (prn 'compile-decision-tree decision-tree)
(match decision-tree
[::test-char ?pairs]
(do (doseq [[?token $body] ?pairs
@@ -506,9 +466,7 @@
(.visitJumpInsn Opcodes/IFEQ tag-else-label) ;; variant, tag
(.visitInsn Opcodes/POP) ;; variant
(do (let [arity (-> ?subcases first (nth 2) count)
- variant-class** (str variant-class* arity)
- ;; _ (prn ?tag arity variant-class**)
- ]
+ variant-class** (str variant-class* arity)]
(.visitTypeInsn writer Opcodes/CHECKCAST variant-class**) ;; variantN
(doseq [subcase ?subcases
:let [next-subcase (new Label)]]
@@ -532,7 +490,6 @@
;; variant, tag ->
(.visitLabel tag-else-label))
(->> (doseq [[?tag ?subcases] ?cases
- ;; :let [_ (.print System/out (prn-str 'COMPILE-PATTERN ?tag ?subcases))]
:let [tag-else-label (new Label)]])))
;; variant, tag ->
(.visitInsn Opcodes/POP) ;; variant ->
@@ -541,23 +498,18 @@
))
(defn sequence-parts [branches parts]
- ;; (.print System/out (prn-str 'sequence-parts branches parts))
(if (empty? parts)
'(())
(let [[head & tail] parts
expanded (case (:type head)
::&analyser/defaults
(for [[?local ?supports] (:stores head)
- ?body (set/intersection branches ?supports)
- ;; :when (set/subset? branches ?supports)
- ]
+ ?body (set/intersection branches ?supports)]
[[::store ?local ?body] #{?body}])
::&analyser/char-tests
(concat (list [[::test-char (for [[?token ?supports] (:patterns head)
- ?body (set/intersection branches ?supports)
- ;; :when (set/subset? branches ?supports)
- ]
+ ?body (set/intersection branches ?supports)]
[?token ?body])]
branches])
(for [[_ ?local ?body] (:defaults head)
@@ -566,9 +518,7 @@
::&analyser/text-tests
(concat (list [[::test-text (for [[?token ?supports] (:patterns head)
- ?body (set/intersection branches ?supports)
- ;; :when (set/subset? branches ?supports)
- ]
+ ?body (set/intersection branches ?supports)]
[?token ?body])]
branches])
(for [[_ ?local ?body] (:defaults head)
@@ -577,14 +527,11 @@
::&analyser/tuple*
(concat (let [patterns (into {} (for [[?tag ?struct] (:patterns head)
- ;; :let [_ (.print System/out (prn-str 'PATTERN ?tag ?struct))]
:let [?parts (:parts ?struct)
num-parts (count ?parts)
?supports (:branches ?struct)
subcases (for [?body (set/intersection branches ?supports)
subseq (sequence-parts #{?body} ?parts)
- ;; :let [_ (when (= "Symbol" ?tag)
- ;; (.print System/out (prn-str 'counting ?tag num-parts (count subseq) subseq)))]
:when (= num-parts (count subseq))]
[::subcase ?body subseq])]
:when (not (empty? subcases))]
@@ -599,52 +546,27 @@
'()))
::&analyser/adt*
- (do ;; (prn '(:default head) (:default head))
- ;; (assert (nil? (:default head)))
- ;; (let [patterns (into {} (for [[?tag ?struct] (:patterns head)
- ;; ;; :let [_ (.print System/out (prn-str 'PATTERN ?tag ?struct))]
- ;; :let [?parts (:parts ?struct)
- ;; num-parts (count ?parts)
- ;; ?supports (:branches ?struct)
- ;; subcases (for [?body (set/intersection branches ?supports)
- ;; subseq (sequence-parts #{?body} ?parts)
- ;; ;; :let [_ (when (= "Symbol" ?tag)
- ;; ;; (.print System/out (prn-str 'counting ?tag num-parts (count subseq) subseq)))]
- ;; :when (= num-parts (count subseq))]
- ;; [::subcase ?body subseq])]
- ;; :when (not (empty? subcases))]
- ;; [?tag subcases]))]
- ;; (if (empty? patterns)
- ;; '()
- ;; (list [[::test-adt branches patterns]
- ;; branches])))
- (concat (let [patterns (into {} (for [[?tag ?struct] (:patterns head)
- ;; :let [_ (.print System/out (prn-str 'PATTERN ?tag ?struct))]
- :let [?parts (:parts ?struct)
- num-parts (count ?parts)
- ?supports (:branches ?struct)
- subcases (for [?body (set/intersection branches ?supports)
- subseq (sequence-parts #{?body} ?parts)
- ;; :let [_ (when (= "Symbol" ?tag)
- ;; (.print System/out (prn-str 'counting ?tag num-parts (count subseq) subseq)))]
- :when (= num-parts (count subseq))]
- [::subcase ?body subseq])]
- :when (not (empty? subcases))]
- [?tag subcases]))]
- (if (empty? patterns)
- '()
- (list [[::test-adt branches patterns]
- branches])))
- (if-let [[_ ?local ?body] (:default head)]
- (for [?body (set/intersection branches #{?body})]
- [[::default ?local ?body] #{?body}])
- '()))
- )
+ (concat (let [patterns (into {} (for [[?tag ?struct] (:patterns head)
+ :let [?parts (:parts ?struct)
+ num-parts (count ?parts)
+ ?supports (:branches ?struct)
+ subcases (for [?body (set/intersection branches ?supports)
+ subseq (sequence-parts #{?body} ?parts)
+ :when (= num-parts (count subseq))]
+ [::subcase ?body subseq])]
+ :when (not (empty? subcases))]
+ [?tag subcases]))]
+ (if (empty? patterns)
+ '()
+ (list [[::test-adt branches patterns]
+ branches])))
+ (if-let [[_ ?local ?body] (:default head)]
+ (for [?body (set/intersection branches #{?body})]
+ [[::default ?local ?body] #{?body}])
+ '()))
)]
(for [[step branches*] expanded
- tail* (sequence-parts branches* tail)
- ;; :let [_ (.print System/out (prn-str 'tail* tail*))]
- ]
+ tail* (sequence-parts branches* tail)]
(cons step tail*)))))
(def !case-vars (atom -1))
@@ -653,83 +575,53 @@
equals-sig (str "(" (->type-signature "java.lang.Object") ")Z")
ex-class (->class "java.lang.IllegalStateException")]
(defcompiler ^:private compile-case
- ;; [::&analyser/case ?variant ?branches]
[::&analyser/case ?base-idx ?variant ?max-registers ?branch-mappings ?decision-tree]
- (do ;; (prn 'compile-case ?base-idx ?variant ?max-registers ?branch-mappings ?decision-tree)
- ;; (assert false)
- ;; (prn 'compile-case ?decision-tree)
- (let [start-label (new Label)
- end-label (new Label)
- ;; default-label (new Label)
- entries (for [[?branch ?body] ?branch-mappings
- :let [label (new Label)]]
- [[?branch label]
- [label ?body]])
- mappings* (into {} (map first entries))]
- (dotimes [idx ?max-registers]
- (.visitLocalVariable *writer* (str "__" (swap! !case-vars inc) "__") (->java-sig ::&type/any) nil start-label end-label (+ ?base-idx (inc idx))))
- (compile-form (assoc *state* :form ?variant))
+ (let [start-label (new Label)
+ end-label (new Label)
+ entries (for [[?branch ?body] ?branch-mappings
+ :let [label (new Label)]]
+ [[?branch label]
+ [label ?body]])
+ mappings* (into {} (map first entries))]
+ (dotimes [idx ?max-registers]
+ (.visitLocalVariable *writer* (str "__" (swap! !case-vars inc) "__") (->java-sig ::&type/any) nil start-label end-label (+ ?base-idx (inc idx))))
+ (compile-form (assoc *state* :form ?variant))
+ (doto *writer*
+ (.visitInsn Opcodes/DUP)
+ (.visitLabel start-label))
+ (let [default-label (new Label)]
+ (doseq [decision-tree (let [pieces (map first (sequence-parts (:branches ?decision-tree) (list ?decision-tree)))]
+ (if (or (:default ?decision-tree)
+ (not (empty? (:defaults ?decision-tree))))
+ (butlast pieces)
+ pieces))]
+ (compile-decision-tree *writer* mappings* default-label decision-tree))
+ (.visitLabel *writer* default-label)
+ (if-let [[_ [_ _ ?idx] ?body] (or (:default ?decision-tree)
+ (first (:defaults ?decision-tree)))]
(doto *writer*
(.visitInsn Opcodes/DUP)
- (.visitLabel start-label))
- (let [default-label (new Label)
- ;; default-code (:default ?decision-tree)
- ]
- ;; (prn 'sequence-parts
- ;; (sequence-parts (:branches ?decision-tree) (list ?decision-tree)))
- (doseq [decision-tree (let [pieces (map first (sequence-parts (:branches ?decision-tree) (list ?decision-tree)))]
- (if (or (:default ?decision-tree)
- (not (empty? (:defaults ?decision-tree))))
- (butlast pieces)
- pieces))]
- (compile-decision-tree *writer* mappings* default-label decision-tree))
- (.visitLabel *writer* default-label)
- (if-let [[_ [_ _ ?idx] ?body] (or (:default ?decision-tree)
- (first (:defaults ?decision-tree)))]
- (doto *writer*
- (.visitInsn Opcodes/DUP)
- (.visitVarInsn Opcodes/ASTORE ?idx)
- (.visitJumpInsn Opcodes/GOTO (get mappings* ?body)))
- (doto *writer*
- (.visitInsn Opcodes/POP)
- ;; (.visitTypeInsn Opcodes/CHECKCAST (->class +variant-class+))
- ;; (.visitFieldInsn Opcodes/GETFIELD (->class +variant-class+) "tag" (->type-signature "java.lang.String"))
- (.visitTypeInsn Opcodes/NEW ex-class)
- (.visitInsn Opcodes/DUP)
- ;; (.visitInsn Opcodes/DUP_X1)
- ;; (.visitInsn Opcodes/SWAP)
- (.visitMethodInsn Opcodes/INVOKESPECIAL ex-class "<init>" "()V")
- ;; (.visitMethodInsn Opcodes/INVOKESPECIAL ex-class "<init>" (str "(" (->type-signature "java.lang.String") ")" "V"))
- (.visitInsn Opcodes/ATHROW)))
- ;; (if default-code
- ;; ;; (do (prn 'default-code default-code)
- ;; ;; (assert false)
- ;; ;; ;; (.visitInsn Opcodes/POP) ;; ...
- ;; ;; (compile-form (assoc *state* :form default-code))
- ;; ;; (.visitJumpInsn *writer* Opcodes/GOTO end-label))
- ;; (doto *writer*
- ;; (.visitInsn Opcodes/POP)
- ;; (.visitTypeInsn Opcodes/NEW ex-class)
- ;; (.visitInsn Opcodes/DUP)
- ;; (.visitMethodInsn Opcodes/INVOKESPECIAL ex-class "<init>" "()V")
- ;; (.visitInsn Opcodes/ATHROW)))
- )
- ;; (compile-decision-tree *state* *writer* mappings* 1 nil (:branches ?decision-tree) ?decision-tree)
- (doseq [[?label ?body] (map second entries)]
- (.visitLabel *writer* ?label)
- (.visitInsn *writer* Opcodes/POP)
- (compile-form (assoc *state* :form ?body))
- (.visitJumpInsn *writer* Opcodes/GOTO end-label))
- (.visitLabel *writer* end-label)
- ))
- ))
+ (.visitVarInsn Opcodes/ASTORE ?idx)
+ (.visitJumpInsn Opcodes/GOTO (get mappings* ?body)))
+ (doto *writer*
+ (.visitInsn Opcodes/POP)
+ (.visitTypeInsn Opcodes/NEW ex-class)
+ (.visitInsn Opcodes/DUP)
+ (.visitMethodInsn Opcodes/INVOKESPECIAL ex-class "<init>" "()V")
+ (.visitInsn Opcodes/ATHROW))))
+ (doseq [[?label ?body] (map second entries)]
+ (.visitLabel *writer* ?label)
+ (.visitInsn *writer* Opcodes/POP)
+ (compile-form (assoc *state* :form ?body))
+ (.visitJumpInsn *writer* Opcodes/GOTO end-label))
+ (.visitLabel *writer* end-label)
+ )))
(defcompiler ^:private compile-let
[::&analyser/let ?idx ?label ?value ?body]
(let [start-label (new Label)
end-label (new Label)
?idx (int ?idx)]
- ;; (prn '(:type ?value) (:type ?value) (->java-sig (:type ?value)))
(.visitLocalVariable *writer* (normalize-ident ?label) (->java-sig (:type ?value)) nil start-label end-label ?idx)
(assert (compile-form (assoc *state* :form ?value)) "CAN't COMPILE LET-VALUE")
(doto *writer*
@@ -817,11 +709,8 @@
(-> (.visitInsn Opcodes/ACONST_NULL)
(->> (dotimes [clo_idx (- (dec num-captured) current-captured)])))
(.visitMethodInsn Opcodes/INVOKESPECIAL current-class "<init>" init-signature)
- ;; (.visitJumpInsn Opcodes/GOTO end-label)
(.visitInsn Opcodes/ARETURN))
- (->> (doseq [[branch-label current-captured] (map vector branch-labels (range (count branch-labels)))
- ;; :let [_ (prn '[branch-label current-captured] [branch-label current-captured])]
- ])))
+ (->> (doseq [[branch-label current-captured] (map vector branch-labels (range (count branch-labels)))])))
(.visitLabel default-label)
(-> (doto (.visitVarInsn Opcodes/ALOAD 0)
(.visitFieldInsn Opcodes/GETFIELD current-class (str "_" clo_idx) clo-field-sig))
@@ -829,7 +718,6 @@
(->> (when (not= 0 num-captured))))
(.visitVarInsn Opcodes/ALOAD 1)
(.visitMethodInsn Opcodes/INVOKESTATIC current-class "impl" real-signature)
- ;; (.visitLabel end-label)
(.visitInsn Opcodes/ARETURN)
(.visitMaxs 0 0)
(.visitEnd)))
@@ -864,25 +752,22 @@
(defcompiler ^:private compile-def
[::&analyser/def ?form ?body]
- (do ;; (prn 'compile-def ?form)
- (match ?form
- (?name :guard string?)
- (compile-field *writer* *class-name* ?name ?body *state*)
-
- [?name ?args]
- (do ;; (prn 'compile-def `(~'def (~(symbol ?name) ~@(map symbol ?args))))
- (if (= "main" ?name)
- (let [signature "([Ljava/lang/String;)V"
- =method (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name signature nil nil)
- (.visitCode))]
- ;; (prn 'FN/?body ?body)
- (compile-form (assoc *state* :parent *writer* :writer =method :form ?body))
- (doto =method
- (.visitInsn Opcodes/RETURN)
- (.visitMaxs 0 0)
- (.visitEnd)))
- (compile-method-function *writer* *class-name* ?name (count ?args) ?body *state*)))
- )))
+ (match ?form
+ (?name :guard string?)
+ (compile-field *writer* *class-name* ?name ?body *state*)
+
+ [?name ?args]
+ (if (= "main" ?name)
+ (let [signature "([Ljava/lang/String;)V"
+ =method (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name signature nil nil)
+ (.visitCode))]
+ (compile-form (assoc *state* :parent *writer* :writer =method :form ?body))
+ (doto =method
+ (.visitInsn Opcodes/RETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd)))
+ (compile-method-function *writer* *class-name* ?name (count ?args) ?body *state*))
+ ))
(defn ^:private captured? [form]
(match form
@@ -893,14 +778,11 @@
(defcompiler ^:private compile-lambda
[::&analyser/lambda ?scope ?frame ?args ?body]
- (let [;; _ (prn '[?scope ?frame] ?scope ?frame ?args)
- num-args (count ?args)
- ;; outer-class (->class *class-name*)
+ (let [num-args (count ?args)
clo-field-sig (->type-signature "java.lang.Object")
counter-sig "I"
apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;"
real-signature (str "(" (apply str (repeat num-args clo-field-sig)) ")" "Ljava/lang/Object;")
- ;; current-class (apply str (interpose "$" ?scope))
current-class (apply str (interpose "$" (map (comp normalize-ident str) ?scope)))
num-captured (dec num-args)
init-signature (str "(" (apply str (repeat (->> (:mappings ?frame)
@@ -912,8 +794,6 @@
(apply str counter-sig (repeat num-captured clo-field-sig)))
")"
"V")
- ;; _ (prn current-class 'init-signature init-signature)
- ;; _ (prn current-class 'real-signature real-signature)
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
current-class nil "java/lang/Object" (into-array [(str +prefix+ "/Function")]))
@@ -981,9 +861,7 @@
(->> (dotimes [clo_idx (- (dec num-captured) current-captured)])))
(.visitMethodInsn Opcodes/INVOKESPECIAL current-class "<init>" init-signature)
(.visitInsn Opcodes/ARETURN))
- (->> (doseq [[branch-label current-captured] (map vector branch-labels (range (count branch-labels)))
- ;; :let [_ (prn '[branch-label current-captured] [branch-label current-captured])]
- ])))
+ (->> (doseq [[branch-label current-captured] (map vector branch-labels (range (count branch-labels)))])))
(.visitLabel default-label)
(-> (doto (.visitVarInsn Opcodes/ALOAD 0)
(.visitFieldInsn Opcodes/GETFIELD current-class (str "_" clo_idx) clo-field-sig))
@@ -994,7 +872,6 @@
(.visitInsn Opcodes/ARETURN)
(.visitMaxs 0 0)
(.visitEnd)))
- ;; _ (prn 'LAMBDA/?body ?body)
=impl (doto (.visitMethod =class Opcodes/ACC_PUBLIC "impl" real-signature nil nil)
(.visitCode)
(->> (assoc *state* :form ?body :writer)
@@ -1006,17 +883,6 @@
bytecode (.toByteArray =class)]
(write-class current-class bytecode)
(load-class! (string/replace current-class #"/" ".") (str current-class ".class"))
- ;; (apply prn 'LAMBDA ?scope ?args (->> (:mappings ?frame)
- ;; (map second)
- ;; (map :form)
- ;; (filter captured?)))
- ;; (prn 'M2 (:mappings ?frame))
- ;; (prn 'M2 (->> (:mappings ?frame)
- ;; (filter (comp captured? :form second))))
- ;; (prn 'M3 (->> (:mappings ?frame)
- ;; (filter (comp captured? :form second))
- ;; (sort #(< (-> %1 second :form (nth 2))
- ;; (-> %2 second :form (nth 2))))))
(doto *writer*
(.visitTypeInsn Opcodes/NEW current-class)
(.visitInsn Opcodes/DUP)
@@ -1028,7 +894,6 @@
(sort #(< (-> %1 second :form (nth 2))
(-> %2 second :form (nth 2)))))])))
(-> (doto (.visitInsn Opcodes/ICONST_0)
- ;; (.visitInsn Opcodes/ICONST_0)
(-> (.visitInsn Opcodes/ACONST_NULL)
(->> (doseq [_ (butlast ?args)]))))
(->> (when (> (count ?args) 1))))
@@ -1076,7 +941,6 @@
(defcompiler ^:private compile-variant
[::&analyser/variant ?tag ?members]
(let [variant-class* (str (->class +variant-class+) (count ?members))]
- ;; (prn 'compile-variant ?tag ?value)
(doto *writer*
(.visitTypeInsn Opcodes/NEW variant-class*)
(.visitInsn Opcodes/DUP)
@@ -1097,18 +961,10 @@
(defcompiler compile-use
[::&analyser/use ?file ?alias]
(let [module-name (re-find #"[^/]+$" ?file)
- ;; _ (prn 'module-name module-name)
source-code (slurp (str "source/" module-name ".lux"))
- ;; _ (prn 'source-code source-code)
tokens (&lexer/lex source-code)
- ;; _ (prn 'tokens tokens)
syntax (&parser/parse tokens)
- ;; _ (prn 'syntax syntax)
- ;; ann-syntax (&analyser/analyse module-name syntax)
- ;; _ (prn 'ann-syntax ann-syntax)
bytecode (compile module-name syntax)]
- ;; (write-file (str module-name ".class") bytecode)
- ;; (load-class! (string/replace module-name #"/" ".") (str module-name ".class"))
nil))
(let [+int-class+ (->class "java.lang.Integer")]
@@ -1166,22 +1022,13 @@
compile-jvm-aastore
compile-jvm-aaload]]
(defn ^:private compile-form [state]
- ;; (prn 'compile-form/state state)
(or (some #(% state) +compilers+)
(assert false (str "Can't compile: " (pr-str (:form state)))))))
;; [Interface]
(def !state (atom nil))
-;; "map" {:mode :lux.analyser/function,
-;; :access :lux.analyser/public,
-;; :type [:lux.type/function (:lux.type/any :lux.type/any) :lux.type/any]}
-
-;; "map" {:form [:lux.analyser/global-fn "lux" "map"],
-;; :type [:lux.type/function (:lux.type/any :lux.type/any) :lux.type/any]}
-
(defn compile [module-name inputs]
- ;; (prn 'inputs inputs)
(if-let [module (get-in @!state [:modules module-name])]
(assert false "Can't redefine a module!")
(do (reset-loader!)
diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj
index c0ced6baf..8f7bdbb1d 100644
--- a/src/lux/lexer.clj
+++ b/src/lux/lexer.clj
@@ -39,13 +39,8 @@
(def ^:private lex-string-body
(try-all-m [(exec [[prefix escaped] (lex-regex2 #"(?s)^([^\"\\]*)(\\.)")
- ;; :let [_ (prn '[prefix escaped] [prefix escaped])]
unescaped (escape-char escaped)
- ;; :let [_ (prn 'unescaped unescaped)]
- postfix lex-string-body
- ;; :let [_ (prn 'postfix postfix)]
- ;; :let [_ (prn 'FULL (str prefix unescaped postfix))]
- ]
+ postfix lex-string-body]
(return (str prefix unescaped postfix)))
(lex-regex #"(?s)^([^\"\\]*)")]))
@@ -74,41 +69,24 @@
(def ^:private lex-text
(exec [_ (lex-str "\"")
- ;; state &util/get-state
- ;; :let [_ (prn 'PRE state)]
token lex-string-body
- _ (lex-str "\"")
- ;; state &util/get-state
- ;; :let [_ (prn 'POST state)]
- ]
+ _ (lex-str "\"")]
(return [::text token])))
(def ^:private lex-single-line-comment
(exec [_ (lex-str "##")
comment (lex-regex #"^([^\n]*)")
- _ (lex-regex #"^(\n?)")
- ;; :let [_ (prn 'comment comment)]
- ]
+ _ (lex-regex #"^(\n?)")]
(return [::comment comment])))
(def ^:private lex-multi-line-comment
(exec [_ (lex-str "#(")
- ;; :let [_ (prn 'OPEN)]
- ;; comment (lex-regex #"^(#\(.*\)#)")
comment (try-all-m [(lex-regex #"(?is)^((?!#\().)*?(?=\)#)")
(exec [pre (lex-regex #"(?is)^(.+?(?=#\())")
- ;; :let [_ (prn 'PRE pre)]
[_ inner] lex-multi-line-comment
- ;; :let [_ (prn 'INNER inner)]
- post (lex-regex #"(?is)^(.+?(?=\)#))")
- ;:let [_ (prn 'POST post)]
- ]
+ post (lex-regex #"(?is)^(.+?(?=\)#))")]
(return (str pre "#(" inner ")#" post)))])
- ;; :let [_ (prn 'COMMENT comment)]
- _ (lex-str ")#")
- ;; :let [_ (prn 'CLOSE)]
- ;; :let [_ (prn 'multi-comment comment)]
- ]
+ _ (lex-str ")#")]
(return [::comment comment])))
(def ^:private lex-comment
diff --git a/src/lux/parser.clj b/src/lux/parser.clj
index d25208dc5..bb7b0f212 100644
--- a/src/lux/parser.clj
+++ b/src/lux/parser.clj
@@ -60,22 +60,6 @@
?elems)]
(return [::form =elems])))
-;; (defparser ^:private parse-get
-;; [::&lexer/list ([[::&lexer/ident "get@"] [::&lexer/tag ?tag] ?record] :seq)]
-;; (exec [=record (apply-m parse-token (list ?record))]
-;; (return [::get ?tag =record])))
-
-;; (defparser ^:private parse-remove
-;; [::&lexer/list ([[::&lexer/ident "remove@"] [::&lexer/tag ?tag] ?record] :seq)]
-;; (exec [=record (apply-m parse-token (list ?record))]
-;; (return [::remove ?tag =record])))
-
-;; (defparser ^:private parse-set
-;; [::&lexer/list ([[::&lexer/ident "set@"] [::&lexer/tag ?tag] ?value ?record] :seq)]
-;; (exec [=value (apply-m parse-token (list ?value))
-;; =record (apply-m parse-token (list ?record))]
-;; (return [::set ?tag =value =record])))
-
(def ^:private parse-token
(try-all-m [parse-bool
parse-int
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-28 10:48:15 +0000