diff options
-rw-r--r-- | src/lux/analyser.clj | 42 | ||||
-rw-r--r-- | src/lux/analyser/base.clj | 12 | ||||
-rw-r--r-- | src/lux/analyser/case.clj | 12 | ||||
-rw-r--r-- | src/lux/analyser/def.clj | 16 | ||||
-rw-r--r-- | src/lux/analyser/env.clj | 40 | ||||
-rw-r--r-- | src/lux/analyser/host.clj | 77 | ||||
-rw-r--r-- | src/lux/analyser/lambda.clj | 17 | ||||
-rw-r--r-- | src/lux/analyser/lux.clj | 91 | ||||
-rw-r--r-- | src/lux/base.clj | 113 | ||||
-rw-r--r-- | src/lux/compiler.clj | 27 | ||||
-rw-r--r-- | src/lux/compiler/base.clj | 64 | ||||
-rw-r--r-- | src/lux/compiler/case.clj | 11 | ||||
-rw-r--r-- | src/lux/compiler/host.clj | 15 | ||||
-rw-r--r-- | src/lux/compiler/lambda.clj | 9 | ||||
-rw-r--r-- | src/lux/compiler/lux.clj | 64 | ||||
-rw-r--r-- | src/lux/host.clj | 8 | ||||
-rw-r--r-- | src/lux/lexer.clj | 44 | ||||
-rw-r--r-- | src/lux/parser.clj | 32 | ||||
-rw-r--r-- | src/lux/type.clj | 110 |
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 ¯o] @@ -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 ¯o] @@ -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 (¯o/expand loader macro-class ?args)] - (return (&/->seq (|flat-map% analyse macro-expansion))))) + (exec [macro-expansion (¯o/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) |