aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser.clj42
-rw-r--r--src/lux/analyser/base.clj12
-rw-r--r--src/lux/analyser/case.clj12
-rw-r--r--src/lux/analyser/def.clj16
-rw-r--r--src/lux/analyser/env.clj40
-rw-r--r--src/lux/analyser/host.clj77
-rw-r--r--src/lux/analyser/lambda.clj17
-rw-r--r--src/lux/analyser/lux.clj91
-rw-r--r--src/lux/base.clj113
-rw-r--r--src/lux/compiler.clj27
-rw-r--r--src/lux/compiler/base.clj64
-rw-r--r--src/lux/compiler/case.clj11
-rw-r--r--src/lux/compiler/host.clj15
-rw-r--r--src/lux/compiler/lambda.clj9
-rw-r--r--src/lux/compiler/lux.clj64
-rw-r--r--src/lux/host.clj8
-rw-r--r--src/lux/lexer.clj44
-rw-r--r--src/lux/parser.clj32
-rw-r--r--src/lux/type.clj110
19 files changed, 417 insertions, 387 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 323c35bff..235478782 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -2,10 +2,7 @@
(:require (clojure [template :refer [do-template]])
[clojure.core.match :as M :refer [matchv]]
clojure.core.match.array
- (lux [base :as & :refer [exec return fail
- |list
- try-all-m map-m |flat-map% reduce-m
- assert!]]
+ (lux [base :as & :refer [exec return fail]]
[parser :as &parser]
[type :as &type]
[macro :as &macro]
@@ -34,19 +31,19 @@
(matchv ::M/objects [token]
;; Standard special forms
[["Bool" ?value]]
- (return (|list (&/V "Expression" (&/T (&/V "bool" ?value) (&/V "Data" (&/T "java.lang.Boolean" (&/V "Nil" nil)))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "bool" ?value) (&/V "Data" (&/T "java.lang.Boolean" (&/V "Nil" nil)))))))
[["Int" ?value]]
- (return (|list (&/V "Expression" (&/T (&/V "int" ?value) (&/V "Data" (&/T "java.lang.Long" (&/V "Nil" nil)))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "int" ?value) (&/V "Data" (&/T "java.lang.Long" (&/V "Nil" nil)))))))
[["Real" ?value]]
- (return (|list (&/V "Expression" (&/T (&/V "real" ?value) (&/V "Data" (&/T "java.lang.Double" (&/V "Nil" nil)))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "real" ?value) (&/V "Data" (&/T "java.lang.Double" (&/V "Nil" nil)))))))
[["Char" ?value]]
- (return (|list (&/V "Expression" (&/T (&/V "char" ?value) (&/V "Data" (&/T "java.lang.Character" (&/V "Nil" nil)))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "char" ?value) (&/V "Data" (&/T "java.lang.Character" (&/V "Nil" nil)))))))
[["Text" ?value]]
- (return (|list (&/V "Expression" (&/T (&/V "text" ?value) (&/V "Data" (&/T "java.lang.String" (&/V "Nil" nil)))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "text" ?value) (&/V "Data" (&/T "java.lang.String" (&/V "Nil" nil)))))))
[["Tuple" ?elems]]
(&&lux/analyse-tuple analyse ?elems)
@@ -56,11 +53,11 @@
[["Tag" ?tag]]
(let [tuple-type (&/V "Tuple" (&/V "Nil" nil))]
- (return (|list [&/V "Expression" (&/T (&/V "variant" (&/T ?tag (&/V "Expression" (&/T (&/V "tuple" (|list)) tuple-type))))
+ (return (&/|list [&/V "Expression" (&/T (&/V "variant" (&/T ?tag (&/V "Expression" (&/T (&/V "tuple" (&/|list)) tuple-type))))
(&/V "Variant" (&/V "Cons" (&/T (&/T ?tag tuple-type) (&/V "Nil" nil)))))])))
[["Ident" "jvm-null"]]
- (return (|list [&/V "Expression" (&/T (&/V "jvm-null" nil) (&/V "Data" (&/T "null" (&/V "Nil" nil))))]))
+ (return (&/|list [&/V "Expression" (&/T (&/V "jvm-null" nil) (&/V "Data" (&/T "null" (&/V "Nil" nil))))]))
[["Ident" ?ident]]
(&&lux/analyse-ident analyse ?ident)
@@ -99,7 +96,7 @@
;; Host special forms
[["Form" ["Cons" [["Ident" "exec"] ?exprs]]]]
- (&&host/analyse-exec analyse (&/->seq ?exprs))
+ (&&host/analyse-exec analyse ?exprs)
;; Integer arithmetic
[["Form" ["Cons" [["Ident" "jvm-iadd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
@@ -246,7 +243,7 @@
["Cons" [["Tuple" ?classes]
["Cons" [["Tuple" ?args]
["Nil" _]]]]]]]]]]]]]
- (&&host/analyse-jvm-invokestatic analyse ?class ?method (&/->seq ?classes) (&/->seq ?args))
+ (&&host/analyse-jvm-invokestatic analyse ?class ?method ?classes ?args)
[["Form" ["Cons" [["Ident" "jvm-invokevirtual"]
["Cons" [["Ident" ?class]
@@ -255,7 +252,7 @@
["Cons" [?object
["Cons" [["Tuple" ?args]
["Nil" _]]]]]]]]]]]]]]]
- (&&host/analyse-jvm-invokevirtual analyse ?class ?method (&/->seq ?classes) ?object (&/->seq ?args))
+ (&&host/analyse-jvm-invokevirtual analyse ?class ?method ?classes ?object ?args)
[["Form" ["Cons" [["Ident" "jvm-invokeinterface"]
["Cons" [["Ident" ?class]
@@ -264,7 +261,7 @@
["Cons" [?object
["Cons" [["Tuple" ?args]
["Nil" _]]]]]]]]]]]]]]]
- (&&host/analyse-jvm-invokeinterface analyse ?class ?method (&/->seq ?classes) ?object (&/->seq ?args))
+ (&&host/analyse-jvm-invokeinterface analyse ?class ?method ?classes ?object ?args)
[["Form" ["Cons" [["Ident" "jvm-invokespecial"]
["Cons" [["Ident" ?class]
@@ -273,13 +270,13 @@
["Cons" [?object
["Cons" [["Tuple" ?args]
["Nil" _]]]]]]]]]]]]]]]
- (&&host/analyse-jvm-invokespecial analyse ?class ?method (&/->seq ?classes) ?object (&/->seq ?args))
+ (&&host/analyse-jvm-invokespecial analyse ?class ?method ?classes ?object ?args)
;; Exceptions
[["Form" ["Cons" [["Ident" "jvm-try"]
["Cons" [?body
?handlers]]]]]]
- (&&host/analyse-jvm-try analyse ?body (reduce parse-handler [(list) nil] (&/->seq ?handlers)))
+ (&&host/analyse-jvm-try analyse ?body (&/fold parse-handler [(list) nil] ?handlers))
[["Form" ["Cons" [["Ident" "jvm-throw"]
["Cons" [?ex
@@ -380,7 +377,7 @@
;; Classes & interfaces
[["Form" ["Cons" [["Ident" "jvm-class"] ["Cons" [["Ident" ?name] ["Cons" [["Ident" ?super-class] ["Cons" [["Tuple" ?fields] ["Nil" _]]]]]]]]]]]
- (&&host/analyse-jvm-class analyse ?name ?super-class (&/->seq ?fields))
+ (&&host/analyse-jvm-class analyse ?name ?super-class ?fields)
[["Form" ["Cons" [["Ident" "jvm-interface"] ["Cons" [["Ident" ?name] ?members]]]]]]
(&&host/analyse-jvm-interface analyse ?name ?members)
@@ -398,12 +395,11 @@
(matchv ::M/objects [token]
[["Form" ["Cons" [["Tag" ?tag] ?values]]]]
(exec [;; :let [_ (prn 'PRE-ASSERT)]
- :let [?values (&/->seq ?values)]
- :let [_ (assert (= 1 (count ?values)) (str "[Analyser Error] Can only tag 1 value: " (pr-str token)))]
+ :let [_ (assert (= 1 (&/|length ?values)) (str "[Analyser Error] Can only tag 1 value: " (pr-str token)))]
;; :let [_ (prn 'POST-ASSERT)]
- =value (&&/analyse-1 (analyse-ast eval!) (first ?values))
+ =value (&&/analyse-1 (analyse-ast eval!) (&/|head ?values))
=value-type (&&/expr-type =value)]
- (return (|list (&/V "Expression" (&/T (&/V "variant" (&/T ?tag =value)) (&/V "Variant" (&/V "Cons" (&/T (&/T ?tag =value-type) (&/V "Nil" nil)))))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "variant" (&/T ?tag =value)) (&/V "Variant" (&/V "Cons" (&/T (&/T ?tag =value-type) (&/V "Nil" nil)))))))))
[["Form" ["Cons" [?fn ?args]]]]
(fn [state]
@@ -422,4 +418,4 @@
(exec [asts &parser/parse
;; :let [_ (prn 'analyse/asts asts)]
]
- (|flat-map% (analyse-ast eval!) asts)))
+ (&/flat-map% (analyse-ast eval!) asts)))
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index b2ec4d0c5..256acd346 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -1,9 +1,7 @@
(ns lux.analyser.base
(:require [clojure.core.match :as M :refer [match matchv]]
clojure.core.match.array
- (lux [base :as & :refer [exec return fail
- try-all-m map-m mapcat-m reduce-m
- assert!]]
+ (lux [base :as & :refer [exec return fail]]
[type :as &type])))
;; [Resources]
@@ -19,16 +17,16 @@
(defn analyse-1 [analyse elem]
(exec [output (analyse elem)]
(matchv ::M/objects [output]
- ["Cons" [x ["Nil" _]]]
+ [["Cons" [x ["Nil" _]]]]
(return x)
[_]
(fail "[Analyser Error] Can't expand to other than 1 element."))))
(defn analyse-2 [analyse el1 el2]
- (exec [output (mapcat-m analyse (list el1 el2))]
- (match output
- ["Cons" [x ["Cons" [y ["Nil" _]]]]]
+ (exec [output (&/flat-map analyse (list el1 el2))]
+ (matchv ::M/objects [output]
+ [["Cons" [x ["Cons" [y ["Nil" _]]]]]]
(return [x y])
[_]
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index ba2342245..cd5bf9e39 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -1,9 +1,7 @@
(ns lux.analyser.case
(:require [clojure.core.match :as M :refer [match matchv]]
clojure.core.match.array
- (lux [base :as & :refer [exec return fail
- try-all-m map-m mapcat-m reduce-m
- assert!]]
+ (lux [base :as & :refer [exec return fail]]
[parser :as &parser]
[type :as &type])
(lux.analyser [base :as &&]
@@ -13,16 +11,16 @@
(defn locals [member]
(matchv ::M/objects [member]
[["Ident" ?name]]
- (|list ?name)
+ (&/|list ?name)
[["Tuple" ?submembers]]
- (|flat-map locals ?submembers)
+ (&/flat-map locals ?submembers)
[["Form" ["Cons" [["Tag" _] ?submembers]]]]
- (|flat-map locals ?submembers)
+ (&/flat-map locals ?submembers)
[_]
- (|list)))
+ (&/|list)))
(defn analyse-branch [analyse max-registers [bindings body]]
;; (prn 'analyse-branch max-registers bindings body)
diff --git a/src/lux/analyser/def.clj b/src/lux/analyser/def.clj
index 4ac7029f1..e83bbb85d 100644
--- a/src/lux/analyser/def.clj
+++ b/src/lux/analyser/def.clj
@@ -2,21 +2,19 @@
(:require (clojure [template :refer [do-template]])
[clojure.core.match :as M :refer [matchv]]
clojure.core.match.array
- (lux [base :as & :refer [exec return return* fail
- if-m try-all-m map-m mapcat-m reduce-m
- assert!]])
+ (lux [base :as & :refer [exec return return* fail]])
[lux.analyser.base :as &&]))
;; [Exports]
(def init-module
- (R "defs" (|table)
- "macros" (|table)))
+ (&/R "defs" (&/|table)
+ "macros" (&/|table)))
(do-template [<name> <category>]
(defn <name> [module name]
(fn [state]
(return* state
- (->> state (get$ "modules") (|get module) (get$ <category>) (|get name) boolean))))
+ (->> state (&/get$ "modules") (&/|get module) (&/get$ <category>) (&/|get name) boolean))))
defined? "defs"
macro? "macros"
@@ -24,7 +22,7 @@
(defn declare-macro [module name]
(fn [state]
- (return* (update$ "modules" (fn [ms] (|update module (fn [m] (update$ "macros" #(|put name true %) m)) ms)) state)
+ (return* (&/update$ "modules" (fn [ms] (&/|update module (fn [m] (&/update$ "macros" #(&/|put name true %) m)) ms)) state)
nil)))
(defn define [module name type]
@@ -32,6 +30,6 @@
(let [full-name (str module &/+name-separator+ name)
bound (&/V "Expression" (&/T (&/V "global" (&/T module name)) type))]
(return* (->> state
- (update$ "modules" (fn [ms] (|update module (fn [m] (update$ "defs" #(|put name type %) m)) ms)))
- (update$ "global-env" #(|merge (|table full-name bound, name bound) %)))
+ (&/update$ "modules" (fn [ms] (&/|update module (fn [m] (&/update$ "defs" #(&/|put name type %) m)) ms)))
+ (&/update$ "global-env" #(&/|merge (&/|table full-name bound, name bound) %)))
nil))))
diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj
index eeaebc18f..816332404 100644
--- a/src/lux/analyser/env.clj
+++ b/src/lux/analyser/env.clj
@@ -1,37 +1,33 @@
(ns lux.analyser.env
(:require [clojure.core.match :as M :refer [matchv]]
clojure.core.match.array
- (lux [base :as & :refer [exec return return* fail
- get$ set$ update$
- |list |get |contains? |concat
- if-m try-all-m map-m mapcat-m reduce-m
- assert!]])
+ (lux [base :as & :refer [exec return return* fail]])
[lux.analyser.base :as &&]))
;; [Exports]
(def next-local-idx
(fn [state]
- (return* state (->> state (get$ "local-envs") |head (get$ "locals") (get$ "counter")))))
+ (return* state (->> state (&/get$ "local-envs") &/|head (&/get$ "locals") (&/get$ "counter")))))
(defn with-local [name type body]
(fn [state]
- (let [old-mappings (->> state (get$ "local-envs") |head (get$ "locals") (get$ "mappings"))
- =return (body (update$ "local-envs"
- (fn [[top & stack]]
- (let [bound-unit (&/V "local" (-> top (get$ "locals") (get$ "counter")))]
- (cons (-> top
- (update$ "locals" #(update$ "counter" inc %))
- (update$ "locals" #(update$ "mappings" (fn [m] (|put name (&/V "Expression" (&/T bound-unit type)) m)) %)))
- stack)))
- state))]
+ (let [old-mappings (->> state (&/get$ "local-envs") &/|head (&/get$ "locals") (&/get$ "mappings"))
+ =return (body (&/update$ "local-envs"
+ (fn [[top & stack]]
+ (let [bound-unit (&/V "local" (-> top (&/get$ "locals") (&/get$ "counter")))]
+ (cons (-> top
+ (&/update$ "locals" #(&/update$ "counter" inc %))
+ (&/update$ "locals" #(&/update$ "mappings" (fn [m] (&/|put name (&/V "Expression" (&/T bound-unit type)) m)) %)))
+ stack)))
+ state))]
(matchv ::M/objects [=return]
[["Right" [?state ?value]]]
- (return* (update$ "local-envs" (fn [[top* & stack*]]
- (cons (->> top*
- (update$ "locals" #(update$ "counter" dec %))
- (update$ "locals" #(set$ "mappings" old-mappings %)))
- stack*))
- ?state)
+ (return* (&/update$ "local-envs" (fn [[top* & stack*]]
+ (cons (->> top*
+ (&/update$ "locals" #(&/update$ "counter" dec %))
+ (&/update$ "locals" #(&/set$ "mappings" old-mappings %)))
+ stack*))
+ ?state)
?value)
[_]
@@ -45,4 +41,4 @@
(def captured-vars
(fn [state]
- (return* state (->> state (get$ "local-envs") |head (get$ "closure") (get$ "mappings")))))
+ (return* state (->> state (&/get$ "local-envs") &/|head (&/get$ "closure") (&/get$ "mappings")))))
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index a87964ed8..15680d681 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -2,10 +2,7 @@
(:require (clojure [template :refer [do-template]])
[clojure.core.match :as M :refer [match matchv]]
clojure.core.match.array
- (lux [base :as & :refer [exec return fail
- |list
- try-all-m map-m reduce-m
- assert!]]
+ (lux [base :as & :refer [exec return fail]]
[parser :as &parser]
[type :as &type]
[host :as &host])
@@ -39,7 +36,7 @@
=y-type (&&/expr-type =y)
_ (&type/solve input-type =x-type)
_ (&type/solve input-type =y-type)]
- (return (|list (&/V "Expression" (&/T (&/V <output-tag> (&/T =x =y)) output-type)))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V <output-tag> (&/T =x =y)) output-type)))))))
analyse-jvm-iadd "jvm-iadd" "java.lang.Integer" "java.lang.Integer"
analyse-jvm-isub "jvm-isub" "java.lang.Integer" "java.lang.Integer"
@@ -84,13 +81,13 @@
=type (&host/lookup-static-field =class ?field)
;; :let [_ (prn 'analyse-jvm-getstatic/=type =type)]
]
- (return (|list (&/V "Expression" (&/T (&/V "jvm-getstatic" (&/T =class ?field)) =type))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "jvm-getstatic" (&/T =class ?field)) =type))))))
(defn analyse-jvm-getfield [analyse ?class ?field ?object]
(exec [=class (&host/full-class-name ?class)
=type (&host/lookup-static-field =class ?field)
=object (&&/analyse-1 analyse ?object)]
- (return (|list (&/V "Expression" (&/T (&/V "jvm-getfield" (&/T =class ?field =object)) =type))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "jvm-getfield" (&/T =class ?field =object)) =type))))))
(defn analyse-jvm-putstatic [analyse ?class ?field ?value]
(exec [=class (&host/full-class-name ?class)
@@ -98,36 +95,36 @@
=type (&host/lookup-static-field =class ?field)
;; :let [_ (prn 'analyse-jvm-getstatic/=type =type)]
=value (&&/analyse-1 analyse ?value)]
- (return (|list (&/V "Expression" (&/T (&/V "jvm-putstatic" (&/T =class ?field =value)) =type))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "jvm-putstatic" (&/T =class ?field =value)) =type))))))
(defn analyse-jvm-putfield [analyse ?class ?field ?object ?value]
(exec [=class (&host/full-class-name ?class)
=type (&host/lookup-static-field =class ?field)
=object (&&/analyse-1 analyse ?object)
=value (&&/analyse-1 analyse ?value)]
- (return (|list (&/V "Expression" (&/T (&/V "jvm-putfield" (&/T =class ?field =object =value)) =type))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "jvm-putfield" (&/T =class ?field =object =value)) =type))))))
(defn analyse-jvm-invokestatic [analyse ?class ?method ?classes ?args]
(exec [=class (&host/full-class-name ?class)
- =classes (map-m &host/extract-jvm-param ?classes)
+ =classes (&/map% &host/extract-jvm-param ?classes)
=return (&host/lookup-virtual-method =class ?method =classes)
- =args (mapcat-m analyse ?args)]
- (return (|list (&/V "Expression" (&/T (&/V "jvm-invokestatic" (&/T =class ?method =classes =args)) =return))))))
+ =args (&/flat-map% analyse ?args)]
+ (return (&/|list (&/V "Expression" (&/T (&/V "jvm-invokestatic" (&/T =class ?method =classes =args)) =return))))))
(do-template [<name> <tag>]
(defn <name> [analyse ?class ?method ?classes ?object ?args]
(exec [=class (&host/full-class-name ?class)
;; :let [_ (prn 'analyse-jvm-invokevirtual/=class =class)]
- =classes (map-m &host/extract-jvm-param ?classes)
+ =classes (&/map% &host/extract-jvm-param ?classes)
;; :let [_ (prn 'analyse-jvm-invokevirtual/=classes =classes)]
[=method-args =return] (&host/lookup-virtual-method =class ?method =classes)
;; :let [_ (prn 'analyse-jvm-invokevirtual/=return =return)]
=object (&&/analyse-1 analyse ?object)
;; :let [_ (prn 'analyse-jvm-invokevirtual/=object =object)]
- =args (mapcat-m analyse ?args)
+ =args (&/flat-map% analyse ?args)
;; :let [_ (prn 'analyse-jvm-invokevirtual/=args =args)]
]
- (return (|list (&/V "Expression" (&/T (&/V <tag> (&/T =class ?method =classes =object =args)) =return))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V <tag> (&/T =class ?method =classes =object =args)) =return))))))
analyse-jvm-invokevirtual "jvm-invokevirtual"
analyse-jvm-invokeinterface "jvm-invokeinterface"
@@ -136,17 +133,17 @@
(defn analyse-jvm-null? [analyse ?object]
(exec [=object (&&/analyse-1 analyse ?object)]
- (return (|list (&/V "Expression" (&/T (&/V "jvm-null?" =object) (&/V "Data" (&/T "java.lang.Boolean" (&/V "Nil" nil)))))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "jvm-null?" =object) (&/V "Data" (&/T "java.lang.Boolean" (&/V "Nil" nil)))))))))
(defn analyse-jvm-new [analyse ?class ?classes ?args]
(exec [=class (&host/full-class-name ?class)
- =classes (map-m &host/extract-jvm-param ?classes)
- =args (mapcat-m analyse ?args)]
- (return (|list (&/V "Expression" (&/T (&/V "jvm-new" (&/T =class =classes =args)) (&/V "Data" (&/T =class (&/V "Nil" nil)))))))))
+ =classes (&/map% &host/extract-jvm-param ?classes)
+ =args (&/flat-map% analyse ?args)]
+ (return (&/|list (&/V "Expression" (&/T (&/V "jvm-new" (&/T =class =classes =args)) (&/V "Data" (&/T =class (&/V "Nil" nil)))))))))
(defn analyse-jvm-new-array [analyse ?class ?length]
(exec [=class (&host/full-class-name ?class)]
- (return (|list (&/V "Expression" (&/T (&/V "jvm-new-array" (&/T =class ?length)) (&/V "array" (&/T (&/V "Data" (to-array [=class (&/V "Nil" nil)]))
+ (return (&/|list (&/V "Expression" (&/T (&/V "jvm-new-array" (&/T =class ?length)) (&/V "array" (&/T (&/V "Data" (to-array [=class (&/V "Nil" nil)]))
(&/V "Nil" nil)))))))))
(defn analyse-jvm-aastore [analyse ?array ?idx ?elem]
@@ -155,15 +152,15 @@
[[=array =elem]]
[=array =elem])]
=array-type (&&/expr-type =array)]
- (return (|list (&/V "Expression" (&/T (&/V "jvm-aastore" (&/T =array ?idx =elem)) =array-type))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "jvm-aastore" (&/T =array ?idx =elem)) =array-type))))))
(defn analyse-jvm-aaload [analyse ?array ?idx]
(exec [=array (&&/analyse-1 analyse ?array)
=array-type (&&/expr-type =array)]
- (return (|list (&/V "Expression" (&/T (&/V "jvm-aaload" (&/T =array ?idx)) =array-type))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "jvm-aaload" (&/T =array ?idx)) =array-type))))))
(defn analyse-jvm-class [analyse ?name ?super-class ?fields]
- (exec [?fields (map-m (fn [?field]
+ (exec [?fields (&/map% (fn [?field]
(matchv ::M/objects [?field]
[["Tuple" ["Cons" [["Ident" ?class] ["Cons" [["Ident" ?field-name] ["Nil" _]]]]]]]
(return [?class ?field-name])
@@ -175,11 +172,11 @@
[field {:access :public
:type class}]))]
$module &/get-module-name]
- (return (|list (&/V "Statement" (&/V "jvm-class" (&/T $module ?name ?super-class =fields {})))))))
+ (return (&/|list (&/V "Statement" (&/V "jvm-class" (&/T $module ?name ?super-class =fields {})))))))
(defn analyse-jvm-interface [analyse ?name ?members]
;; (prn 'analyse-jvm-interface ?name ?members)
- (exec [?members (map-m (fn [member]
+ (exec [?members (&/map% (fn [member]
;; (prn 'analyse-jvm-interface (&/show-ast member))
(matchv ::M/objects [member]
[["Form" ["Cons" [["Ident" ":"]
@@ -190,51 +187,51 @@
["Nil" _]]]]]]]]
["Nil" _]]]]]]]]]
(do ;; (prn 'analyse-jvm-interface ?member-name ?inputs ?output)
- (exec [?inputs (map-m extract-ident (&/->seq ?inputs))]
+ (exec [?inputs (&/map% extract-ident (->seq ?inputs))]
(return [?member-name [?inputs ?output]])))
[_]
(fail "[Analyser Error] Invalid method signature!")))
- (&/->seq ?members))
+ (->seq ?members))
:let [=methods (into {} (for [[method [inputs output]] ?members]
[method {:access :public
:type [inputs output]}]))]
$module &/get-module-name]
- (return (|list (&/V "Statement" (&/V "jvm-interface" (&/T $module ?name =methods)))))))
+ (return (&/|list (&/V "Statement" (&/V "jvm-interface" (&/T $module ?name =methods)))))))
(defn analyse-exec [analyse ?exprs]
- (exec [_ (assert! (count ?exprs) "\"exec\" expressions can't have empty bodies.")
- =exprs (flat-map% analyse ?exprs)
- =exprs-types (map% &&/expr-type =exprs)]
- (return (|list (&/V "Expression" (&/T (&/V "exec" =exprs) (|last =exprs-types)))))))
+ (exec [_ (&/assert! (count ?exprs) "\"exec\" expressions can't have empty bodies.")
+ =exprs (&/flat-map% analyse ?exprs)
+ =exprs-types (&/map% &&/expr-type =exprs)]
+ (return (&/|list (&/V "Expression" (&/T (&/V "exec" =exprs) (&/|head (&/|reverse =exprs-types))))))))
(defn analyse-jvm-try [analyse ?body [?catches ?finally]]
(exec [=body (&&/analyse-1 analyse ?body)
- =catches (map% (fn [[?ex-class ?ex-arg ?catch-body]]
+ =catches (&/map% (fn [[?ex-class ?ex-arg ?catch-body]]
(&&env/with-local ?ex-arg (&/V "Data" (&/T ?ex-class (&/V "Nil" nil)))
(exec [=catch-body (&&/analyse-1 analyse ?catch-body)]
(return [?ex-class ?ex-arg =catch-body]))))
?catches)
=finally (&&/analyse-1 analyse ?finally)
=body-type (&&/expr-type =body)]
- (return (|list (&/V "Expression" (&/T (&/V "jvm-try" (&/T =body =catches =finally)) =body-type))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "jvm-try" (&/T =body =catches =finally)) =body-type))))))
(defn analyse-jvm-throw [analyse ?ex]
(exec [=ex (&&/analyse-1 analyse ?ex)]
- (return (|list (&/V "Expression" (&/T (&/V "jvm-throw" =ex) (&/V "Nothing" nil)))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "jvm-throw" =ex) (&/V "Nothing" nil)))))))
(defn analyse-jvm-monitorenter [analyse ?monitor]
(exec [=monitor (&&/analyse-1 analyse ?monitor)]
- (return (|list (&/V "Expression" (&/T (&/V "jvm-monitorenter" =monitor) (&/V "Tuple" (&/V "Nil" nil))))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "jvm-monitorenter" =monitor) (&/V "Tuple" (&/V "Nil" nil))))))))
(defn analyse-jvm-monitorexit [analyse ?monitor]
(exec [=monitor (&&/analyse-1 analyse ?monitor)]
- (return (|list (&/V "Expression" (&/T (&/V "jvm-monitorexit" =monitor) (&/V "Tuple" (&/V "Nil" nil))))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "jvm-monitorexit" =monitor) (&/V "Tuple" (&/V "Nil" nil))))))))
(do-template [<name> <tag> <from-class> <to-class>]
(defn <name> [analyse ?value]
(exec [=value (&&/analyse-1 analyse ?value)]
- (return (|list (&/V "Expression" (&/T (&/V <tag> =value) (&/V "Data" (&/T <to-class> (&/V "Nil" nil)))))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V <tag> =value) (&/V "Data" (&/T <to-class> (&/V "Nil" nil)))))))))
analyse-jvm-d2f "jvm-d2f" "java.lang.Double" "java.lang.Float"
analyse-jvm-d2i "jvm-d2i" "java.lang.Double" "java.lang.Integer"
@@ -259,7 +256,7 @@
(do-template [<name> <tag> <from-class> <to-class>]
(defn <name> [analyse ?value]
(exec [=value (&&/analyse-1 analyse ?value)]
- (return (|list (&/V "Expression" (&/T (&/V <tag> =value) (&/V "Data" (&/T <to-class> (&/V "Nil" nil)))))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V <tag> =value) (&/V "Data" (&/T <to-class> (&/V "Nil" nil)))))))))
analyse-jvm-iand "jvm-iand" "java.lang.Integer" "java.lang.Integer"
analyse-jvm-ior "jvm-ior" "java.lang.Integer" "java.lang.Integer"
@@ -276,4 +273,4 @@
(defn analyse-jvm-program [analyse ?args ?body]
(exec [=body (&&env/with-local ?args (&/V "Any" nil)
(&&/analyse-1 analyse ?body))]
- (return (|list (&/V "Statement" (&/V "jvm-program" =body))))))
+ (return (&/|list (&/V "Statement" (&/V "jvm-program" =body))))))
diff --git a/src/lux/analyser/lambda.clj b/src/lux/analyser/lambda.clj
index 3b3d6d9a0..e70fd7bf6 100644
--- a/src/lux/analyser/lambda.clj
+++ b/src/lux/analyser/lambda.clj
@@ -1,8 +1,7 @@
(ns lux.analyser.lambda
- (:require [clojure.core.match :refer [match]]
- (lux [base :as & :refer [exec return fail
- try-all-m map-m mapcat-m reduce-m
- assert!]])
+ (:require [clojure.core.match :as M :refer [matchv]]
+ clojure.core.match.array
+ (lux [base :as & :refer [exec return fail]])
(lux.analyser [base :as &&]
[env :as &env])))
@@ -19,8 +18,8 @@
(defn close-over [scope ident register frame]
(matchv ::M/objects [register]
[["Expression" [_ register-type]]]
- (let [register* (&/V "Expression" (&/T (&/V "captured" (&/T scope (->> frame (get$ "closure") (get$ "counter")) register)) register-type))]
- [register* (update$ "closure" #(-> %
- (update$ "counter" inc)
- (update$ "mappings" #(|put ident register* %)))
- frame)])))
+ (let [register* (&/V "Expression" (&/T (&/V "captured" (&/T scope (->> frame (&/get$ "closure") (&/get$ "counter")) register)) register-type))]
+ [register* (&/update$ "closure" #(-> %
+ (&/update$ "counter" inc)
+ (&/update$ "mappings" (fn [mps] (&/|put ident register* mps))))
+ frame)])))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 5412bdade..c0124936e 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -2,11 +2,7 @@
(:require (clojure [template :refer [do-template]])
[clojure.core.match :as M :refer [matchv]]
clojure.core.match.array
- (lux [base :as & :refer [exec return return* fail fail*
- get$ set$ update$
- |list |get |contains? |concat
- if-m try-all-m |map% |flat-map% |fold% map-m mapcat-m reduce-m
- assert!]]
+ (lux [base :as & :refer [exec return return* fail fail*]]
[parser :as &parser]
[type :as &type]
[macro :as &macro]
@@ -19,20 +15,20 @@
;; [Resources]
(defn analyse-tuple [analyse ?elems]
- (exec [=elems (|flat-map% analyse ?elems)
- =elems-types (|map% &&/expr-type =elems)
+ (exec [=elems (&/flat-map% analyse ?elems)
+ =elems-types (&/map% &&/expr-type =elems)
;; :let [_ (prn 'analyse-tuple =elems)]
]
- (return (|list (&/V "Expression" (&/T (&/V "tuple" =elems) (&/V "Tuple" (&/|->list =elems-types))))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "tuple" =elems) (&/V "Tuple" =elems-types)))))))
(defn analyse-record [analyse ?elems]
- (exec [=elems (|map% (fn [kv]
+ (exec [=elems (&/map% (fn [kv]
(matchv ::M/objects [kv]
[[k v]]
(exec [=v (&&/analyse-1 analyse v)]
(return (to-array [k =v])))))
?elems)
- =elems-types (|map% (fn [kv]
+ =elems-types (&/map% (fn [kv]
(matchv ::M/objects [kv]
[[k v]]
(exec [=v (&&/expr-type v)]
@@ -40,42 +36,42 @@
=elems)
;; :let [_ (prn 'analyse-tuple =elems)]
]
- (return (|list (&/V "Expression" (&/T (&/V "record" =elems) (&/V "Record" (&/|->list =elems-types))))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "record" =elems) (&/V "Record" =elems-types)))))))
(defn analyse-ident [analyse ident]
(exec [module-name &/get-module-name]
(fn [state]
- (let [[top & stack*] (get$ "local-envs" state)]
- (if-let [=bound (or (->> top (get$ "locals") (get$ "mappings") (|get ident))
- (->> top (get$ "closure") (get$ "mappings") (|get ident)))]
- (return* state (|list =bound))
- (let [no-binding? #(and (->> % (get$ "locals") (get$ "mappings") (|contains? ident) not)
- (->> % (get$ "closure") (get$ "mappings") (|contains? ident) not))
+ (let [[top & stack*] (&/get$ "local-envs" state)]
+ (if-let [=bound (or (->> top (&/get$ "locals") (&/get$ "mappings") (&/|get ident))
+ (->> top (&/get$ "closure") (&/get$ "mappings") (&/|get ident)))]
+ (return* state (&/|list =bound))
+ (let [no-binding? #(and (->> % (&/get$ "locals") (&/get$ "mappings") (&/|contains? ident) not)
+ (->> % (&/get$ "closure") (&/get$ "mappings") (&/|contains? ident) not))
[inner outer] (split-with no-binding? stack*)]
(if (empty? outer)
- (if-let [global (->> state (get$ "global-env") (|get ident))]
- (return* state (|list global))
+ (if-let [global (->> state (&/get$ "global-env") (&/|get ident))]
+ (return* state (&/|list global))
(fail* (str "[Analyser Error] Unresolved identifier: " ident)))
(let [in-stack (cons top inner)
- scopes (rest (reductions #(cons (get$ "name" %2) %1) (map #(get$ "name" %) outer) (reverse in-stack)))
- _ (prn 'in-stack module-name ident (map #(get$ "name" %) in-stack) scopes)
+ scopes (rest (reductions #(cons (&/get$ "name" %2) %1) (map #(&/get$ "name" %) outer) (reverse in-stack)))
+ _ (prn 'in-stack module-name ident (map #(&/get$ "name" %) in-stack) scopes)
[=local inner*] (reduce (fn [[register new-inner] [frame in-scope]]
(let [[register* frame*] (&&lambda/close-over (cons module-name (reverse in-scope)) ident register frame)]
[register* (cons frame* new-inner)]))
- [(or (->> outer |head (get$ "locals") (get$ "mappings") (|get ident))
- (->> outer |head (get$ "closure") (get$ "mappings") (|get ident)))
+ [(or (->> outer &/|head (&/get$ "locals") (&/get$ "mappings") (&/|get ident))
+ (->> outer &/|head (&/get$ "closure") (&/get$ "mappings") (&/|get ident)))
'()]
(map vector (reverse in-stack) scopes)
)]
- (return* (set$ "local-envs" (|concat inner* outer) state) (|list =local)))
+ (return* (&/set$ "local-envs" (&/|concat inner* outer) state) (&/|list =local)))
))
))
)))
(defn ^:private analyse-apply* [analyse =fn ?args]
- (exec [=args (|flat-map% analyse ?args)
+ (exec [=args (&/flat-map% analyse ?args)
=fn-type (&&/expr-type =fn)
- =apply+=apply-type (fold% (fn [[=fn =fn-type] =input]
+ =apply+=apply-type (&/fold (fn [[=fn =fn-type] =input]
(exec [=input-type (&&/expr-type =input)
=output-type (&type/apply-lambda =fn-type =input-type)]
(return [(&/V "apply" (&/T =fn =input)) =output-type])))
@@ -84,7 +80,7 @@
:let [[=apply =apply-type] (matchv ::M/objects [=apply+=apply-type]
[[=apply =apply-type]]
[=apply =apply-type])]]
- (return (|list (&/V "Expression" (&/T =apply =apply-type))))))
+ (return (&/|list (&/V "Expression" (&/T =apply =apply-type))))))
(defn analyse-apply [analyse =fn ?args]
(exec [loader &/loader]
@@ -95,8 +91,9 @@
(exec [macro? (&&def/macro? ?module ?name)]
(if macro?
(let [macro-class (&host/location (list ?module ?name))]
- (exec [macro-expansion (&macro/expand loader macro-class ?args)]
- (return (&/->seq (|flat-map% analyse macro-expansion)))))
+ (exec [macro-expansion (&macro/expand loader macro-class ?args)
+ output (&/flat-map% analyse macro-expansion)]
+ (return output)))
(analyse-apply* analyse =fn ?args)))
[_]
@@ -109,8 +106,8 @@
(defn analyse-case [analyse ?value ?branches]
;; (prn 'analyse-case ?value ?branches)
(exec [:let [num-branches (count ?branches)]
- _ (assert! (and (> num-branches 0) (even? num-branches))
- "[Analyser Error] Unbalanced branches in \"case'\" expression.")
+ _ (&/assert! (and (> num-branches 0) (even? num-branches))
+ "[Analyser Error] Unbalanced branches in \"case'\" expression.")
:let [branches (partition 2 ?branches)
locals-per-branch (map (comp &&case/locals first) branches)
max-locals (reduce max 0 (map count locals-per-branch))]
@@ -119,14 +116,14 @@
;; :let [_ (prn 'base-register base-register)]
=value (&&/analyse-1 analyse ?value)
;; :let [_ (prn '=value =value)]
- =bodies (map-m (partial &&case/analyse-branch analyse max-locals)
- (map vector locals-per-branch (map second branches)))
+ =bodies (&/map% (partial &&case/analyse-branch analyse max-locals)
+ (map vector locals-per-branch (map second branches)))
;; :let [_ (prn '=bodies =bodies)]
;; :let [_ (prn 'analyse-case/=bodies =bodies)]
- =body-types (map-m &&/expr-type =bodies)
- =case-type (reduce-m &type/merge (&/V "Nothing" nil) =body-types)
+ =body-types (&/map% &&/expr-type =bodies)
+ :let [=case-type (&/fold &type/merge (&/|table) =body-types)]
:let [=branches (map vector (map first branches) =bodies)]]
- (return (|list (&/V "Expression" (&/T (&/V "case" (&/T =value base-register max-locals =branches)) =case-type))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "case" (&/T =value base-register max-locals =branches)) =case-type))))))
(defn analyse-lambda [analyse ?self ?arg ?body]
(exec [=lambda-type* &type/fresh-lambda]
@@ -139,13 +136,13 @@
=lambda-type (exec [_ (&type/solve =return =body-type)
=lambda-type** (&type/clean =return =lambda-type*)]
(&type/clean =arg =lambda-type**))]
- (return (|list (&/V "Expression" (&/T (&/V "lambda" (&/T =scope =captured ?arg =body)) =lambda-type))))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "lambda" (&/T =scope =captured ?arg =body)) =lambda-type))))))))
(defn analyse-get [analyse ?slot ?record]
(exec [=record (&&/analyse-1 analyse ?record)
=record-type (&&/expr-type =record)
=slot-type (&type/slot-type =record-type ?slot)]
- (return (|list (&/V "Expression" (&/T (&/V "get" (?slot =record)) =slot-type))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "get" (?slot =record)) =slot-type))))))
(defn analyse-set [analyse ?slot ?value ?record]
(exec [=value (&&/analyse-1 analyse ?value)
@@ -153,26 +150,26 @@
=record-type (&&/expr-type =record)
=slot-type (&type/slot-type =record-type ?slot)
_ (&type/solve =slot-type =value)]
- (return (|list (&/V "Expression" (&/T (&/V "set" (&/T ?slot =value =record)) =slot-type))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "set" (&/T ?slot =value =record)) =slot-type))))))
(defn analyse-def [analyse ?name ?value]
;; (prn 'analyse-def ?name ?value)
(exec [module-name &/get-module-name]
- (if-m (&&def/defined? module-name ?name)
- (fail (str "[Analyser Error] Can't redefine " ?name))
- (exec [=value (&&/analyse-1 analyse ?value)
- =value-type (&&/expr-type =value)
- _ (&&def/define module-name ?name =value-type)]
- (return (|list (&/V "Statement" (&/V "def" (&/T ?name =value)))))))))
+ (&/if% (&&def/defined? module-name ?name)
+ (fail (str "[Analyser Error] Can't redefine " ?name))
+ (exec [=value (&&/analyse-1 analyse ?value)
+ =value-type (&&/expr-type =value)
+ _ (&&def/define module-name ?name =value-type)]
+ (return (&/|list (&/V "Statement" (&/V "def" (&/T ?name =value)))))))))
(defn analyse-declare-macro [?ident]
(exec [module-name &/get-module-name
_ (&&def/declare-macro module-name ?ident)]
- (return (|list))))
+ (return (&/|list))))
(defn analyse-import [analyse ?path]
(assert false)
- (return (|list)))
+ (return (&/|list)))
(defn analyse-check [analyse eval! ?type ?value]
(exec [=type (&&/analyse-1 analyse ?type)
diff --git a/src/lux/base.clj b/src/lux/base.clj
index d0b349eeb..0706a563b 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -45,6 +45,64 @@
(defn return* [state value]
(V "Right" (T state value)))
+(defmacro |list [& elems]
+ (reduce (fn [tail head]
+ `(V "Cons" (T ~head ~tail)))
+ `(V "Nil" nil)
+ elems))
+
+(defmacro |table [& elems]
+ (reduce (fn [table [k v]]
+ `(|put ~k ~v ~table))
+ `(|list)
+ (partition 2 elems)))
+
+(defn |get [slot table]
+ (matchv ::M/objects [table]
+ [["Nil" _]]
+ (V "Left" (str "Not found: " slot))
+
+ [["Cons" [[k v] table*]]]
+ (if (= k slot)
+ (V "Right" v)
+ (|get slot table*))))
+
+(defn |put [slot value table]
+ (matchv ::M/objects [table]
+ [["Nil" _]]
+ (V "Cons" (T (T slot value) (V "Nil" nil)))
+
+ [["Cons" [[k v] table*]]]
+ (if (= k slot)
+ (V "Cons" (T (T slot value) table*))
+ (V "Cons" (T (T k v) (|put slot value table*))))))
+
+(defn |merge [table1 table2]
+ (matchv ::M/objects [table2]
+ [["Nil" _]]
+ table1
+
+ [["Cons" [[k v] table2*]]]
+ (|merge (|put k v table1) table2*)))
+
+(defn |update [k f table]
+ (matchv ::M/objects [table]
+ [["Nil" _]]
+ table
+
+ [["Cons" [[k* v] table*]]]
+ (if (= k k*)
+ (V "Cons" (T (T k (f v)) table*))
+ (|update k f table*))))
+
+(defn |head [xs]
+ (matchv ::M/objects [xs]
+ [["Nil" _]]
+ (assert false)
+
+ [["Cons" [x _]]]
+ x))
+
;; [Resources/Monads]
(defn fail [message]
(fn [_]
@@ -88,6 +146,14 @@
(defn |cons [head tail]
(V "Cons" (T head tail)))
+(defn |concat [xs ys]
+ (matchv ::M/objects [xs]
+ [["Nil" _]]
+ ys
+
+ [["Cons" [x xs*]]]
+ (V "Cons" (T x (|concat xs* ys)))))
+
(defn |map [f xs]
(matchv ::M/objects [xs]
[["Nil" _]]
@@ -96,6 +162,23 @@
[["Cons" [x xs*]]]
(V "Cons" (T (f x) (|map f xs*)))))
+(defn flat-map [f xs]
+ (matchv ::M/objects [xs]
+ [["Nil" _]]
+ xs
+
+ [["Cons" [x xs*]]]
+ (|concat (f x) (flat-map f xs*))))
+
+(defn |contains? [k table]
+ (matchv ::M/objects [table]
+ [["Nil" _]]
+ false
+
+ [["Cons" [[k* _] table*]]]
+ (or (= k k*)
+ (|contains? k table*))))
+
(defn fold [f init xs]
(matchv ::M/objects [xs]
[["Nil" _]]
@@ -157,29 +240,19 @@
map% cons%
flat-map% ++%))
-(defn fold% [f init xs]
+(defn |as-pairs [xs]
(matchv ::M/objects [xs]
- [["Nil" _]]
- init
-
- [["Cons" [x xs*]]]
- (fold% f (f init x) xs*)))
+ [["Cons" [x [["Cons" [y xs*]]]]]]
+ (V "Cons" (T (T x y) (|as-pairs xs*)))
-(defn |get [record slot]
- (matchv ::M/objects [record]
- [["Nil" _]]
- (V "Left" (str "Not found: " slot))
-
- [["Cons" [[k v] record*]]]
- (if (= k slot)
- (V "Right" v)
- (|get record* slot))))
+ [_]
+ (V "Nil" nil)))
-(defmacro |list [& elems]
- (reduce (fn [tail head]
- `(V "Cons" (T ~head ~tail)))
- `(V "Nil" nil)
- elems))
+(defn |reverse [xs]
+ (fold (fn [tail head]
+ (|cons head tail))
+ (|list)
+ xs))
(defn if% [text-m then-m else-m]
(exec [? text-m]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 46cddc9b0..fd60537e5 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -5,11 +5,7 @@
[template :refer [do-template]])
[clojure.core.match :as M :refer [matchv]]
clojure.core.match.array
- (lux [base :as & :refer [exec return* return fail fail* assert!
- repeat% exhaust% try% try-all% map% flat-map% fold% sequence%
- apply%
- normalize-ident
- |get |list]]
+ (lux [base :as & :refer [exec return* return fail fail*]]
[type :as &type]
[lexer :as &lexer]
[parser :as &parser]
@@ -23,7 +19,8 @@
[host :as &&host]
[case :as &&case]
[lambda :as &&lambda])
- :reload)
+ ;; :reload
+ )
(:import (org.objectweb.asm Opcodes
Label
ClassWriter
@@ -320,7 +317,7 @@
;; (prn 'compile-statement syntax)
(matchv ::M/objects [syntax]
[["Statement" ?form]]
- (matchv ::M/objects ?form
+ (matchv ::M/objects [?form]
[["def" ?name ?body]]
(&&lux/compile-def compile-expression ?name ?body)
@@ -364,19 +361,19 @@
(let [compiler-step (exec [analysis+ (&optimizer/optimize eval!)
;; :let [_ (prn 'analysis+ analysis+)]
]
- (flat-map% compile-statement analysis+))]
+ (&/flat-map% compile-statement analysis+))]
(defn ^:private compile-module [name]
(fn [state]
- (if (->> state (get$ "modules") (|contains? name))
+ (if (->> state (&/get$ "modules") (&/|contains? name))
(fail "[Compiler Error] Can't redefine a module!")
(let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
(&host/->class name) nil "java/lang/Object" nil))]
- (matchv ::M/objects [(&/run-state (exhaust% compiler-step) (-> state
- (set$ "source" (slurp (str "source/" name ".lux")))
- (set$ "global-env" (&/env name))
- (set$ "writer" =class)
- (update$ "modules" #(|put name &a-def/init-module %))))]
+ (matchv ::M/objects [(&/run-state (&/exhaust% compiler-step) (-> state
+ (&/set$ "source" (slurp (str "source/" name ".lux")))
+ (&/set$ "global-env" (&/env name))
+ (&/set$ "writer" =class)
+ (&/update$ "modules" #(&/|put name &a-def/init-module %))))]
[["Right" [?state ?vals]]]
(do (.visitEnd =class)
;; (prn 'compile-module/?vals ?vals)
@@ -388,7 +385,7 @@
;; [Resources]
(defn compile-all [modules]
(.mkdir (java.io.File. "output"))
- (matchv ::M/objects [(&/run-state (map% compile-module modules) (&/init-state))]
+ (matchv ::M/objects [(&/run-state (&/map% compile-module modules) (&/init-state))]
[["Right" [?state _]]]
(println (str "Compilation complete! " (pr-str modules)))
diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj
index 683696537..f09008ca8 100644
--- a/src/lux/compiler/base.clj
+++ b/src/lux/compiler/base.clj
@@ -1,10 +1,8 @@
(ns lux.compiler.base
(:require [clojure.string :as string]
- [clojure.core.match :refer [match]]
- (lux [base :as & :refer [exec return* return fail fail*
- repeat-m exhaust-m try-m try-all-m map-m reduce-m
- apply-m
- normalize-ident]])
+ [clojure.core.match :as M :refer [matchv]]
+ clojure.core.match.array
+ (lux [base :as & :refer [exec return* return fail fail*]])
[lux.analyser.base :as &a])
(:import (org.objectweb.asm Opcodes
Label
@@ -36,91 +34,91 @@
(defn total-locals [expr]
(matchv ::M/objects [expr]
[["case" [?variant ?base-register ?num-registers ?branches]]]
- (+ ?num-registers (fold max 0 (|map (comp total-locals second) ?branches)))
+ (+ ?num-registers (&/fold max 0 (&/|map (comp total-locals second) ?branches)))
[["tuple" ?members]]
- (fold max 0 (|map total-locals ?members))
+ (&/fold max 0 (&/|map total-locals ?members))
[["variant" ?tag ?value]]
(total-locals ?value)
[["call" [?fn ?args]]]
- (fold max 0 (|map total-locals (|cons ?fn ?args)))
+ (&/fold max 0 (&/|map total-locals (&/|cons ?fn ?args)))
[["jvm-iadd" [?x ?y]]]
- (fold max 0 (|map total-locals (|list ?x ?y)))
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
[["jvm-isub" [?x ?y]]]
- (fold max 0 (|map total-locals (|list ?x ?y)))
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
[["jvm-imul" [?x ?y]]]
- (fold max 0 (|map total-locals (|list ?x ?y)))
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
[["jvm-idiv" [?x ?y]]]
- (fold max 0 (|map total-locals (|list ?x ?y)))
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
[["jvm-irem" [?x ?y]]]
- (fold max 0 (|map total-locals (|list ?x ?y)))
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
[["jvm-ladd" [?x ?y]]]
- (fold max 0 (|map total-locals (|list ?x ?y)))
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
[["jvm-lsub" [?x ?y]]]
- (fold max 0 (|map total-locals (|list ?x ?y)))
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
[["jvm-lmul" [?x ?y]]]
- (fold max 0 (|map total-locals (|list ?x ?y)))
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
[["jvm-ldiv" [?x ?y]]]
- (fold max 0 (|map total-locals (|list ?x ?y)))
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
[["jvm-lrem" [?x ?y]]]
- (fold max 0 (|map total-locals (|list ?x ?y)))
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
[["jvm-fadd" [?x ?y]]]
- (fold max 0 (|map total-locals (|list ?x ?y)))
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
[["jvm-fsub" [?x ?y]]]
- (fold max 0 (|map total-locals (|list ?x ?y)))
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
[["jvm-fmul" [?x ?y]]]
- (fold max 0 (|map total-locals (|list ?x ?y)))
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
[["jvm-fdiv" [?x ?y]]]
- (fold max 0 (|map total-locals (|list ?x ?y)))
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
[["jvm-frem" [?x ?y]]]
- (fold max 0 (|map total-locals (|list ?x ?y)))
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
[["jvm-dadd" [?x ?y]]]
- (fold max 0 (|map total-locals (|list ?x ?y)))
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
[["jvm-dsub" [?x ?y]]]
- (fold max 0 (|map total-locals (|list ?x ?y)))
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
[["jvm-dmul" [?x ?y]]]
- (fold max 0 (|map total-locals (|list ?x ?y)))
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
[["jvm-ddiv" [?x ?y]]]
- (fold max 0 (|map total-locals (|list ?x ?y)))
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
[["jvm-drem" [?x ?y]]]
- (fold max 0 (|map total-locals (|list ?x ?y)))
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
[["exec" ?exprs]]
- (fold max 0 (|map total-locals ?exprs))
+ (&/fold max 0 (&/|map total-locals ?exprs))
[["jvm-new" [?class ?classes ?args]]]
- (fold max 0 (|map total-locals ?args))
+ (&/fold max 0 (&/|map total-locals ?args))
[["jvm-invokestatic" [?class ?method ?classes ?args]]]
- (fold max 0 (|map total-locals ?args))
+ (&/fold max 0 (&/|map total-locals ?args))
[["jvm-invokevirtual" [?class ?method ?classes ?object ?args]]]
- (fold max 0 (|map total-locals ?args))
+ (&/fold max 0 (&/|map total-locals ?args))
[["jvm-aastore" [?array ?idx ?elem]]]
- (fold max 0 (|map total-locals (|list ?array ?elem)))
+ (&/fold max 0 (&/|map total-locals (&/|list ?array ?elem)))
[["jvm-aaload" [?array ?idx]]]
(total-locals ?array)
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index 8d9c129c5..6f9fd998a 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -3,10 +3,7 @@
[template :refer [do-template]])
[clojure.core.match :as M :refer [match matchv]]
clojure.core.match.array
- (lux [base :as & :refer [exec return* return fail fail*
- repeat-m exhaust-m try-m try-all-m map-m reduce-m
- apply-m
- normalize-ident]]
+ (lux [base :as & :refer [exec return* return fail fail*]]
[type :as &type]
[lexer :as &lexer]
[parser :as &parser]
@@ -40,11 +37,11 @@
[register (&/V "Pattern" (&/T $body [&/V "TextMatch" ?value]))]
[["Tuple" ?members]]
- (let [[register* =members] (reduce (fn [[register =members] member]
+ (let [[register* =members] (&/fold (fn [[register =members] member]
(let [[register* =member] (->match $body register member)]
[register* (cons =member =members)]))
[register (list)]
- (&/->seq ?members))]
+ ?members)]
[register* (&/V "Pattern" (&/T $body [&/V "TupleMatch" (reverse =members)]))])
[["Tag" ?tag]]
@@ -182,7 +179,7 @@
(.visitInsn Opcodes/DUP)
(.visitMethodInsn Opcodes/INVOKESPECIAL ex-class "<init>" "()V")
(.visitInsn Opcodes/ATHROW))
- (map-m (fn [[?label ?body]]
+ (&/map% (fn [[?label ?body]]
(exec [:let [_ (.visitLabel writer ?label)]
ret (compile ?body)
:let [_ (.visitJumpInsn writer Opcodes/GOTO $end)]]
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 5d2b06d76..08a00b536 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -4,10 +4,7 @@
[template :refer [do-template]])
[clojure.core.match :as M :refer [match matchv]]
clojure.core.match.array
- (lux [base :as & :refer [exec return* return fail fail*
- repeat-m exhaust-m try-m try-all-m map-m reduce-m
- apply-m
- normalize-ident]]
+ (lux [base :as & :refer [exec return* return fail fail*]]
[type :as &type]
[lexer :as &lexer]
[parser :as &parser]
@@ -173,7 +170,7 @@
(defn compile-jvm-invokestatic [compile *type* ?class ?method ?classes ?args]
(exec [*writer* &/get-writer
:let [method-sig (str "(" (reduce str "" (map &host/->type-signature ?classes)) ")" (&host/->java-sig *type*))]
- _ (map-m (fn [[class-name arg]]
+ _ (&/map% (fn [[class-name arg]]
(exec [ret (compile arg)
:let [_ (prepare-arg! *writer* class-name)]]
(return ret)))
@@ -190,7 +187,7 @@
:let [method-sig (str "(" (reduce str "" (map &host/->type-signature ?classes)) ")" (&host/->java-sig *type*))]
_ (compile ?object)
:let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST (&host/->class ?class))]
- _ (map-m (fn [[class-name arg]]
+ _ (&/map% (fn [[class-name arg]]
(exec [ret (compile arg)
:let [_ (prepare-arg! *writer* class-name)]]
(return ret)))
@@ -231,7 +228,7 @@
_ (doto *writer*
(.visitTypeInsn Opcodes/NEW class*)
(.visitInsn Opcodes/DUP))]
- _ (map-m (fn [[class-name arg]]
+ _ (&/map% (fn [[class-name arg]]
(exec [ret (compile arg)
:let [_ (prepare-arg! *writer* class-name)]]
(return ret)))
@@ -328,7 +325,7 @@
(defn compile-exec [compile *type* ?exprs]
(exec [*writer* &/get-writer
- _ (map-m (fn [expr]
+ _ (&/map% (fn [expr]
(exec [ret (compile expr)
:let [_ (.visitInsn *writer* Opcodes/POP)]]
(return ret)))
@@ -356,7 +353,7 @@
_ (compile ?body)
:let [_ (.visitLabel *writer* $to)]
_ compile-finally
- handlers (map-m (fn [[?ex-class ?ex-arg ?catch-body]]
+ handlers (&/map% (fn [[?ex-class ?ex-arg ?catch-body]]
(exec [:let [$handler-start (new Label)
$handler-end (new Label)]
_ (compile ?catch-body)
diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj
index 1ebfb1568..45a75337c 100644
--- a/src/lux/compiler/lambda.clj
+++ b/src/lux/compiler/lambda.clj
@@ -2,10 +2,9 @@
(:require (clojure [string :as string]
[set :as set]
[template :refer [do-template]])
- [clojure.core.match :refer [match]]
- (lux [base :as & :refer [exec return* return fail fail*
- repeat-m exhaust-m try-m try-all-m map-m reduce-m
- normalize-ident]]
+ [clojure.core.match :as M :refer [matchv]]
+ clojure.core.match.array
+ (lux [base :as & :refer [exec return* return fail fail*]]
[type :as &type]
[lexer :as &lexer]
[parser :as &parser]
@@ -87,7 +86,7 @@
[["Expression" [["captured" [_ ?cid1 _]] _]]
["Expression" [["captured" [_ ?cid2 _]] _]]]
(< ?cid1 ?cid2)))
- (map-m (fn [[?name ?captured]]
+ (&/map% (fn [[?name ?captured]]
(matchv ::M/objects [?captured]
[["Expression" [["captured" [_ _ ?source]] _]]]
(compile ?source)))))
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 0aff48750..9ce0da213 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -2,11 +2,9 @@
(:require (clojure [string :as string]
[set :as set]
[template :refer [do-template]])
- [clojure.core.match :refer [match]]
- (lux [base :as & :refer [exec return* return fail fail*
- repeat-m exhaust-m try-m try-all-m map-m reduce-m
- apply-m
- normalize-ident]]
+ [clojure.core.match :as M :refer [matchv]]
+ clojure.core.match.array
+ (lux [base :as & :refer [exec return* return fail fail*]]
[type :as &type]
[lexer :as &lexer]
[parser :as &parser]
@@ -56,14 +54,14 @@
_ (doto *writer*
(.visitLdcInsn (int num-elems))
(.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))]
- _ (map-m (fn [[idx elem]]
- (exec [:let [_ (doto *writer*
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int idx)))]
- ret (compile elem)
- :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
- (return ret)))
- (map vector (range num-elems) ?elems))]
+ _ (&/map% (fn [[idx elem]]
+ (exec [:let [_ (doto *writer*
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int idx)))]
+ ret (compile elem)
+ :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
+ (return ret)))
+ (map vector (range num-elems) ?elems))]
(return nil)))
(defn compile-record [compile *type* ?elems]
@@ -72,20 +70,20 @@
_ (doto *writer*
(.visitLdcInsn (int (* 2 num-elems)))
(.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))]
- _ (map-m (fn [[idx [k v]]]
- (exec [:let [idx* (* 2 idx)
- _ (doto *writer*
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int idx*))
- (.visitLdcInsn k)
- (.visitInsn Opcodes/AASTORE))]
- :let [_ (doto *writer*
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int (inc idx*))))]
- ret (compile v)
- :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
- (return ret)))
- (map vector (range num-elems) ?elems))]
+ _ (&/map% (fn [[idx [k v]]]
+ (exec [:let [idx* (* 2 idx)
+ _ (doto *writer*
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int idx*))
+ (.visitLdcInsn k)
+ (.visitInsn Opcodes/AASTORE))]
+ :let [_ (doto *writer*
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int (inc idx*))))]
+ ret (compile v)
+ :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
+ (return ret)))
+ (map vector (range num-elems) ?elems))]
(return nil)))
(defn compile-variant [compile *type* ?tag ?value]
@@ -127,11 +125,11 @@
(defn compile-call [compile *type* ?fn ?args]
(exec [*writer* &/get-writer
_ (compile ?fn)
- _ (map-m (fn [arg]
- (exec [ret (compile arg)
- :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE (&host/->class &host/function-class) "apply" &&/apply-signature)]]
- (return ret)))
- ?args)]
+ _ (&/map% (fn [arg]
+ (exec [ret (compile arg)
+ :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE (&host/->class &host/function-class) "apply" &&/apply-signature)]]
+ (return ret)))
+ ?args)]
(return nil)))
(defn compile-get [compile *type* ?slot ?record]
@@ -232,7 +230,7 @@
module-name &/get-module-name
:let [outer-class (&host/->class module-name)
datum-sig (&host/->type-signature "java.lang.Object")
- current-class (&host/location (list outer-class ?name))
+ current-class (&host/location (&/|list outer-class ?name))
_ (.visitInnerClass *writer* current-class outer-class nil (+ Opcodes/ACC_STATIC Opcodes/ACC_SYNTHETIC))
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 767b331e7..0becee945 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -3,9 +3,7 @@
[template :refer [do-template]])
[clojure.core.match :as M :refer [match matchv]]
clojure.core.match.array
- (lux [base :as & :refer [exec return* return fail fail*
- repeat-m try-all-m map-m mapcat-m reduce-m
- normalize-ident]]
+ (lux [base :as & :refer [exec return* return fail fail*]]
[parser :as &parser]
[type :as &type])))
@@ -32,7 +30,7 @@
)))
(defn ^:private method->type [method]
- (exec [=args (map-m class->type (seq (.getParameterTypes method)))
+ (exec [=args (&/map% class->type (seq (.getParameterTypes method)))
=return (class->type (.getReturnType method))]
(return [=args =return])))
@@ -143,4 +141,4 @@
)
(defn location [scope]
- (->> scope (map normalize-ident) (interpose "$") (reduce str "")))
+ (->> scope (&/|map &/normalize-ident) (&/|interpose "$") (&/fold str "")))
diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj
index f3f65d2b5..1c506950c 100644
--- a/src/lux/lexer.clj
+++ b/src/lux/lexer.clj
@@ -1,26 +1,24 @@
(ns lux.lexer
(:require [clojure.template :refer [do-template]]
- [lux.base :as & :refer [exec return* return fail fail*
- |list
- try-all%]]))
+ [lux.base :as & :refer [exec return* return fail fail*]]))
;; [Utils]
(defn ^:private lex-regex [regex]
(fn [state]
- (if-let [[match] (re-find regex (get$ "source" state))]
- (return* (update$ "source" #(.substring % (.length match)) state) match)
+ (if-let [[match] (re-find regex (&/get$ "source" state))]
+ (return* (&/update$ "source" #(.substring % (.length match)) state) match)
(fail* (str "[Lexer Error] Pattern failed: " regex)))))
(defn ^:private lex-regex2 [regex]
(fn [state]
- (if-let [[match tok1 tok2] (re-find regex (get$ "source" state))]
- (return* (update$ "source" #(.substring % (.length match)) state) [tok1 tok2])
+ (if-let [[match tok1 tok2] (re-find regex (&/get$ "source" state))]
+ (return* (&/update$ "source" #(.substring % (.length match)) state) [tok1 tok2])
(fail* (str "[Lexer Error] Pattern failed: " regex)))))
(defn ^:private lex-prefix [prefix]
(fn [state]
- (if (.startsWith (get$ "source" state) prefix)
- (return* (update$ "source" #(.substring % (.length prefix)) state) prefix)
+ (if (.startsWith (&/get$ "source" state) prefix)
+ (return* (&/update$ "source" #(.substring % (.length prefix)) state) prefix)
(fail* (str "[Lexer Error] Text failed: " prefix)))))
(defn ^:private escape-char [escaped]
@@ -36,7 +34,7 @@
(fail (str "[Lexer Error] Unknown escape character: " escaped))))
(def ^:private lex-text-body
- (try-all% (|list (exec [[prefix escaped] (lex-regex2 #"(?s)^([^\"\\]*)(\\.)")
+ (&/try-all% (&/|list (exec [[prefix escaped] (lex-regex2 #"(?s)^([^\"\\]*)(\\.)")
unescaped (escape-char escaped)
postfix lex-text-body]
(return (str prefix unescaped postfix)))
@@ -47,32 +45,32 @@
;; [Lexers]
(def ^:private lex-white-space
(exec [white-space (lex-regex #"^(\s+)")]
- (return (V "White_Space" white-space))))
+ (return (&/V "White_Space" white-space))))
(def ^:private lex-single-line-comment
(exec [_ (lex-prefix "##")
comment (lex-regex #"^([^\n]*)")
_ (lex-regex #"^(\n?)")]
- (return (V "Comment" comment))))
+ (return (&/V "Comment" comment))))
(def ^:private lex-multi-line-comment
(exec [_ (lex-prefix "#(")
- comment (try-all% (|list (lex-regex #"(?is)^((?!#\().)*?(?=\)#)")
+ comment (&/try-all% (&/|list (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 (V "Comment" comment))))
+ (return (&/V "Comment" comment))))
(def ^:private lex-comment
- (try-all% (|list lex-single-line-comment
+ (&/try-all% (&/|list lex-single-line-comment
lex-multi-line-comment)))
(do-template [<name> <tag> <regex>]
(def <name>
(exec [token (lex-regex <regex>)]
- (return (V <tag> token))))
+ (return (&/V <tag> token))))
^:private lex-bool "Bool" #"^(true|false)"
^:private lex-real "Real" #"^-?(0|[1-9][0-9]*)\.[0-9]+"
@@ -81,27 +79,27 @@
(def ^:private lex-char
(exec [_ (lex-prefix "#\"")
- token (try-all% (|list (exec [escaped (lex-regex #"^(\\.)")]
+ token (&/try-all% (&/|list (exec [escaped (lex-regex #"^(\\.)")]
(escape-char escaped))
(lex-regex #"^(.)")))
_ (lex-prefix "\"")]
- (return (V "Char" token))))
+ (return (&/V "Char" token))))
(def ^:private lex-text
(exec [_ (lex-prefix "\"")
token lex-text-body
_ (lex-prefix "\"")]
- (return (V "Text" token))))
+ (return (&/V "Text" token))))
(def ^:private lex-tag
(exec [_ (lex-prefix "#")
token (lex-regex +ident-re+)]
- (return (V "Tag" token))))
+ (return (&/V "Tag" token))))
(do-template [<name> <text> <tag>]
(def <name>
(exec [_ (lex-prefix <text>)]
- (return (V <tag> nil))))
+ (return (&/V <tag> nil))))
^:private lex-open-paren "(" "Open_Paren"
^:private lex-close-paren ")" "Close_Paren"
@@ -112,7 +110,7 @@
)
(def ^:private lex-delimiter
- (try-all% (|list lex-open-paren
+ (&/try-all% (&/|list lex-open-paren
lex-close-paren
lex-open-bracket
lex-close-bracket
@@ -121,7 +119,7 @@
;; [Exports]
(def lex
- (try-all% (|list lex-white-space
+ (&/try-all% (&/|list lex-white-space
lex-comment
lex-bool
lex-real
diff --git a/src/lux/parser.clj b/src/lux/parser.clj
index b2af943a5..49a636bd6 100644
--- a/src/lux/parser.clj
+++ b/src/lux/parser.clj
@@ -2,17 +2,17 @@
(:require [clojure.template :refer [do-template]]
[clojure.core.match :as M :refer [matchv]]
clojure.core.match.array
- (lux [base :as & :refer [exec return fail repeat-m]]
+ (lux [base :as & :refer [exec return fail]]
[lexer :as &lexer])))
;; [Utils]
(do-template [<name> <close-tag> <description> <tag>]
(defn <name> [parse]
- (exec [elems (repeat% parse)
+ (exec [elems (&/repeat% parse)
token &lexer/lex]
(matchv ::M/objects [token]
[[<close-token> _]]
- (return (|list (&/V <tag> (|concat elems))))
+ (return (&/|list (&/V <tag> (&/|concat elems))))
[_]
(fail (str "[Parser Error] Unbalanced " <description> ".")))))
@@ -21,16 +21,16 @@
)
(defn ^:private parse-record [parse]
- (exec [elems* (repeat% parse)
+ (exec [elems* (&/repeat% parse)
token &lexer/lex
- :let [elems (|concat elems*)]]
+ :let [elems (&/|concat elems*)]]
(matchv ::M/objects [token]
[["Close_Brace" _]]
(fail (str "[Parser Error] Unbalanced braces."))
[_]
- (if (even? (|length elems))
- (return (|list (&/V "Record" (|as-pairs elems))))
+ (if (even? (&/|length elems))
+ (return (&/|list (&/V "Record" (&/|as-pairs elems))))
(fail (str "[Parser Error] Records must have an even number of elements."))))))
;; [Interface]
@@ -40,31 +40,31 @@
]
(matchv ::M/objects [token]
[["White_Space" _]]
- (return (|list))
+ (return (&/|list))
[["Comment" _]]
- (return (|list))
+ (return (&/|list))
[["Bool" ?value]]
- (return (|list (&/V "Bool" (Boolean/parseBoolean ?value))))
+ (return (&/|list (&/V "Bool" (Boolean/parseBoolean ?value))))
[["Int" ?value]]
- (return (|list (&/V "Int" (Integer/parseInt ?value))))
+ (return (&/|list (&/V "Int" (Integer/parseInt ?value))))
[["Real" ?value]]
- (return (|list (&/V "Real" (Float/parseFloat ?value))))
+ (return (&/|list (&/V "Real" (Float/parseFloat ?value))))
[["Char" ?value]]
- (return (|list (&/V "Char" (.charAt ?value 0))))
+ (return (&/|list (&/V "Char" (.charAt ?value 0))))
[["Text" ?value]]
- (return (|list (&/V "Text" ?value)))
+ (return (&/|list (&/V "Text" ?value)))
[["Ident" ?value]]
- (return (|list (&/V "Ident" ?value)))
+ (return (&/|list (&/V "Ident" ?value)))
[["Tag" ?value]]
- (return (|list (&/V "Tag" ?value)))
+ (return (&/|list (&/V "Tag" ?value)))
[["Open_Paren" _]]
(parse-form parse)
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 6e8996f2a..a59ef19ca 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -2,38 +2,34 @@
(:refer-clojure :exclude [deref apply merge])
(:require [clojure.core.match :as M :refer [match matchv]]
clojure.core.match.array
- [lux.base :as & :refer [exec return* return fail fail* assert!
- |list |map fold |length |interpose |get zip2 |keys
- repeat% exhaust% try% try-all% map% flat-map% fold% sequence%
- apply%
- normalize-ident]]))
+ [lux.base :as & :refer [exec return* return fail fail* assert!]]))
;; [Util]
(def ^:private success (return nil))
(defn ^:private deref [id]
(fn [state]
- (if-let [type (->> state (get$ "types") (get$ "mappings") (|get id))]
+ (if-let [type (->> state (&/get$ "types") (&/get$ "mappings") (&/|get id))]
(return* state type)
(fail* (str "Unknown type-var: " id)))))
(defn ^:private reset [id type]
(fn [state]
- (if-let [_ (->> state (get$ "types") (get$ "mappings") (|get id))]
- (return* (update$ "types" (fn [ts] (update$ "mappings" #(|put id (&/V "Some" type) %)
- ts))
- state)
+ (if-let [_ (->> state (&/get$ "types") (&/get$ "mappings") (&/|get id))]
+ (return* (&/update$ "types" (fn [ts] (&/update$ "mappings" #(&/|put id (&/V "Some" type) %)
+ ts))
+ state)
nil)
(fail* (str "Unknown type-var: " id)))))
;; [Exports]
(def fresh-var
(fn [state]
- (let [id (->> state (get$ "types") (get$ "counter"))]
- (return* (update$ "types" #(-> %
- (update$ "counter" inc)
- (update$ "mappings" #(|put id (&/V "None" nil) %)))
- state)
+ (let [id (->> state (&/get$ "types") (&/get$ "counter"))]
+ (return* (&/update$ "types" #(-> %
+ (&/update$ "counter" inc)
+ (&/update$ "mappings" (fn [ms] (&/|put id (&/V "None" nil) ms))))
+ state)
(&/V "Var" id)))))
(def fresh-lambda
@@ -84,30 +80,30 @@
))
(def +list+
- [::All (|list) "List" "a"
- [::Variant (|list ["Cons" [::Tuple (|list [::Bound "a"] [::App [::Bound "List"] [::Bound "a"]])]]
- ["Nil" [::Tuple (|list)]])]])
+ [::All (&/|list) "List" "a"
+ [::Variant (&/|list ["Cons" [::Tuple (&/|list [::Bound "a"] [::App [::Bound "List"] [::Bound "a"]])]]
+ ["Nil" [::Tuple (&/|list)]])]])
(def +type+
- (let [text [::Data "java.lang.String" (|list)]
+ (let [text [::Data "java.lang.String" (&/|list)]
type [::App [::Bound "Type"] [::Any]]
list-of-types [::App +list+ type]
- string=>type [::App +list+ [::Tuple (|list text type)]]]
- (->type [::All (|list) "Type" "_"
- [::Variant (|list ["Any" [::Tuple (|list)]]
- ["Nothing" [::Tuple (|list)]]
- ["Data" [::Tuple (|list text list-of-types)]]
- ["Tuple" list-of-types]
- ["Variant" string=>type]
- ["Record" string=>type]
- ["Lambda" [::Tuple (|list type
- type)]]
- ["App" [::Tuple (|list type
- type)]]
- ["Bound" text]
- ["Var" [::Data "java.lang.Long" (|list)]]
- ["All" [::Tuple (|list string=>type text text type)]]
- )]])))
+ string=>type [::App +list+ [::Tuple (&/|list text type)]]]
+ (->type [::All (&/|list) "Type" "_"
+ [::Variant (&/|list ["Any" [::Tuple (&/|list)]]
+ ["Nothing" [::Tuple (&/|list)]]
+ ["Data" [::Tuple (&/|list text list-of-types)]]
+ ["Tuple" list-of-types]
+ ["Variant" string=>type]
+ ["Record" string=>type]
+ ["Lambda" [::Tuple (&/|list type
+ type)]]
+ ["App" [::Tuple (&/|list type
+ type)]]
+ ["Bound" text]
+ ["Var" [::Data "java.lang.Long" (&/|list)]]
+ ["All" [::Tuple (&/|list string=>type text text type)]]
+ )]])))
(defn clean [type]
(matchv ::M/objects [type]
@@ -126,25 +122,25 @@
(return (&/V "App" (to-array [=lambda =param]))))
[["Tuple" ?members]]
- (exec [=members (map% clean ?members)]
+ (exec [=members (&/map% clean ?members)]
(return (&/V "Tuple" =members)))
[["Variant" ?members]]
- (exec [=members (map% (fn [[k v]]
+ (exec [=members (&/map% (fn [[k v]]
(exec [=v (clean v)]
(return (to-array [k =v]))))
?members)]
(return (&/V "Variant" =members)))
[["Record" ?members]]
- (exec [=members (map% (fn [[k v]]
+ (exec [=members (&/map% (fn [[k v]]
(exec [=v (clean v)]
(return (to-array [k =v]))))
?members)]
(return (&/V "Record" =members)))
[["All" [?env ?name ?arg ?body]]]
- (exec [=env (map% (fn [[k v]]
+ (exec [=env (&/map% (fn [[k v]]
(exec [=v (clean v)]
(return (to-array [k =v]))))
?env)]
@@ -163,32 +159,32 @@
"Nothing"
[["Data" [name params]]]
- (str "(^ " name " [" (->> params (|map show-type) (|interpose " ") (fold str "")) "])")
+ (str "(^ " name " [" (->> params (&/|map show-type) (&/|interpose " ") (&/fold str "")) "])")
[["Tuple" elems]]
- (str "(, " (->> elems (|map show-type) (|interpose " ") (fold str "")) ")")
+ (str "(, " (->> elems (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")")
[["Variant" cases]]
(str "(| " (->> cases
- (|map (fn [kv]
+ (&/|map (fn [kv]
(matchv ::M/objects [kv]
[[k ["Tuple" ["Nil" _]]]]
(str "#" k)
[[k v]]
(str "(#" k " " (show-type v) ")"))))
- (|interpose " ")
- (fold str "")) ")")
+ (&/|interpose " ")
+ (&/fold str "")) ")")
[["Record" fields]]
(str "(& " (->> fields
- (|map (fn [kv]
+ (&/|map (fn [kv]
(matchv ::M/objects [kv]
[[k v]]
(str "(#" k " " (show-type v) ")"))))
- (|interpose " ")
- (fold str "")) ")")
+ (&/|interpose " ")
+ (&/fold str "")) ")")
[["Lambda" [input output]]]
(str "(-> " (show-type input) " " (show-type output) ")")
@@ -224,22 +220,22 @@
(fail (str "not (" actual " <= " expected ")")))
[["Tuple" e!elems] ["Tuple" a!elems]]
- (exec [_ (assert! (= (|length e!elems) (|length a!elems))
+ (exec [_ (assert! (= (&/|length e!elems) (&/|length a!elems))
"Tuples must have matching element sizes.")
- _ (map% (fn [n g] (solve n g))
- (zip2 e!elems a!elems))]
+ _ (&/map% (fn [n g] (solve n g))
+ (&/zip2 e!elems a!elems))]
success)
[["Variant" e!cases] ["Variant" a!cases]]
- (exec [_ (map% (fn [slot]
- (solve (|get e!cases slot) (|get a!cases slot)))
- (|keys a!cases))]
+ (exec [_ (&/map% (fn [slot]
+ (solve (&/|get e!cases slot) (&/|get a!cases slot)))
+ (&/|keys a!cases))]
success)
[["Record" e!fields] ["Record" a!fields]]
- (exec [_ (map% (fn [slot]
- (solve (|get e!fields slot) (|get a!fields slot)))
- (|keys e!fields))]
+ (exec [_ (&/map% (fn [slot]
+ (solve (&/|get e!fields slot) (&/|get a!fields slot)))
+ (&/|keys e!fields))]
success)
[["Lambda" [e!input e!output]] ["Lambda" [a!input a!output]]]
@@ -313,7 +309,7 @@
(defn slot-type [record slot]
(fn [state]
- (matchv ::M/objects [(|get record slot)]
+ (matchv ::M/objects [(&/|get record slot)]
[["Left" msg]]
(fail* msg)