aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux108
-rw-r--r--source/test2.lux8
-rw-r--r--src/lux.clj9
-rw-r--r--src/lux/analyser.clj853
-rw-r--r--src/lux/compiler.clj62
-rw-r--r--src/lux/lexer.clj62
-rw-r--r--src/lux/parser.clj139
-rw-r--r--src/lux/util.clj14
8 files changed, 594 insertions, 661 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 8f02c681d..2b008f95f 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -1,79 +1,96 @@
## Base interfaces & classes
-(jvm/definterface Function
+(jvm:interface Function
(: apply (-> [java.lang.Object] java.lang.Object)))
-(jvm/defclass Tuple0 java.lang.Object
+(jvm:class Tuple0 java.lang.Object
[])
-(jvm/defclass Tuple1 java.lang.Object
+(jvm:class Tuple1 java.lang.Object
[[java.lang.Object _1]])
-(jvm/defclass Tuple2 java.lang.Object
+(jvm:class Tuple2 java.lang.Object
[[java.lang.Object _1] [java.lang.Object _2]])
-(jvm/defclass Tuple3 java.lang.Object
+(jvm:class Tuple3 java.lang.Object
[[java.lang.Object _1] [java.lang.Object _2]
[java.lang.Object _3]])
-(jvm/defclass Tuple4 java.lang.Object
+(jvm:class Tuple4 java.lang.Object
[[java.lang.Object _1] [java.lang.Object _2]
[java.lang.Object _3] [java.lang.Object _4]])
-(jvm/defclass Tuple5 java.lang.Object
+(jvm:class Tuple5 java.lang.Object
[[java.lang.Object _1] [java.lang.Object _2]
[java.lang.Object _3] [java.lang.Object _4]
[java.lang.Object _5]])
-(jvm/defclass Tuple6 java.lang.Object
+(jvm:class Tuple6 java.lang.Object
[[java.lang.Object _1] [java.lang.Object _2]
[java.lang.Object _3] [java.lang.Object _4]
[java.lang.Object _5] [java.lang.Object _6]])
-(jvm/defclass Tuple7 java.lang.Object
+(jvm:class Tuple7 java.lang.Object
[[java.lang.Object _1] [java.lang.Object _2]
[java.lang.Object _3] [java.lang.Object _4]
[java.lang.Object _5] [java.lang.Object _6]
[java.lang.Object _7]])
-(jvm/defclass Tuple8 java.lang.Object
+(jvm:class Tuple8 java.lang.Object
[[java.lang.Object _1] [java.lang.Object _2]
[java.lang.Object _3] [java.lang.Object _4]
[java.lang.Object _5] [java.lang.Object _6]
[java.lang.Object _7] [java.lang.Object _8]])
-(jvm/defclass Variant java.lang.Object
+(jvm:class Variant java.lang.Object
[[java.lang.String tag]])
-(jvm/defclass Variant0 lux.Variant
+(jvm:class Variant0 lux.Variant
[])
-(jvm/defclass Variant1 lux.Variant
+(jvm:class Variant1 lux.Variant
[[java.lang.Object _1]])
-(jvm/defclass Variant2 lux.Variant
+(jvm:class Variant2 lux.Variant
[[java.lang.Object _1] [java.lang.Object _2]])
-(jvm/defclass Variant3 lux.Variant
+(jvm:class Variant3 lux.Variant
[[java.lang.Object _1] [java.lang.Object _2]
[java.lang.Object _3]])
-(jvm/defclass Variant4 lux.Variant
+(jvm:class Variant4 lux.Variant
[[java.lang.Object _1] [java.lang.Object _2]
[java.lang.Object _3] [java.lang.Object _4]])
-(jvm/defclass Variant5 lux.Variant
+(jvm:class Variant5 lux.Variant
[[java.lang.Object _1] [java.lang.Object _2]
[java.lang.Object _3] [java.lang.Object _4]
[java.lang.Object _5]])
-(jvm/defclass Variant6 lux.Variant
+(jvm:class Variant6 lux.Variant
[[java.lang.Object _1] [java.lang.Object _2]
[java.lang.Object _3] [java.lang.Object _4]
[java.lang.Object _5] [java.lang.Object _6]])
-(jvm/defclass Variant7 lux.Variant
+(jvm:class Variant7 lux.Variant
[[java.lang.Object _1] [java.lang.Object _2]
[java.lang.Object _3] [java.lang.Object _4]
[java.lang.Object _5] [java.lang.Object _6]
[java.lang.Object _7]])
-(jvm/defclass Variant8 lux.Variant
+(jvm:class Variant8 lux.Variant
[[java.lang.Object _1] [java.lang.Object _2]
[java.lang.Object _3] [java.lang.Object _4]
[java.lang.Object _5] [java.lang.Object _6]
[java.lang.Object _7] [java.lang.Object _8]])
## Base functions & macros
-(defmacro (list xs)
- (case xs
+(def (id x)
+ x)
+
+(def (fold f init values)
+ (case values
#Nil
- (#Tag "Nil")
+ init
+ (#Cons x xs)
+ (fold f (f init x) xs)))
- (#Cons x xs*)
- (#Form (#Cons (#Tag "Cons") (#Cons x (#Cons (list xs*) #Nil))))))
+(def (cons tail head)
+ (#Cons head tail))
+
+(def (reverse list)
+ (fold cons #Nil list))
+
+(annotate list Macro)
+(def (list xs)
+ (fold (lambda [tail head]
+ (#Form (#Cons (#Tag "Cons")
+ (#Cons head
+ (#Cons tail #Nil)))))
+ (#Tag "Nil")
+ (reverse xs)))
(def (++ xs ys)
(case xs
@@ -135,40 +152,31 @@
## I/O
(def (print x)
- (jvm/invokevirtual java.io.PrintStream "print" [Object]
- (jvm/getstatic System out) [x]))
+ (jvm:invokevirtual java.io.PrintStream "print" [Object]
+ (jvm:getstatic System out) [x]))
(def (println x)
- (jvm/invokevirtual java.io.PrintStream "println" [Object]
- (jvm/getstatic System out) [x]))
+ (jvm:invokevirtual java.io.PrintStream "println" [Object]
+ (jvm:getstatic System out) [x]))
-(defmacro (' form)
+(annotate ' Macro)
+(def (' form)
(case form
(#Cons token #Nil)
(untemplate token)))
(def (+ x y)
- (jvm/i+ x y))
+ (jvm:iadd x y))
(def inc (+ 1))
-(def (id x)
- x)
-
-(def (fold f init values)
- (case values
- #Nil
- init
- (#Cons x xs)
- (fold f (f init x) xs)))
-
(def length (fold (lambda [l x] (inc l)) 0))
(def (rem dividend divisor)
- (jvm/irem dividend divisor))
+ (jvm:irem dividend divisor))
(def (= x y)
- (jvm/invokevirtual Object "equals" [Object]
+ (jvm:invokevirtual Object "equals" [Object]
x [y]))
(def (pairs list)
@@ -180,11 +188,11 @@
#Nil))
(def (show x)
- (jvm/invokevirtual Object "toString" []
+ (jvm:invokevirtual Object "toString" []
x []))
(def (concat t1 t2)
- (jvm/invokevirtual String "concat" [String]
+ (jvm:invokevirtual String "concat" [String]
t1 [t2]))
(def (range from to)
@@ -193,19 +201,13 @@
(#Cons from (range (inc from) to))))
(def (text->list text)
- (let length (jvm/invokevirtual String "length" []
+ (let length (jvm:invokevirtual String "length" []
text [])
(map (lambda [idx]
- (jvm/invokevirtual String "charAt" [int]
+ (jvm:invokevirtual String "charAt" [int]
text [idx]))
(range 0 length))))
-(def (cons tail head)
- (#Cons head tail))
-
-(def (reverse list)
- (fold cons #Nil list))
-
(def (enumerate list)
(case (fold (lambda [state x]
(case state
diff --git a/source/test2.lux b/source/test2.lux
index c72602edb..f2fe02bb8 100644
--- a/source/test2.lux
+++ b/source/test2.lux
@@ -1,4 +1,4 @@
-(use "./util" as util)
+(require "./util")
(def (print-enum enum)
(case enum
@@ -10,10 +10,10 @@
(print-enum enum'))))
#((def monadic-dup
- (util/exec [foo get-state
+ (util:exec [foo get-state
bar get-state
- baz (util/return 1000)]
- (util/return (+ (+ foo bar) baz)))))#
+ baz (util:return 1000)]
+ (util:return (+ (+ foo bar) baz)))))#
(def (print-map list-map)
(do (print "{")
diff --git a/src/lux.clj b/src/lux.clj
index d5c76cea9..045e6b0f2 100644
--- a/src/lux.clj
+++ b/src/lux.clj
@@ -18,15 +18,18 @@
;; TODO: Add records.
;; TODO: throw, try, catch, finally
;; TODO: Add extra arities (apply2, apply3, ..., apply16)
- ;; TODO: When doing partial application, skip "apply" and just call constructor appropiatedly.
- ;; TODO: Add "new". Allow setting fields.
+ ;; TODO: 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: Reader macros.
+ ;; TODO: Automatic currying of functions.
+ ;; TODO:
+ ;; TODO:
+ ;; TODO:
;; TODO:
- (&compiler/compile-all ["lux" "test2"])
+ (time (&compiler/compile-all ["lux" "test2"]))
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index fd7a5a5d0..d2c64c8df 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -4,178 +4,139 @@
[template :refer [do-template]])
[clojure.core.match :refer [match]]
(lux [util :as &util :refer [exec return* return fail fail*
- repeat-m exhaust-m try-m try-all-m map-m reduce-m
- apply-m within
+ repeat-m try-all-m map-m reduce-m
+ within do-all-m*
normalize-ident
loader]]
+ [lexer :as &lexer]
[parser :as &parser]
[type :as &type])))
-(declare analyse-form
- ->tokens
- tokens->clojure)
-
;; [Util]
+(def +int-class+ "java.lang.Integer")
+
(defn ^:private annotated [form type]
{:form form
:type type})
-(defn fresh-env [id]
- {:id id
+(defn fresh-env [name]
+ {:name name
+ :inner-closures 0
:counter 0
:mappings {}
:closure/id 0})
(def ^:private module-name
(fn [state]
- [::&util/ok [state (:name state)]]))
-
-(defn ^:private define [name desc]
- (fn [state]
- [::&util/ok [(-> state
- (assoc-in [:modules (:name state) name] desc)
- (assoc-in [:defs-env name] (annotated [::global (:name state) name] (:type desc))))
- nil]]))
+ [::&util/ok [state (::current-module state)]]))
-(defn ^:private define-fn [name desc]
+(defn ^:private annotate [name mode access macro? type]
(fn [state]
- [::&util/ok [(-> state
- (assoc-in [:modules (:name state) name] desc)
- (assoc-in [:defs-env name] (annotated [::global-fn (:name state) name] (:type desc))))
+ [::&util/ok [(assoc-in state [::modules (::current-module state) name] {:mode mode
+ :access access
+ :macro? macro?
+ :type type
+ :defined? false})
nil]]))
-(defn ^:private is-macro? [module name]
+(defn ^:private define [name]
(fn [state]
- [::&util/ok [state (= (get-in state [:modules module name :mode]) ::macro)]]))
-
-(def ^:private next-local-idx
- (fn [state]
- [::&util/ok [state (-> state :env first :counter)]]))
-
-(def ^:private scope-id
+ (if-let [{:keys [mode type]} (get-in state [::modules (::current-module state) name])]
+ (let [full-name (str (::current-module state) ":" name)
+ tag (if (= ::function mode)
+ ::global-fn
+ ::global)
+ bound (annotated [tag (::current-module state) name] type)]
+ [::&util/ok [(-> state
+ (assoc-in [::modules (::current-module state) name :defined?] true)
+ (update-in [::global-env] merge {full-name bound, name bound}))
+ nil]])
+ (fail* (str "Can't define an unannotated element [" name "]")))))
+
+(defn ^:private defined? [name]
(fn [state]
- [::&util/ok [state (-> state :env first :id)]]))
+ [::&util/ok [state (get-in state [::modules (::current-module state) name :defined?])]]))
-(def ^:private my-frame
+(defn ^:private annotated? [name]
(fn [state]
- [::&util/ok [state (-> state :env first)]]))
+ [::&util/ok [state (boolean (get-in state [::modules (::current-module state) name]))]]))
-(defn ^:private in-scope? [module name]
+(defn ^:private is-macro? [module name]
(fn [state]
- [::&util/ok [state (some (partial = name) (get-in state [:lambda-scope 0]))]]))
+ [::&util/ok [state (boolean (get-in state [::modules module name :macro?]))]]))
-(defn with-scope [scope body]
+(def ^:private next-local-idx
(fn [state]
- (let [=return (body (-> state
- (update-in [:lambda-scope 0] conj scope)
- (assoc-in [:lambda-scope 1] 0)))]
- (match =return
- [::&util/ok [?state ?value]]
- [::&util/ok [(assoc ?state :lambda-scope (:lambda-scope state)) ?value]]
-
- _
- =return))))
+ [::&util/ok [state (-> state ::local-envs first :counter)]]))
-(defn ^:private with-scoped-name [name type body]
+(def ^:private scope-id
(fn [state]
- (let [=return (body (update-in state [:env]
- #(cons (assoc-in (first %) [:mappings name] (annotated [::global-fn (:name state) name] type))
- (rest %))))]
- (match =return
- [::&util/ok [?state ?value]]
- [::&util/ok [(update-in ?state [:env] #(cons (update-in (first %) [:mappings] dissoc name)
- (rest %)))
- ?value]]
-
- _
- =return))))
+ [::&util/ok [state (-> state ::local-envs first :name)]]))
-(defn ^:private with-lambda-scope [body]
+(defn with-env [label body]
(fn [state]
- (let [=return (body (-> state
- (update-in [:lambda-scope 0] conj (get-in state [:lambda-scope 1]))
- (assoc-in [:lambda-scope 1] 0)))]
+ (let [=return (body (update-in state [::local-envs] conj (fresh-env label)))]
(match =return
[::&util/ok [?state ?value]]
- [::&util/ok [(-> ?state
- (update-in [:lambda-scope 0] pop)
- (assoc-in [:lambda-scope 1] (inc (get-in state [:lambda-scope 1]))))
- ?value]]
+ [::&util/ok [(update-in ?state [::local-envs] rest) ?value]]
_
=return))))
-(def ^:private scope
- (fn [state]
- [::&util/ok [state (get-in state [:lambda-scope 0])]]))
-
-(defn ^:private with-local [name type body]
+(defn ^:private with-local [name value body]
(fn [state]
- (let [=return (body (update-in state [:env]
- #(cons (-> (first %)
- (update-in [:counter] inc)
- (assoc-in [:mappings name] (annotated [::local (:id (first %)) (:counter (first %))] type)))
- (rest %))))]
+ (let [=return (body (update-in state [::local-envs]
+ (fn [[env & other-envs]]
+ (cons (assoc-in env [:mappings name] value)
+ other-envs))))]
(match =return
[::&util/ok [?state ?value]]
- [::&util/ok [(update-in ?state [:env] #(cons (-> (first %)
- (update-in [:counter] dec)
- (update-in [:mappings] dissoc name))
- (rest %)))
+ [::&util/ok [(update-in ?state [::local-envs] #(cons (update-in (first %) [:mappings] dissoc name)
+ (rest %)))
?value]]
_
=return)
)))
-(defn ^:private with-locals [mappings monad]
+(defn ^:private with-let [name type body]
(fn [state]
- (let [=return (monad (update-in state [:env] #(cons (update-in (first %) [:mappings] merge mappings)
- (rest %))))]
+ (let [[top & stack] (::local-envs state)
+ body* (with-local name (annotated [::local (:name top) (:counter top)] type)
+ body)
+ =return (body* (assoc state ::local-envs (cons (update-in top [:counter] inc) stack)))]
(match =return
[::&util/ok [?state ?value]]
- [::&util/ok [(update-in ?state [:env] #(cons (update-in (first %) [:mappings] (fn [m] (apply dissoc m (keys mappings))))
- (rest %)))
+ [::&util/ok [(update-in ?state [::local-envs] (fn [[top* & stack*]]
+ (cons (update-in top* [:counter] dec)
+ stack*)))
?value]]
_
=return))))
-(defn ^:private with-fresh-env [[args-vars args-types] body]
- (with-lambda-scope
- (fn [state]
- (let [state* (update-in state [:env]
- (fn [outer]
- (let [frame-id (-> outer first :id inc)
- new-top (reduce (fn [frame [name type]]
- (-> frame
- (update-in [:counter] inc)
- (assoc-in [:mappings name] (annotated [::local frame-id (:counter frame)] type))))
- (update-in (fresh-env frame-id) [:counter] inc)
- (map vector args-vars args-types))]
- (conj outer new-top))))
- =return (body state*)]
- (match =return
- [::&util/ok [?state ?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)))))
-
-(defn ^:private import-class [long-name short-name]
- (fn [state]
- (let [=class (annotated [::class long-name] [::&type/object long-name []])]
- [::&util/ok [(update-in state [:imports] merge {long-name =class,
- short-name =class})
- nil]])))
+(do-template [<name> <unit-fn>]
+ (defn <name> [locals monad]
+ (reduce (fn [inner [label elem]]
+ (<unit-fn> label elem inner))
+ monad
+ (reverse locals)))
+
+ ^:private with-locals with-local
+ ^:private with-lets with-let
+ )
-(defn ^:private use-module [name alias]
+(defn with-lambda [args body]
(fn [state]
- [::&util/ok [(assoc-in state [:deps alias] name)
- nil]]))
+ (let [top (-> state ::local-envs first)
+ scope* (str (:name top) "$" (str (:inner-closures top)))
+ body* (with-env scope*
+ (with-lets args
+ (exec [=return body]
+ (return [scope* =return]))))]
+ (body* (update-in state [::local-envs] #(cons (update-in (first %) [:inner-closures] inc)
+ (rest %))))
+ )))
(defn ^:private close-over [scope ident register frame]
(let [register* (annotated [::captured scope (:closure/id frame) register] (:type register))]
@@ -185,93 +146,23 @@
(defn ^:private resolve [ident]
(fn [state]
- (or (if-let [[_ ?alias ?binding] (re-find #"^(.*)/(.*)$" ident)]
- (if-let [?module (get-in state [:deps ?alias])]
- [::&util/ok [state (annotated [::global ?module ?binding] ::&type/nothing)]]))
- (let [[inner outer] (split-with #(nil? (get-in % [:mappings ident])) (:env state))]
- (cond (empty? inner)
- [::&util/ok [state (-> state :env first :mappings (get ident))]]
-
- (empty? outer)
- (if-let [global|import (or (get-in state [:defs-env ident])
- (get-in state [:imports ident]))]
- [::&util/ok [state global|import]]
- [::&util/failure (str "[Analyser Error] Unresolved identifier: " ident)])
-
- :else
- (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
- (fn [{[token# & left#] :forms :as state#}]
- (match token#
- ~match
- (~return (assoc state# :forms left#))
-
- _#
- (fail* (str "[Analyser Error] Unmatched token: " token#))))))
-
-(defn analyse-form* [form]
- (fn [state]
- (let [old-forms (:forms state)
- =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]
- [::&util/failure ?message]))))
-
-(do-template [<name> <tag> <class>]
- (defanalyser <name>
- [<tag> ?value]
- (return (annotated [::literal ?value] [::&type/object <class> []])))
-
- analyse-bool ::&parser/bool "java.lang.Boolean"
- analyse-int ::&parser/int "java.lang.Integer"
- analyse-real ::&parser/real "java.lang.Float"
- analyse-char ::&parser/char "java.lang.Character"
- analyse-text ::&parser/text "java.lang.String"
- )
-
-(defanalyser analyse-variant
- ?token
- (match ?token
- [::&parser/tag ?tag]
- (return (annotated [::variant ?tag '()] [::&type/variant ?tag '()]))
-
- [::&parser/form ([[::&parser/tag ?tag] & ?data] :seq)]
- (exec [=data (map-m analyse-form* ?data)]
- (return (annotated [::variant ?tag =data] [::&type/variant ?tag (map :type =data)])))
-
- _
- (fail "")))
-
-(defanalyser analyse-tuple
- [::&parser/tuple ?elems]
- (exec [=elems (map-m analyse-form* ?elems)]
- (return (annotated [::tuple =elems] [::&type/tuple (mapv :type =elems)]))))
-
-(defanalyser analyse-ident
- [::&parser/ident ?ident]
- (resolve ?ident))
-
-(defanalyser analyse-access
- [::&parser/static-access ?target ?member]
- (exec [=target (resolve ?target)]
- (match (:form =target)
- [::class ?class]
- (return (annotated [::static-access ?class ?member] ::&type/nothing)))))
+ (let [[top & stack*] (::local-envs state)]
+ (if-let [=bound (get-in top [:mappings ident])]
+ [::&util/ok [state (list =bound)]]
+ (let [[inner outer] (split-with #(-> % :mappings (contains? ident) not) stack*)]
+ (if (empty? outer)
+ (if-let [global|import (get-in state [::global-env ident])]
+ [::&util/ok [state (list global|import)]]
+ [::&util/failure (str "[Analyser Error] Unresolved identifier: " ident)])
+ (let [[=local inner*] (reduce (fn [[register new-inner] frame]
+ (let [[register* frame*] (close-over (:name frame) ident register frame)]
+ [register* (cons frame* new-inner)]))
+ [(-> outer first :mappings (get ident)) '()]
+ (reverse (cons top inner)))]
+ [::&util/ok [(assoc state ::local-envs (concat inner* outer)) (list =local)]])
+ ))
+ ))
+ ))
(defn extract-ident [ident]
(match ident
@@ -336,31 +227,7 @@
_
(fail "")))
-(defn lookup-field [mode target field]
- (if-let [[[owner type]] (seq (for [=field (.getFields (Class/forName target))
- :when (and (= field (.getName =field))
- (case mode
- :static (java.lang.reflect.Modifier/isStatic (.getModifiers =field))
- :dynamic (not (java.lang.reflect.Modifier/isStatic (.getModifiers =field)))))]
- [(.getDeclaringClass =field) (.getType =field)]))]
- (exec [=type (&type/class->type type)]
- (return [(.getName owner) =type]))
- (fail (str "[Analyser Error] Field does not exist: " target field mode))))
-
-(defn lookup-method [mode target method args]
- (if-let [methods (seq (for [=method (.getMethods (Class/forName target))
- :when (and (= method (.getName =method))
- (case mode
- :static (java.lang.reflect.Modifier/isStatic (.getModifiers =method))
- :virtual (not (java.lang.reflect.Modifier/isStatic (.getModifiers =method)))))]
- [(.getDeclaringClass =method) =method]))]
- (map-m (fn [[owner method]]
- (exec [=method (&type/method->type method)]
- (return [(.getName owner) =method])))
- methods)
- (fail (str "[Analyser Error] Method does not exist: " target method mode))))
-
-(defn lookup-static-field [target field]
+(defn ^:private lookup-static-field [target field]
(if-let [type* (first (for [=field (.getFields target)
:when (and (= target (.getDeclaringClass =field))
(= field (.getName =field))
@@ -370,7 +237,7 @@
(return =type))
(fail (str "[Analyser Error] Field does not exist: " target field))))
-(defn lookup-virtual-method [target method-name args]
+(defn ^:private lookup-virtual-method [target method-name args]
(if-let [method (first (for [=method (.getMethods target)
:when (and (= target (.getDeclaringClass =method))
(= method-name (.getName =method))
@@ -380,7 +247,7 @@
(&type/return-type =method))
(fail (str "[Analyser Error] Virtual method does not exist: " target method-name))))
-(defn full-class-name [class]
+(defn ^:private full-class-name [class]
(if (.contains class ".")
(return class)
(try-all-m [(exec [=class (resolve class)]
@@ -397,45 +264,17 @@
(return full-name)
(fail "[Analyser Error] Unknown class.")))])))
-(defanalyser analyse-jvm-getstatic
- [::&parser/form ([[::&parser/ident "jvm/getstatic"] [::&parser/ident ?class] [::&parser/ident ?field]] :seq)]
- (exec [=class (full-class-name ?class)
- =type (lookup-static-field (Class/forName =class) ?field)]
- (return (annotated [::jvm-getstatic =class ?field] =type))))
-
-(defanalyser analyse-jvm-invokevirtual
- [::&parser/form ([[::&parser/ident "jvm/invokevirtual"] [::&parser/ident ?class] [::&parser/text ?method] [::&parser/tuple ?classes] ?object [::&parser/tuple ?args]] :seq)]
- (exec [=class (full-class-name ?class)
- =classes (map-m extract-jvm-param ?classes)
- =return (lookup-virtual-method (Class/forName =class) ?method =classes)
- =object (analyse-form* ?object)
- =args (map-m analyse-form* ?args)]
- (return (annotated [::jvm-invokevirtual =class ?method (map #(.getName %) =classes) =object =args] =return))))
-
-(defanalyser analyse-jvm-new
- [::&parser/form ([[::&parser/ident "jvm/new"] [::&parser/ident ?class] [::&parser/tuple ?classes] [::&parser/tuple ?args]] :seq)]
- (exec [=class (full-class-name ?class)
- =classes (map-m extract-jvm-param ?classes)
- =args (map-m analyse-form* ?args)]
- (return (annotated [::jvm-new =class (map #(.getName %) =classes) =args] [::&type/object =class []]))))
-
-(defanalyser analyse-jvm-new-array
- [::&parser/form ([[::&parser/ident "jvm/new-array"] [::&parser/ident ?class] [::&parser/int ?length]] :seq)]
- (exec [=class (full-class-name ?class)]
- (return (annotated [::jvm-new-array =class ?length] [::&type/array [::&type/object =class []]]))))
-
-(defanalyser analyse-jvm-aastore
- [::&parser/form ([[::&parser/ident "jvm/aastore"] ?array [::&parser/int ?idx] ?elem] :seq)]
- (exec [=array (analyse-form* ?array)
- =elem (analyse-form* ?elem)]
- (return (annotated [::jvm-aastore =array ?idx =elem] (:type =array)))))
-
-(defanalyser analyse-jvm-aaload
- [::&parser/form ([[::&parser/ident "jvm/aaload"] ?array [::&parser/int ?idx]] :seq)]
- (exec [=array (analyse-form* ?array)]
- (return (annotated [::jvm-aaload =array ?idx] (-> =array :type (nth 1))))))
+(defn ^:private ->lux+* [->lux xs]
+ (reduce (fn [tail x]
+ (doto (.newInstance (.loadClass @loader "lux.Variant2"))
+ (-> .-tag (set! "Cons"))
+ (-> .-_1 (set! (->lux x)))
+ (-> .-_2 (set! tail))))
+ (doto (.newInstance (.loadClass @loader "lux.Variant0"))
+ (-> .-tag (set! "Nil")))
+ (reverse xs)))
-(defn ->token [x]
+(defn ^:private ->lux [x]
(match x
[::&parser/bool ?bool]
(doto (.newInstance (.loadClass @loader "lux.Variant1"))
@@ -468,24 +307,23 @@
[::&parser/tuple ?elems]
(doto (.newInstance (.loadClass @loader "lux.Variant1"))
(-> .-tag (set! "Tuple"))
- (-> .-_1 (set! (->tokens ?elems))))
+ (-> .-_1 (set! (->lux+* ->lux ?elems))))
[::&parser/form ?elems]
(doto (.newInstance (.loadClass @loader "lux.Variant1"))
(-> .-tag (set! "Form"))
- (-> .-_1 (set! (->tokens ?elems))))
+ (-> .-_1 (set! (->lux+* ->lux ?elems))))
))
-(defn ->tokens [xs]
- (reduce (fn [tail x]
- (doto (.newInstance (.loadClass @loader "lux.Variant2"))
- (-> .-tag (set! "Cons"))
- (-> .-_1 (set! (->token x)))
- (-> .-_2 (set! tail))))
- (doto (.newInstance (.loadClass @loader "lux.Variant0"))
- (-> .-tag (set! "Nil")))
- (reverse xs)))
+(def ^:private ->lux+ (partial ->lux+* ->lux))
-(defn ->clojure-token [x]
+(defn ->clojure+* [->clojure xs]
+ (case (.-tag xs)
+ "Nil" '()
+ "Cons" (cons (->clojure (.-_1 xs))
+ (->clojure+* ->clojure (.-_2 xs)))
+ ))
+
+(defn ->clojure [x]
(case (.-tag x)
"Bool" [::&parser/bool (-> x .-_1)]
"Int" [::&parser/int (-> x .-_1)]
@@ -494,32 +332,31 @@
"Text" [::&parser/text (-> x .-_1)]
"Tag" [::&parser/tag (-> x .-_1)]
"Ident" [::&parser/ident (-> x .-_1)]
- "Tuple" [::&parser/tuple (-> x .-_1 tokens->clojure)]
- "Form" [::&parser/form (-> x .-_1 tokens->clojure)]))
+ "Tuple" [::&parser/tuple (->> x .-_1 (->clojure+* ->clojure))]
+ "Form" [::&parser/form (->> x .-_1 (->clojure+* ->clojure))]))
-(defn tokens->clojure [xs]
- (case (.-tag xs)
- "Nil" '()
- "Cons" (cons (->clojure-token (.-_1 xs))
- (tokens->clojure (.-_2 xs)))
- ))
+(def ^:private ->clojure+ (partial ->clojure+* ->clojure))
+
+(defn ^:private analyse-tuple [analyse-ast ?elems]
+ (exec [=elems (do-all-m* (map analyse-ast ?elems))]
+ (return (list (annotated [::tuple =elems] [::&type/tuple (mapv :type =elems)])))))
-(defanalyser analyse-call
- [::&parser/form ([?fn & ?args] :seq)]
- (exec [=fn (analyse-form* ?fn)]
+(defn ^:private analyse-ident [analyse-ast ?ident]
+ (resolve ?ident))
+
+(defn ^:private analyse-call [analyse-ast ?fn ?args]
+ (exec [[=fn] (analyse-ast ?fn)]
(match (:form =fn)
[::global-fn ?module ?name]
- (exec [macro? (is-macro? ?module ?name)
- 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)]
- (-> transformed
- analyse-form*))
- (exec [=args (map-m analyse-form* ?args)
+ (exec [macro? (is-macro? ?module ?name)]
+ (if macro?
+ (let [macro-class (str ?module "$" (normalize-ident ?name))]
+ (-> (.loadClass @loader macro-class)
+ .newInstance
+ (.apply (->lux+ ?args))
+ ->clojure
+ analyse-ast))
+ (exec [=args (do-all-m* (map analyse-ast ?args))
:let [[needs-num =return-type] (match (:type =fn)
[::&type/function ?fargs ?freturn]
(let [needs-num (count ?fargs)
@@ -527,24 +364,22 @@
(if (> needs-num provides-num)
[needs-num [::&type/function (drop provides-num ?fargs) ?freturn]]
[needs-num [::&type/object "java.lang.Object" []]])))]]
- (return (annotated [::static-call needs-num =fn =args] =return-type)))))
+ (return (list (annotated [::static-call needs-num =fn =args] =return-type))))))
_
- (exec [=args (map-m analyse-form* ?args)]
- (return (annotated [::call =fn =args] [::&type/object "java.lang.Object" []]))))
+ (exec [=args (do-all-m* (map analyse-ast ?args))]
+ (return (list (annotated [::call =fn =args] [::&type/object "java.lang.Object" []])))))
))
-(defanalyser analyse-if
- [::&parser/form ([[::&parser/ident "if"] ?test ?then ?else] :seq)]
- (exec [=test (analyse-form* ?test)
- =then (analyse-form* ?then)
- =else (analyse-form* ?else)]
- (return (annotated [::if =test =then =else] ::&type/nothing))))
+(defn ^:private analyse-if [analyse-ast ?test ?then ?else]
+ (exec [[=test] (analyse-ast ?test)
+ [=then] (analyse-ast ?then)
+ [=else] (analyse-ast ?else)]
+ (return (list (annotated [::if =test =then =else] ::&type/nothing)))))
-(defanalyser analyse-do
- [::&parser/form ([[::&parser/ident "do"] & ?exprs] :seq)]
- (exec [=exprs (map-m analyse-form* ?exprs)]
- (return (annotated [::do =exprs] (-> =exprs last :type)))))
+(defn ^:private analyse-do [analyse-ast ?exprs]
+ (exec [=exprs (do-all-m* (map analyse-ast ?exprs))]
+ (return (list (annotated [::do =exprs] (-> =exprs last :type))))))
(let [fold-branch (fn [struct entry]
(let [struct* (clojure.core.match/match (nth entry 0)
@@ -724,70 +559,161 @@
[max-registers branch-mappings (generate-branches branches**)])))
(let [locals-getter (fn [$scope]
- (fn member-fold [[$local locals-map] ?member]
+ (fn member-fold [[$local locals] ?member]
(match ?member
[::&parser/ident ?name]
- (return [(inc $local) (assoc locals-map ?name (annotated [::local $scope $local] [::&type/object "java.lang.Object" []]))])
+ (return [(inc $local) (cons [?name (annotated [::local $scope $local] [::&type/object "java.lang.Object" []])] locals)])
[::&parser/tuple ?submembers]
- (reduce-m member-fold [$local locals-map] ?submembers)
+ (reduce-m member-fold [$local locals] ?submembers)
[::&parser/form ([[::&parser/tag ?subtag] & ?submembers] :seq)]
- (reduce-m member-fold [$local locals-map] ?submembers)
+ (reduce-m member-fold [$local locals] ?submembers)
_
- (return [$local locals-map])
+ (return [$local locals])
)))]
- (defanalyser analyse-case
- [::&parser/form ([[::&parser/ident "case"] ?variant & ?branches] :seq)]
- (exec [=variant (analyse-form* ?variant)
+ (defn ^:private analyse-case [analyse-ast ?variant ?branches]
+ (exec [[=variant] (analyse-ast ?variant)
$scope scope-id
$base next-local-idx
[registers mappings tree] (exec [=branches (map-m (fn [[?pattern ?body]]
(match ?pattern
[::&parser/char ?token]
- (exec [=body (analyse-form* ?body)]
+ (exec [[=body] (analyse-ast ?body)]
(return [::case-branch [::&parser/char ?token] =body]))
[::&parser/text ?token]
- (exec [=body (analyse-form* ?body)]
+ (exec [[=body] (analyse-ast ?body)]
(return [::case-branch [::&parser/text ?token] =body]))
[::&parser/ident ?name]
- (exec [=body (with-locals {?name (annotated [::local $scope $base] [::&type/object "java.lang.Object" []])}
- (analyse-form* ?body))]
+ (exec [[=body] (with-local ?name (annotated [::local $scope $base] [::&type/object "java.lang.Object" []])
+ (analyse-ast ?body))]
(return [::case-branch [::&parser/ident ?name] =body]))
[::&parser/tag ?tag]
- (exec [=body (analyse-form* ?body)]
+ (exec [[=body] (analyse-ast ?body)]
(return [::case-branch [::&parser/variant ?tag '()] =body]))
[::&parser/tuple ?members]
- (exec [[_ locals+] (reduce-m (locals-getter $scope) [$base {}] ?members)
- =body (with-locals locals+
- (analyse-form* ?body))]
+ (exec [[_ locals+] (reduce-m (locals-getter $scope) [$base '()] ?members)
+ [=body] (with-locals (reverse locals+)
+ (analyse-ast ?body))]
(return [::case-branch [::&parser/tuple ?members] =body]))
[::&parser/form ([[::&parser/tag ?tag] & ?members] :seq)]
- (exec [[_ locals+] (reduce-m (locals-getter $scope) [$base {}] ?members)
- =body (with-locals locals+
- (analyse-form* ?body))]
+ (exec [[_ locals+] (reduce-m (locals-getter $scope) [$base '()] ?members)
+ [=body] (with-locals (reverse locals+)
+ (analyse-ast ?body))]
(return [::case-branch [::&parser/variant ?tag ?members] =body]))
))
(partition 2 ?branches))]
(return (->decision-tree $scope $base =branches)))]
- (return (annotated [::case (dec $base) =variant registers mappings tree] ::&type/nothing)))))
+ (return (list (annotated [::case (dec $base) =variant registers mappings tree] ::&type/nothing))))))
-(defanalyser analyse-let
- [::&parser/form ([[::&parser/ident "let"] [::&parser/ident ?label] ?value ?body] :seq)]
- (exec [=value (analyse-form* ?value)
+(defn ^:private analyse-let [analyse-ast ?label ?value ?body]
+ (exec [[=value] (analyse-ast ?value)
idx next-local-idx
- =body (with-local ?label (:type =value)
- (analyse-form* ?body))]
- (return (annotated [::let idx ?label =value =body] (:type =body)))))
+ [=body] (with-let ?label (:type =value)
+ (analyse-ast ?body))]
+ (return (list (annotated [::let idx ?label =value =body] (:type =body))))))
+
+(defn ^:private analyse-lambda [analyse-ast ?args ?body]
+ (exec [?args (map-m extract-ident ?args)
+ [=function =args =return] (within ::types (&type/fresh-function (count ?args)))
+ [=scope =body] (with-lambda (map vector ?args =args)
+ (analyse-ast ?body))
+ =function (within ::types (exec [_ (&type/solve =return (:type =body))]
+ (&type/clean =function)))]
+ (return (list (annotated [::lambda =scope ?args =body] =function)))))
+
+(defn ^:private analyse-def [analyse-ast ?usage ?value]
+ (match ?usage
+ [::&parser/ident ?name]
+ (exec [:let [scoped-name (str "def_" ?name)]
+ [=value] (with-env (str "def_" ?name)
+ (analyse-ast ?value))
+ _ (annotate ?name ::constant ::public false (:type =value))
+ _ (define ?name)]
+ (return (list (annotated [::def ?name =value] ::&type/nothing))))
+
+ [::&parser/form ([[::&parser/ident ?name] & ?args] :seq)]
+ (exec [def?? (defined? ?name)]
+ (if def??
+ (fail (str "Can't redefine function/constant: " ?name))
+ (exec [ann?? (annotated? ?name)
+ args (map-m extract-ident ?args)
+ [=function =args =return] (within ::types (&type/fresh-function (count args)))
+ :let [scoped-name (str "def_" ?name)]
+ current-module module-name
+ [=value] (with-env scoped-name
+ (with-local ?name (annotated [::global-fn current-module ?name] =function)
+ (with-lets (map vector args =args)
+ (analyse-ast ?value))))
+ =function (within ::types (exec [_ (&type/solve =return (:type =value))]
+ (&type/clean =function)))
+ _ (if ann??
+ (return nil)
+ (annotate ?name ::function ::public false =function))
+ _ (define ?name)]
+ (return (list (annotated [::def [?name args] =value] ::&type/nothing))))))
+ ))
+
+(defn ^:private analyse-annotate [?ident]
+ (exec [_ (annotate ?ident ::function ::public true ::&type/nothing)]
+ (return (list))))
+
+(defn ^:private analyse-require [analyse-ast ?path]
+ (assert false)
+ (return (list)))
+
+(do-template [<name> <ident> <output-tag>]
+ (defn <name> [analyse-ast ?x ?y]
+ (exec [[=x] (analyse-ast ?x)
+ [=y] (analyse-ast ?y)]
+ (return (list (annotated [<output-tag> =x =y] [::&type/object +int-class+ []])))))
+
+ ^:private analyse-jvm-iadd "jvm:iadd" ::jvm:iadd
+ ^:private analyse-jvm-isub "jvm:isub" ::jvm:isub
+ ^:private analyse-jvm-imul "jvm:imul" ::jvm:imul
+ ^:private analyse-jvm-idiv "jvm:idiv" ::jvm:idiv
+ ^:private analyse-jvm-irem "jvm:irem" ::jvm:irem
+ )
-(defanalyser analyse-defclass
- [::&parser/form ([[::&parser/ident "jvm/defclass"] [::&parser/ident ?name] [::&parser/ident ?super-class] [::&parser/tuple ?fields]] :seq)]
+(defn ^:private analyse-jvm-getstatic [analyse-ast ?class ?field]
+ (exec [=class (full-class-name ?class)
+ =type (lookup-static-field (Class/forName =class) ?field)]
+ (return (list (annotated [::jvm:getstatic =class ?field] =type)))))
+
+(defn ^:private analyse-jvm-invokevirtual [analyse-ast ?class ?method ?classes ?object ?args]
+ (exec [=class (full-class-name ?class)
+ =classes (map-m extract-jvm-param ?classes)
+ =return (lookup-virtual-method (Class/forName =class) ?method =classes)
+ [=object] (analyse-ast ?object)
+ =args (do-all-m* (map analyse-ast ?args))]
+ (return (list (annotated [::jvm:invokevirtual =class ?method (map #(.getName %) =classes) =object =args] =return)))))
+
+(defn ^:private analyse-jvm-new [analyse-ast ?class ?classes ?args]
+ (exec [=class (full-class-name ?class)
+ =classes (map-m extract-jvm-param ?classes)
+ =args (do-all-m* (map analyse-ast ?args))]
+ (return (list (annotated [::jvm:new =class (map #(.getName %) =classes) =args] [::&type/object =class []])))))
+
+(defn ^:private analyse-jvm-new-array [analyse-ast ?class ?length]
+ (exec [=class (full-class-name ?class)]
+ (return (list (annotated [::jvm:new-array =class ?length] [::&type/array [::&type/object =class []]])))))
+
+(defn ^:private analyse-jvm-aastore [analyse-ast ?array ?idx ?elem]
+ (exec [[=array] (analyse-ast ?array)
+ [=elem] (analyse-ast ?elem)]
+ (return (list (annotated [::jvm:aastore =array ?idx =elem] (:type =array))))))
+
+(defn ^:private analyse-jvm-aaload [analyse-ast ?array ?idx]
+ (exec [[=array] (analyse-ast ?array)]
+ (return (list (annotated [::jvm:aaload =array ?idx] (-> =array :type (nth 1)))))))
+
+(defn ^:private analyse-jvm-class [analyse-ast ?name ?super-class ?fields]
(exec [?fields (map-m (fn [?field]
(match ?field
[::&parser/tuple ([[::&parser/ident ?class] [::&parser/ident ?field-name]] :seq)]
@@ -800,10 +726,9 @@
[field {:access ::public
:type class}]))}]
name module-name]
- (return (annotated [::defclass [name ?name] ?super-class =members] ::&type/nothing))))
+ (return (list (annotated [::defclass [name ?name] ?super-class =members] ::&type/nothing)))))
-(defanalyser analyse-definterface
- [::&parser/form ([[::&parser/ident "jvm/definterface"] [::&parser/ident ?name] & ?members] :seq)]
+(defn ^:private analyse-jvm-interface [analyse-ast ?name ?members]
(exec [?members (map-m #(match %
[::&parser/form ([[::&parser/ident ":"] [::&parser/ident ?member-name]
[::&parser/form ([[::&parser/ident "->"] [::&parser/tuple ?inputs] [::&parser/ident ?output]] :seq)]]
@@ -819,115 +744,139 @@
:type [inputs output]}]))}
=interface [::interface ?name =members]]
name module-name]
- (return (annotated [::definterface [name ?name] =members] ::&type/nothing))))
+ (return (list (annotated [::definterface [name ?name] =members] ::&type/nothing)))))
-(defanalyser analyse-def
- [::&parser/form ([[::&parser/ident "def"] ?usage ?value] :seq)]
- (match ?usage
- [::&parser/ident ?name]
- (exec [=value (with-scope ?name
- (analyse-form* ?value))
- _ (define ?name {:mode ::constant
- :access ::public
- :type (:type =value)})]
- (return (annotated [::def ?name =value] ::&type/nothing)))
+(defn ^:private analyse-basic-ast [analyse-ast token]
+ (match token
+ ;; Standard special forms
+ [::&parser/bool ?value]
+ (return (list (annotated [::literal ?value] [::&type/object "java.lang.Boolean" []])))
- [::&parser/form ([[::&parser/ident ?name] & ?args] :seq)]
- (exec [args (map-m extract-ident ?args)
- [=function =args =return] (within :types (&type/fresh-function (count args)))
- =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)))))
- =function (within :types (exec [_ (&type/solve =return (:type =value))]
- (&type/clean =function)))
- _ (define-fn ?name {:mode ::function
- :access ::public
- :type =function})]
- (return (annotated [::def [?name args] =value] ::&type/nothing)))
- ))
+ [::&parser/int ?value]
+ (return (list (annotated [::literal ?value] [::&type/object +int-class+ []])))
-(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))
- =value (with-scope ?name
- (with-scoped-name ?name =function
- (with-local ?tokens =tokens
- (analyse-form* ?value))))
- =function (within :types (exec [_ (&type/solve =return (:type =value))]
- (&type/clean =function)))
- _ (define-fn ?name {:mode ::macro
- :access ::public
- :type =function})]
- (return (annotated [::def [?name (list ?tokens)] =value] ::&type/nothing))))
-
-(defanalyser analyse-lambda
- [::&parser/form ([[::&parser/ident "lambda"] [::&parser/tuple ?args] ?body] :seq)]
- (exec [?args (map-m extract-ident ?args)
- [=function =args =return] (within :types (&type/fresh-function (count ?args)))
- [=scope =frame =body] (with-fresh-env [?args =args]
- (analyse-form* ?body))
- =function (within :types (exec [_ (&type/solve =return (:type =body))]
- (&type/clean =function)))]
- (return (annotated [::lambda =scope =frame ?args =body] =function))))
-
-(defanalyser analyse-import
- [::&parser/form ([[::&parser/ident "import"] [::&parser/ident ?class]] :seq)]
- (exec [_ (import-class ?class (last (string/split ?class #"\.")))]
- (return (annotated [::import ?class] ::&type/nothing))))
-
-(defanalyser analyse-use
- [::&parser/form ([[::&parser/ident "use"] [::&parser/text ?file] [::&parser/ident "as"] [::&parser/ident ?alias]] :seq)]
- (let [module-name (re-find #"[^/]+$" ?file)]
- (exec [_ (use-module module-name ?alias)]
- (return (annotated [::use ?file ?alias] ::&type/nothing)))))
+ [::&parser/real ?value]
+ (return (list (annotated [::literal ?value] [::&type/object "java.lang.Float" []])))
-(do-template [<name> <ident> <output-tag>]
- (defanalyser <name>
- [::&parser/form ([[::&parser/ident <ident>] ?x ?y] :seq)]
- (exec [=x (analyse-form* ?x)
- =y (analyse-form* ?y)]
- (return (annotated [<output-tag> =x =y] [::&type/object "java.lang.Integer" []]))))
-
- ^:private analyse-jvm-i+ "jvm/i+" ::jvm-i+
- ^:private analyse-jvm-i- "jvm/i-" ::jvm-i-
- ^:private analyse-jvm-i* "jvm/i*" ::jvm-i*
- ^:private analyse-jvm-idiv "jvm/i/" ::jvm-idiv
- ^:private analyse-jvm-irem "jvm/irem" ::jvm-irem
- )
+ [::&parser/char ?value]
+ (return (list (annotated [::literal ?value] [::&type/object "java.lang.Character" []])))
+
+ [::&parser/text ?value]
+ (return (list (annotated [::literal ?value] [::&type/object "java.lang.String" []])))
+
+ [::&parser/tag ?tag]
+ (return (list (annotated [::variant ?tag '()] [::&type/variant ?tag '()])))
+
+ [::&parser/form ([[::&parser/tag ?tag] & ?data] :seq)]
+ (exec [=data (do-all-m* (map analyse-ast ?data))]
+ (return (list (annotated [::variant ?tag =data] [::&type/variant ?tag (map :type =data)]))))
+
+ [::&parser/tuple ?elems]
+ (analyse-tuple analyse-ast ?elems)
+
+ [::&parser/ident ?ident]
+ (analyse-ident analyse-ast ?ident)
+
+ [::&parser/form ([[::&parser/ident "if"] ?test ?then ?else] :seq)]
+ (analyse-if analyse-ast ?test ?then ?else)
+
+ [::&parser/form ([[::&parser/ident "let"] [::&parser/ident ?label] ?value ?body] :seq)]
+ (analyse-let analyse-ast ?label ?value ?body)
+
+ [::&parser/form ([[::&parser/ident "case"] ?variant & ?branches] :seq)]
+ (analyse-case analyse-ast ?variant ?branches)
+
+ [::&parser/form ([[::&parser/ident "lambda"] [::&parser/tuple ?args] ?body] :seq)]
+ (analyse-lambda analyse-ast ?args ?body)
+
+ [::&parser/form ([[::&parser/ident "def"] ?usage ?value] :seq)]
+ (analyse-def analyse-ast ?usage ?value)
-(def analyse-form
- (try-all-m [analyse-bool
- analyse-int
- analyse-real
- analyse-char
- analyse-text
- analyse-ident
- analyse-tuple
- analyse-variant
- analyse-call
- analyse-do
- analyse-if
- analyse-let
- analyse-case
- analyse-lambda
- analyse-def
- analyse-defmacro
- analyse-defclass
- analyse-definterface
- analyse-use
- analyse-import
- analyse-jvm-i+
- analyse-jvm-i-
- analyse-jvm-i*
- analyse-jvm-idiv
- analyse-jvm-irem
- analyse-jvm-getstatic
- analyse-jvm-invokevirtual
- analyse-jvm-new
- analyse-jvm-new-array
- analyse-jvm-aastore
- analyse-jvm-aaload
- ]))
+ [::&parser/form ([[::&parser/ident "annotate"] [::&parser/ident ?ident] [::&parser/ident "Macro"]] :seq)]
+ (analyse-annotate ?ident)
+
+ [::&parser/form ([[::&parser/ident "require"] [::&parser/text ?path]] :seq)]
+ (analyse-require analyse-ast ?path)
+
+ ;; Host special forms
+ [::&parser/form ([[::&parser/ident "do"] & ?exprs] :seq)]
+ (analyse-do ?exprs)
+
+ [::&parser/form ([[::&parser/ident "jvm:iadd"] ?x ?y] :seq)]
+ (analyse-jvm-iadd analyse-ast ?x ?y)
+
+ [::&parser/form ([[::&parser/ident "jvm:isub"] ?x ?y] :seq)]
+ (analyse-jvm-isub analyse-ast ?x ?y)
+
+ [::&parser/form ([[::&parser/ident "jvm:imul"] ?x ?y] :seq)]
+ (analyse-jvm-imul analyse-ast ?x ?y)
+
+ [::&parser/form ([[::&parser/ident "jvm:idiv"] ?x ?y] :seq)]
+ (analyse-jvm-idiv analyse-ast ?x ?y)
+
+ [::&parser/form ([[::&parser/ident "jvm:irem"] ?x ?y] :seq)]
+ (analyse-jvm-irem analyse-ast ?x ?y)
+
+ [::&parser/form ([[::&parser/ident "jvm:getstatic"] [::&parser/ident ?class] [::&parser/ident ?field]] :seq)]
+ (analyse-jvm-getstatic analyse-ast ?class ?field)
+
+ [::&parser/form ([[::&parser/ident "jvm:invokevirtual"] [::&parser/ident ?class] [::&parser/text ?method] [::&parser/tuple ?classes] ?object [::&parser/tuple ?args]] :seq)]
+ (analyse-jvm-invokevirtual analyse-ast ?class ?method ?classes ?object ?args)
+
+ [::&parser/form ([[::&parser/ident "jvm:new"] [::&parser/ident ?class] [::&parser/tuple ?classes] [::&parser/tuple ?args]] :seq)]
+ (analyse-jvm-new analyse-ast ?class ?classes ?args)
+
+ [::&parser/form ([[::&parser/ident "jvm:new-array"] [::&parser/ident ?class] [::&parser/int ?length]] :seq)]
+ (analyse-jvm-new-array analyse-ast ?class ?length)
+
+ [::&parser/form ([[::&parser/ident "jvm:aastore"] ?array [::&parser/int ?idx] ?elem] :seq)]
+ (analyse-jvm-aastore analyse-ast ?array ?idx ?elem)
+
+ [::&parser/form ([[::&parser/ident "jvm:aaload"] ?array [::&parser/int ?idx]] :seq)]
+ (analyse-jvm-aaload analyse-ast ?array ?idx)
+
+ [::&parser/form ([[::&parser/ident "jvm:class"] [::&parser/ident ?name] [::&parser/ident ?super-class] [::&parser/tuple ?fields]] :seq)]
+ (analyse-jvm-class analyse-ast ?name ?super-class ?fields)
+
+ [::&parser/form ([[::&parser/ident "jvm:interface"] [::&parser/ident ?name] & ?members] :seq)]
+ (analyse-jvm-interface analyse-ast ?name ?members)
+
+ _
+ (fail (str "[Analyser Error] Unmatched token: " token))))
+
+(defn analyse-ast [token]
+ ;; (prn 'analyse-ast token)
+ (match token
+ [::&parser/form ([?fn & ?args] :seq)]
+ (try-all-m [(analyse-call analyse-ast ?fn ?args)
+ (analyse-basic-ast analyse-ast token)])
+
+ _
+ (analyse-basic-ast analyse-ast token)))
+
+(def analyse
+ (exec [asts &parser/parse
+ ;; :let [_ (prn 'asts asts)]
+ ]
+ (do-all-m* (map analyse-ast asts))))
+
+(comment
+ (do (defn analyse-all []
+ (exec [?analyses analyse]
+ (fn [?state]
+ (if (empty? (::&lexer/source ?state))
+ (return* ?state ?analyses)
+ ((exec [more-analyses (analyse-all)]
+ (return (concat ?analyses more-analyses)))
+ ?state)))))
+
+ (let [name "lux"]
+ (&util/reset-loader!)
+ (time ((analyse-all) {::&lexer/source (slurp (str "source/" name ".lux"))
+ ::current-module name
+ ::modules {}
+ ::global-env {}
+ ::local-envs (list)
+ ::types &type/+init+})))
+ )
+ )
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 6d8cd08ff..676923258 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -6,6 +6,7 @@
[clojure.core.match :refer [match]]
(lux [util :as &util :refer [exec return* return fail fail*
repeat-m exhaust-m try-m try-all-m map-m reduce-m
+ do-all-m
apply-m within
normalize-ident
loader reset-loader!]]
@@ -174,7 +175,7 @@
(doto *writer*
(.visitVarInsn Opcodes/ALOAD 0)
(.visitFieldInsn Opcodes/GETFIELD
- (apply str (interpose "$" (map (comp normalize-ident str) ?scope)))
+ (normalize-ident ?scope)
(str "__" ?captured-id)
"Ljava/lang/Object;")))
@@ -954,10 +955,6 @@
(->> (doseq [[?tfield ?member] (mapv vector (range (count ?members)) ?members)]))))
))
-(defcompiler compile-import
- [::&analyser/import ?class]
- nil)
-
(defcompiler compile-use
[::&analyser/use ?file ?alias]
(let [module-name (re-find #"[^/]+$" ?file)
@@ -1028,14 +1025,12 @@
(assert false (str "Can't compile: " (pr-str (:form state)))))))
;; [Interface]
-(def !state (atom nil))
-
-(defn compile [module-name inputs]
- (if-let [module (get-in @!state [:modules module-name])]
+(defn compile [state module-name inputs]
+ (if-let [module (get-in state [:modules module-name])]
(assert false "Can't redefine a module!")
(do (reset-loader!)
(let [init-state (let [+prelude-module+ "lux"
- init-state (assoc @!state :name module-name, :forms inputs, :defs-env {})]
+ init-state (assoc state :name module-name, :forms inputs, :defs-env {})]
(if (= +prelude-module+ module-name)
init-state
(assoc init-state :defs-env (into {} (for [[?name ?desc] (get-in init-state [:modules +prelude-module+])]
@@ -1055,15 +1050,14 @@
:parent nil}
new-state (match ((exhaust-m
(&analyser/with-scope module-name
- (exec [ann-input &analyser/analyse-form
+ (exec [ann-input &analyser/analyse
:let [_ (when (not (compile-form (assoc compiler-state :form ann-input)))
(assert false ann-input))]]
(return ann-input))))
init-state)
[::&util/ok [?state ?forms]]
(if (empty? (:forms ?state))
- (do (reset! !state ?state)
- ?state)
+ ?state
(assert false (str "Unconsumed input: " (pr-str (first (:forms ?state))))))
[::&util/failure ?message]
@@ -1073,30 +1067,36 @@
(write-class module-name bytecode)
(load-class! (string/replace module-name #"/" ".") (str module-name ".class"))
bytecode)
- new-state
+ [::&util/ok [new-state true]]
))))
(defn compile-file [name]
- (match ((&parser/parse-all) {::&lexer/source (slurp (str "source/" name ".lux"))})
- [::&util/ok [?state ?forms]]
- (let [?forms* (filter identity ?forms)]
- (prn '?forms ?forms*)
- (compile name ?forms*))
+ (fn [state]
+ (match ((&parser/parse-all) {::&lexer/source (slurp (str "source/" name ".lux"))})
+ [::&util/ok [?state ?forms]]
+ (let [?forms* (filter identity ?forms)]
+ ;; (prn '?forms ?forms*)
+ (compile state name ?forms*))
- [::&util/failure ?message]
- (assert false ?message)))
+ [::&util/failure ?message]
+ (fail* ?message))))
(defn compile-all [files]
- (reset! !state {:name nil
- :forms nil
- :modules {}
- :deps {}
- :imports {}
- :defs-env {}
- :lambda-scope [[] 0]
- :env (list (&analyser/fresh-env 0))
- :types &type/+init+})
- (dorun (map compile-file files)))
+ (let [state {:name nil
+ :forms nil
+ :modules {}
+ :deps {}
+ :imports {}
+ :defs-env {}
+ :lambda-scope [[] 0]
+ :env (list (&analyser/fresh-env 0))
+ :types &type/+init+}]
+ (match ((do-all-m (map compile-file files)) state)
+ [::&util/ok [?state ?forms]]
+ (println (str "Compilation complete! " (pr-str files)))
+
+ [::&util/failure ?message]
+ (assert false ?message))))
(comment
(compile-all ["lux"])
diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj
index 78b9dc304..132f3402e 100644
--- a/src/lux/lexer.clj
+++ b/src/lux/lexer.clj
@@ -16,7 +16,7 @@
(return* (update-in state [::source] #(.substring % (.length match))) [tok1 tok2])
(fail* (str "[Lexer Error] Pattern failed: " regex)))))
-(defn ^:private lex-str [prefix]
+(defn ^:private lex-prefix [prefix]
(fn [state]
(if (.startsWith (::source state) prefix)
(return* (update-in state [::source] #(.substring % (.length prefix))) prefix)
@@ -34,10 +34,10 @@
;; else
(fail (str "[Lexer Error] Unknown escape character: " escaped))))
-(def ^:private lex-string-body
+(def ^:private lex-text-body
(try-all-m [(exec [[prefix escaped] (lex-regex2 #"(?s)^([^\"\\]*)(\\.)")
unescaped (escape-char escaped)
- postfix lex-string-body]
+ postfix lex-text-body]
(return (str prefix unescaped postfix)))
(lex-regex #"(?s)^([^\"\\]*)")]))
@@ -48,6 +48,26 @@
(exec [white-space (lex-regex #"^(\s+)")]
(return [::white-space white-space])))
+(def ^:private lex-single-line-comment
+ (exec [_ (lex-prefix "##")
+ comment (lex-regex #"^([^\n]*)")
+ _ (lex-regex #"^(\n?)")]
+ (return [::comment comment])))
+
+(def ^:private lex-multi-line-comment
+ (exec [_ (lex-prefix "#(")
+ comment (try-all-m [(lex-regex #"(?is)^((?!#\().)*?(?=\)#)")
+ (exec [pre (lex-regex #"(?is)^(.+?(?=#\())")
+ [_ inner] lex-multi-line-comment
+ post (lex-regex #"(?is)^(.+?(?=\)#))")]
+ (return (str pre "#(" inner ")#" post)))])
+ _ (lex-prefix ")#")]
+ (return [::comment comment])))
+
+(def ^:private lex-comment
+ (try-all-m [lex-single-line-comment
+ lex-multi-line-comment]))
+
(do-template [<name> <tag> <regex>]
(def <name>
(exec [token (lex-regex <regex>)]
@@ -59,47 +79,27 @@
^:private lex-ident ::ident +ident-re+)
(def ^:private lex-char
- (exec [_ (lex-str "#\"")
+ (exec [_ (lex-prefix "#\"")
token (try-all-m [(exec [escaped (lex-regex #"^(\\.)")]
(escape-char escaped))
(lex-regex #"^(.)")])
- _ (lex-str "\"")]
+ _ (lex-prefix "\"")]
(return [::char token])))
(def ^:private lex-text
- (exec [_ (lex-str "\"")
- token lex-string-body
- _ (lex-str "\"")]
+ (exec [_ (lex-prefix "\"")
+ token lex-text-body
+ _ (lex-prefix "\"")]
(return [::text token])))
-(def ^:private lex-single-line-comment
- (exec [_ (lex-str "##")
- comment (lex-regex #"^([^\n]*)")
- _ (lex-regex #"^(\n?)")]
- (return [::comment comment])))
-
-(def ^:private lex-multi-line-comment
- (exec [_ (lex-str "#(")
- comment (try-all-m [(lex-regex #"(?is)^((?!#\().)*?(?=\)#)")
- (exec [pre (lex-regex #"(?is)^(.+?(?=#\())")
- [_ inner] lex-multi-line-comment
- post (lex-regex #"(?is)^(.+?(?=\)#))")]
- (return (str pre "#(" inner ")#" post)))])
- _ (lex-str ")#")]
- (return [::comment comment])))
-
-(def ^:private lex-comment
- (try-all-m [lex-single-line-comment
- lex-multi-line-comment]))
-
(def ^:private lex-tag
- (exec [_ (lex-str "#")
+ (exec [_ (lex-prefix "#")
token (lex-regex +ident-re+)]
(return [::tag token])))
(do-template [<name> <text> <tag>]
(def <name>
- (exec [_ (lex-str <text>)]
+ (exec [_ (lex-prefix <text>)]
(return [<tag>])))
^:private lex-open-paren "(" ::open-paren
@@ -121,6 +121,7 @@
;; [Interface]
(def lex
(try-all-m [lex-white-space
+ lex-comment
lex-bool
lex-real
lex-int
@@ -128,5 +129,4 @@
lex-text
lex-ident
lex-tag
- lex-comment
lex-delimiter]))
diff --git a/src/lux/parser.clj b/src/lux/parser.clj
index e3a5a08a9..92d6d43b9 100644
--- a/src/lux/parser.clj
+++ b/src/lux/parser.clj
@@ -1,76 +1,26 @@
(ns lux.parser
(:require [clojure.template :refer [do-template]]
[clojure.core.match :refer [match]]
- (lux [util :as &util :refer [exec return* return fail fail*
- repeat-m try-m try-all-m map-m
- apply-m]]
+ (lux [util :as &util :refer [exec return fail repeat-m]]
[lexer :as &lexer])))
-(declare parse)
-
;; [Utils]
-(defmacro ^:private defparser [name match return]
- `(defn ~name [token#]
- (match token#
- ~match
- ~return
-
- _#
- (fail (str "[Parser Error] Unmatched token: " token#)))))
-
-;; [Parsers]
-(let [first-char #(.charAt % 0)]
- (do-template [<name> <input-tag> <output-tag> <method>]
- (defparser <name>
- [<input-tag> ?value]
- (return [<output-tag> (<method> ?value)]))
-
- ^:private parse-bool ::&lexer/bool ::bool Boolean/parseBoolean
- ^:private parse-int ::&lexer/int ::int Integer/parseInt
- ^:private parse-real ::&lexer/real ::real Float/parseFloat
- ^:private parse-char ::&lexer/char ::char first-char
- ^:private parse-text ::&lexer/text ::text identity
- ^:private parse-ident ::&lexer/ident ::ident identity
- ))
-
-(defparser parse-comment
- [::&lexer/comment _]
- (return nil))
-
-(defparser parse-whitespace
- [::&lexer/white-space _]
- (return nil))
-
-(defparser ^:private parse-tag
- [::&lexer/tag ?tag]
- (return [::tag ?tag]))
-
-(defparser ^:private parse-form
- [::&lexer/open-paren]
- (exec [elems (repeat-m parse)
- token &lexer/lex]
- (if (= [::&lexer/close-paren] token)
- (return [::form (filter identity elems)])
- (fail "[Parser Error] Unbalanced parantheses."))))
-
-(do-template [<name> <open-tag> <close-tag> <description> <ast>]
- (defparser <name>
- [<open-tag>]
+(do-template [<name> <close-token> <description> <ast>]
+ (defn <name> [parse]
(exec [elems (repeat-m parse)
token &lexer/lex]
- (if (= [<close-tag>] token)
- (return [<ast> (filter identity elems)])
+ (if (= <close-token> token)
+ (return (list [<ast> (apply concat elems)]))
(fail (str "[Parser Error] Unbalanced " <description> ".")))))
- ^:private parse-form ::&lexer/open-paren ::&lexer/close-paren "parantheses" ::form
- ^:private parse-tuple ::&lexer/open-bracket ::&lexer/close-bracket "brackets" ::tuple
+ ^:private parse-form [::&lexer/close-paren] "parantheses" ::form
+ ^:private parse-tuple [::&lexer/close-bracket] "brackets" ::tuple
)
-(defparser ^:private parse-record
- [::&lexer/open-brace]
+(defn ^:private parse-record [parse]
(exec [elems* (repeat-m parse)
token &lexer/lex
- :let [elems (filter identity elems*)]]
+ :let [elems (apply concat elems*)]]
(cond (not= [::&lexer/close-brace] token)
(fail (str "[Parser Error] Unbalanced braces."))
@@ -78,32 +28,47 @@
(fail (str "[Parser Error] Records must have an even number of elements."))
:else
- (return [::record (filter identity elems)]))))
-
-(let [parsers [parse-comment
- parse-whitespace
- parse-bool
- parse-int
- parse-real
- parse-char
- parse-text
- parse-tag
- parse-ident
- parse-form
- parse-tuple
- parse-record]]
- (defn ^:private parse-token [token]
- (try-all-m (map #(% token) parsers))))
-
-(def ^:private parse
+ (return (list [::record elems])))))
+
+;; [Interface]
+(def parse
(exec [token &lexer/lex]
- (parse-token token)))
-
-(defn parse-all []
- (exec [ast parse]
- (fn [state]
- (if (empty? (::&lexer/source state))
- (return* state (if ast (list ast) '()))
- ((exec [asts (parse-all)]
- (return (cons ast asts)))
- state)))))
+ (match token
+ [::&lexer/white-space _]
+ (return '())
+
+ [::&lexer/comment _]
+ (return '())
+
+ [::&lexer/bool ?value]
+ (return (list [::bool (Boolean/parseBoolean ?value)]))
+
+ [::&lexer/int ?value]
+ (return (list [::int (Integer/parseInt ?value)]))
+
+ [::&lexer/real ?value]
+ (return (list [::real (Float/parseFloat ?value)]))
+
+ [::&lexer/char ?value]
+ (return (list [::char (.charAt ?value 0)]))
+
+ [::&lexer/text ?value]
+ (return (list [::text ?value]))
+
+ [::&lexer/ident ?value]
+ (return (list [::ident ?value]))
+
+ [::&lexer/tag ?value]
+ (return (list [::tag ?value]))
+
+ [::&lexer/open-paren]
+ (parse-form parse)
+
+ [::&lexer/open-bracket]
+ (parse-tuple parse)
+
+ [::&lexer/open-brace]
+ (parse-record parse)
+
+ _
+ (fail (str "[Parser Error] Unmatched token: " token)))))
diff --git a/src/lux/util.clj b/src/lux/util.clj
index 3662a4ea5..5d0d6ffc5 100644
--- a/src/lux/util.clj
+++ b/src/lux/util.clj
@@ -138,6 +138,20 @@
(fn [state]
(return* state state)))
+(defn do-all-m [monads]
+ (if (empty? monads)
+ (return '())
+ (exec [head (first monads)
+ tail (do-all-m (rest monads))]
+ (return (cons head tail)))))
+
+(defn do-all-m* [monads]
+ (if (empty? monads)
+ (return '())
+ (exec [head (first monads)
+ tail (do-all-m* (rest monads))]
+ (return (concat head tail)))))
+
(defn within [slot monad]
(fn [state]
(let [=return (monad (get state slot))]