diff options
-rw-r--r-- | src/lux/analyser.clj | 18 | ||||
-rw-r--r-- | src/lux/analyser/base.clj | 22 | ||||
-rw-r--r-- | src/lux/analyser/case.clj | 8 | ||||
-rw-r--r-- | src/lux/analyser/def.clj | 2 | ||||
-rw-r--r-- | src/lux/analyser/env.clj | 4 | ||||
-rw-r--r-- | src/lux/analyser/host.clj | 203 | ||||
-rw-r--r-- | src/lux/analyser/lambda.clj | 6 | ||||
-rw-r--r-- | src/lux/analyser/lux.clj | 55 | ||||
-rw-r--r-- | src/lux/compiler.clj | 220 | ||||
-rw-r--r-- | src/lux/compiler/base.clj | 125 | ||||
-rw-r--r-- | src/lux/compiler/case.clj | 36 | ||||
-rw-r--r-- | src/lux/compiler/lambda.clj | 18 |
12 files changed, 362 insertions, 355 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 2c45c160a..323c35bff 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -34,19 +34,19 @@ (matchv ::M/objects [token] ;; Standard special forms [["Bool" ?value]] - (return (|list [::&&/Expression [::&&/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 [::&&/Expression [::&&/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 [::&&/Expression [::&&/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 [::&&/Expression [::&&/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 [::&&/Expression [::&&/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 +56,11 @@ [["Tag" ?tag]] (let [tuple-type (&/V "Tuple" (&/V "Nil" nil))] - (return (|list [::&&/Expression [::&&/variant ?tag [::&&/Expression [::&&/tuple (|list)] tuple-type]] - (&/V "Variant" (&/V "Cons" (&/T (&/T ?tag tuple-type) (&/V "Nil" nil))))]))) + (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 [::&&/Expression [::&&/jvm-null] (&/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) @@ -403,7 +403,7 @@ ;; :let [_ (prn 'POST-ASSERT)] =value (&&/analyse-1 (analyse-ast eval!) (first ?values)) =value-type (&&/expr-type =value)] - (return (|list [::&&/Expression [::&&/variant ?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] diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj index 43bcd1181..b2ec4d0c5 100644 --- a/src/lux/analyser/base.clj +++ b/src/lux/analyser/base.clj @@ -9,35 +9,35 @@ ;; [Resources] (defn expr-type [syntax+] ;; (prn 'expr-type syntax+) - (match syntax+ - [::Expression _ type] + (matchv ::M/objects [syntax+] + [["Expression" [_ type]]] (return type) - _ + [_] (fail (str "[Analyser Error] Can't retrieve the type of a non-expression: " (pr-str syntax+))))) (defn analyse-1 [analyse elem] (exec [output (analyse elem)] - (match output - ([x] :seq) + (matchv ::M/objects [output] + ["Cons" [x ["Nil" _]]] (return x) - :else + [_] (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 - ([x y] :seq) + ["Cons" [x ["Cons" [y ["Nil" _]]]]] (return [x y]) - :else + [_] (fail "[Analyser Error] Can't expand to other than 2 elements.")))) (defn with-var [k] (exec [=var &type/fresh-var =ret (k =var)] - (match =ret - [::Expression ?expr ?type] + (matchv ::M/objects [=ret] + [["Expression" [?expr ?type]]] (exec [=type (&type/clean =var ?type)] - (return [::Expression ?expr =type]))))) + (return (&/V "Expression" (&/T ?expr =type))))))) diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index 9ae2f736b..ba2342245 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -13,16 +13,16 @@ (defn locals [member] (matchv ::M/objects [member] [["Ident" ?name]] - (list ?name) + (|list ?name) [["Tuple" ?submembers]] - (mapcat locals (&/->seq ?submembers)) + (|flat-map locals ?submembers) [["Form" ["Cons" [["Tag" _] ?submembers]]]] - (mapcat locals (&/->seq ?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 c7454351b..4ac7029f1 100644 --- a/src/lux/analyser/def.clj +++ b/src/lux/analyser/def.clj @@ -30,7 +30,7 @@ (defn define [module name type] (fn [state] (let [full-name (str module &/+name-separator+ name) - bound [::&&/Expression [::&&/global module name] type]] + 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) %))) diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj index 5d70434bb..eeaebc18f 100644 --- a/src/lux/analyser/env.clj +++ b/src/lux/analyser/env.clj @@ -18,10 +18,10 @@ (let [old-mappings (->> state (get$ "local-envs") |head (get$ "locals") (get$ "mappings")) =return (body (update$ "local-envs" (fn [[top & stack]] - (let [bound-unit [::&&/local (-> top (get$ "locals") (get$ "counter"))]] + (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 [::&&/Expression bound-unit type] m)) %))) + (update$ "locals" #(update$ "mappings" (fn [m] (|put name (&/V "Expression" (&/T bound-unit type)) m)) %))) stack))) state))] (matchv ::M/objects [=return] diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 3d94aac59..a87964ed8 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -39,43 +39,43 @@ =y-type (&&/expr-type =y) _ (&type/solve input-type =x-type) _ (&type/solve input-type =y-type)] - (return (|list [::&&/Expression [<output-tag> =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" - analyse-jvm-imul ::&&/jvm-imul "java.lang.Integer" "java.lang.Integer" - analyse-jvm-idiv ::&&/jvm-idiv "java.lang.Integer" "java.lang.Integer" - analyse-jvm-irem ::&&/jvm-irem "java.lang.Integer" "java.lang.Integer" - analyse-jvm-ieq ::&&/jvm-ieq "java.lang.Integer" "java.lang.Boolean" - analyse-jvm-ilt ::&&/jvm-ilt "java.lang.Integer" "java.lang.Boolean" - analyse-jvm-igt ::&&/jvm-igt "java.lang.Integer" "java.lang.Boolean" - - analyse-jvm-ladd ::&&/jvm-ladd "java.lang.Long" "java.lang.Long" - analyse-jvm-lsub ::&&/jvm-lsub "java.lang.Long" "java.lang.Long" - analyse-jvm-lmul ::&&/jvm-lmul "java.lang.Long" "java.lang.Long" - analyse-jvm-ldiv ::&&/jvm-ldiv "java.lang.Long" "java.lang.Long" - analyse-jvm-lrem ::&&/jvm-lrem "java.lang.Long" "java.lang.Long" - analyse-jvm-leq ::&&/jvm-leq "java.lang.Long" "java.lang.Boolean" - analyse-jvm-llt ::&&/jvm-llt "java.lang.Long" "java.lang.Boolean" - analyse-jvm-lgt ::&&/jvm-lgt "java.lang.Long" "java.lang.Boolean" - - analyse-jvm-fadd ::&&/jvm-fadd "java.lang.Float" "java.lang.Float" - analyse-jvm-fsub ::&&/jvm-fsub "java.lang.Float" "java.lang.Float" - analyse-jvm-fmul ::&&/jvm-fmul "java.lang.Float" "java.lang.Float" - analyse-jvm-fdiv ::&&/jvm-fdiv "java.lang.Float" "java.lang.Float" - analyse-jvm-frem ::&&/jvm-frem "java.lang.Float" "java.lang.Float" - analyse-jvm-feq ::&&/jvm-feq "java.lang.Float" "java.lang.Boolean" - analyse-jvm-flt ::&&/jvm-flt "java.lang.Float" "java.lang.Boolean" - analyse-jvm-fgt ::&&/jvm-fgt "java.lang.Float" "java.lang.Boolean" - - analyse-jvm-dadd ::&&/jvm-dadd "java.lang.Double" "java.lang.Double" - analyse-jvm-dsub ::&&/jvm-dsub "java.lang.Double" "java.lang.Double" - analyse-jvm-dmul ::&&/jvm-dmul "java.lang.Double" "java.lang.Double" - analyse-jvm-ddiv ::&&/jvm-ddiv "java.lang.Double" "java.lang.Double" - analyse-jvm-drem ::&&/jvm-drem "java.lang.Double" "java.lang.Double" - analyse-jvm-deq ::&&/jvm-deq "java.lang.Double" "java.lang.Boolean" - analyse-jvm-dlt ::&&/jvm-dlt "java.lang.Double" "java.lang.Boolean" - analyse-jvm-dgt ::&&/jvm-dgt "java.lang.Double" "java.lang.Boolean" + (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" + analyse-jvm-imul "jvm-imul" "java.lang.Integer" "java.lang.Integer" + analyse-jvm-idiv "jvm-idiv" "java.lang.Integer" "java.lang.Integer" + analyse-jvm-irem "jvm-irem" "java.lang.Integer" "java.lang.Integer" + analyse-jvm-ieq "jvm-ieq" "java.lang.Integer" "java.lang.Boolean" + analyse-jvm-ilt "jvm-ilt" "java.lang.Integer" "java.lang.Boolean" + analyse-jvm-igt "jvm-igt" "java.lang.Integer" "java.lang.Boolean" + + analyse-jvm-ladd "jvm-ladd" "java.lang.Long" "java.lang.Long" + analyse-jvm-lsub "jvm-lsub" "java.lang.Long" "java.lang.Long" + analyse-jvm-lmul "jvm-lmul" "java.lang.Long" "java.lang.Long" + analyse-jvm-ldiv "jvm-ldiv" "java.lang.Long" "java.lang.Long" + analyse-jvm-lrem "jvm-lrem" "java.lang.Long" "java.lang.Long" + analyse-jvm-leq "jvm-leq" "java.lang.Long" "java.lang.Boolean" + analyse-jvm-llt "jvm-llt" "java.lang.Long" "java.lang.Boolean" + analyse-jvm-lgt "jvm-lgt" "java.lang.Long" "java.lang.Boolean" + + analyse-jvm-fadd "jvm-fadd" "java.lang.Float" "java.lang.Float" + analyse-jvm-fsub "jvm-fsub" "java.lang.Float" "java.lang.Float" + analyse-jvm-fmul "jvm-fmul" "java.lang.Float" "java.lang.Float" + analyse-jvm-fdiv "jvm-fdiv" "java.lang.Float" "java.lang.Float" + analyse-jvm-frem "jvm-frem" "java.lang.Float" "java.lang.Float" + analyse-jvm-feq "jvm-feq" "java.lang.Float" "java.lang.Boolean" + analyse-jvm-flt "jvm-flt" "java.lang.Float" "java.lang.Boolean" + analyse-jvm-fgt "jvm-fgt" "java.lang.Float" "java.lang.Boolean" + + analyse-jvm-dadd "jvm-dadd" "java.lang.Double" "java.lang.Double" + analyse-jvm-dsub "jvm-dsub" "java.lang.Double" "java.lang.Double" + analyse-jvm-dmul "jvm-dmul" "java.lang.Double" "java.lang.Double" + analyse-jvm-ddiv "jvm-ddiv" "java.lang.Double" "java.lang.Double" + analyse-jvm-drem "jvm-drem" "java.lang.Double" "java.lang.Double" + analyse-jvm-deq "jvm-deq" "java.lang.Double" "java.lang.Boolean" + analyse-jvm-dlt "jvm-dlt" "java.lang.Double" "java.lang.Boolean" + analyse-jvm-dgt "jvm-dgt" "java.lang.Double" "java.lang.Boolean" ) (defn analyse-jvm-getstatic [analyse ?class ?field] @@ -84,13 +84,13 @@ =type (&host/lookup-static-field =class ?field) ;; :let [_ (prn 'analyse-jvm-getstatic/=type =type)] ] - (return (|list [::&&/Expression [::&&/jvm-getstatic =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 [::&&/Expression [::&&/jvm-getfield =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,21 +98,21 @@ =type (&host/lookup-static-field =class ?field) ;; :let [_ (prn 'analyse-jvm-getstatic/=type =type)] =value (&&/analyse-1 analyse ?value)] - (return (|list [::&&/Expression [::&&/jvm-putstatic =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 [::&&/Expression [::&&/jvm-putfield =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) =return (&host/lookup-virtual-method =class ?method =classes) =args (mapcat-m analyse ?args)] - (return (|list [::&&/Expression [::&&/jvm-invokestatic =class ?method =classes =args] =return])))) + (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] @@ -127,52 +127,55 @@ =args (mapcat-m analyse ?args) ;; :let [_ (prn 'analyse-jvm-invokevirtual/=args =args)] ] - (return (|list [::&&/Expression [<tag> =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 - analyse-jvm-invokespecial ::&&/jvm-invokespecial + analyse-jvm-invokevirtual "jvm-invokevirtual" + analyse-jvm-invokeinterface "jvm-invokeinterface" + analyse-jvm-invokespecial "jvm-invokespecial" ) (defn analyse-jvm-null? [analyse ?object] (exec [=object (&&/analyse-1 analyse ?object)] - (return (|list [::&&/Expression [::&&/jvm-null? =object] (&/V "Data" (to-array ["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 [::&&/Expression [::&&/jvm-new =class =classes =args] (&/V "Data" (to-array [=class (&/V "Nil" nil)]))])))) + (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 [::&&/Expression [::&&/jvm-new-array =class ?length] (&/V "array" (to-array [(&/V "Data" (to-array [=class (&/V "Nil" nil)])) - (&/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] - (exec [[=array =elem] (&&/analyse-2 analyse ?array ?elem) + (exec [=array+=elem (&&/analyse-2 analyse ?array ?elem) + :let [[=array =elem] (matchv ::M/objects [=array+=elem] + [[=array =elem]] + [=array =elem])] =array-type (&&/expr-type =array)] - (return (|list [::&&/Expression [::&&/jvm-aastore =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 [::&&/Expression [::&&/jvm-aaload =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] - (match ?field - [::&parser/Tuple ([[::&parser/Ident ?class] [::&parser/Ident ?field-name]] :seq)] + (matchv ::M/objects [?field] + [["Tuple" ["Cons" [["Ident" ?class] ["Cons" [["Ident" ?field-name] ["Nil" _]]]]]]] (return [?class ?field-name]) - _ + [_] (fail "[Analyser Error] Fields must be Tuple2 of [Ident, Ident]"))) ?fields) :let [=fields (into {} (for [[class field] ?fields] [field {:access :public :type class}]))] $module &/get-module-name] - (return (|list [::&&/Statement [::&&/jvm-class $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) @@ -197,80 +200,80 @@ [method {:access :public :type [inputs output]}]))] $module &/get-module-name] - (return (|list [::&&/Statement [::&&/jvm-interface $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 (mapcat-m analyse ?exprs) - =exprs-types (map-m &&/expr-type =exprs)] - (return (|list [::&&/Expression [::&&/exec =exprs] (last =exprs-types)])))) + =exprs (flat-map% analyse ?exprs) + =exprs-types (map% &&/expr-type =exprs)] + (return (|list (&/V "Expression" (&/T (&/V "exec" =exprs) (|last =exprs-types))))))) (defn analyse-jvm-try [analyse ?body [?catches ?finally]] (exec [=body (&&/analyse-1 analyse ?body) - =catches (map-m (fn [[?ex-class ?ex-arg ?catch-body]] - (&&env/with-local ?ex-arg (&/V "Data" (to-array [?ex-class (&/V "Nil" nil)])) - (exec [=catch-body (&&/analyse-1 analyse ?catch-body)] - (return [?ex-class ?ex-arg =catch-body])))) - ?catches) + =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 [::&&/Expression [::&&/jvm-try =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 [::&&/Expression [::&&/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 [::&&/Expression [::&&/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 [::&&/Expression [::&&/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 [::&&/Expression [<tag> =value] (&/V "Data" (to-array [<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" - analyse-jvm-d2l ::&&/jvm-d2l "java.lang.Double" "java.lang.Long" - - analyse-jvm-f2d ::&&/jvm-f2d "java.lang.Float" "java.lang.Double" - analyse-jvm-f2i ::&&/jvm-f2i "java.lang.Float" "java.lang.Integer" - analyse-jvm-f2l ::&&/jvm-f2l "java.lang.Float" "java.lang.Long" - - analyse-jvm-i2b ::&&/jvm-i2b "java.lang.Integer" "java.lang.Byte" - analyse-jvm-i2c ::&&/jvm-i2c "java.lang.Integer" "java.lang.Character" - analyse-jvm-i2d ::&&/jvm-i2d "java.lang.Integer" "java.lang.Double" - analyse-jvm-i2f ::&&/jvm-i2f "java.lang.Integer" "java.lang.Float" - analyse-jvm-i2l ::&&/jvm-i2l "java.lang.Integer" "java.lang.Long" - analyse-jvm-i2s ::&&/jvm-i2s "java.lang.Integer" "java.lang.Short" - - analyse-jvm-l2d ::&&/jvm-l2d "java.lang.Long" "java.lang.Double" - analyse-jvm-l2f ::&&/jvm-l2f "java.lang.Long" "java.lang.Float" - analyse-jvm-l2i ::&&/jvm-l2i "java.lang.Long" "java.lang.Integer" + (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" + analyse-jvm-d2l "jvm-d2l" "java.lang.Double" "java.lang.Long" + + analyse-jvm-f2d "jvm-f2d" "java.lang.Float" "java.lang.Double" + analyse-jvm-f2i "jvm-f2i" "java.lang.Float" "java.lang.Integer" + analyse-jvm-f2l "jvm-f2l" "java.lang.Float" "java.lang.Long" + + analyse-jvm-i2b "jvm-i2b" "java.lang.Integer" "java.lang.Byte" + analyse-jvm-i2c "jvm-i2c" "java.lang.Integer" "java.lang.Character" + analyse-jvm-i2d "jvm-i2d" "java.lang.Integer" "java.lang.Double" + analyse-jvm-i2f "jvm-i2f" "java.lang.Integer" "java.lang.Float" + analyse-jvm-i2l "jvm-i2l" "java.lang.Integer" "java.lang.Long" + analyse-jvm-i2s "jvm-i2s" "java.lang.Integer" "java.lang.Short" + + analyse-jvm-l2d "jvm-l2d" "java.lang.Long" "java.lang.Double" + analyse-jvm-l2f "jvm-l2f" "java.lang.Long" "java.lang.Float" + analyse-jvm-l2i "jvm-l2i" "java.lang.Long" "java.lang.Integer" ) (do-template [<name> <tag> <from-class> <to-class>] (defn <name> [analyse ?value] (exec [=value (&&/analyse-1 analyse ?value)] - (return (|list [::&&/Expression [<tag> =value] (&/V "Data" (to-array [<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" + analyse-jvm-iand "jvm-iand" "java.lang.Integer" "java.lang.Integer" + analyse-jvm-ior "jvm-ior" "java.lang.Integer" "java.lang.Integer" - analyse-jvm-land ::&&/jvm-land "java.lang.Long" "java.lang.Long" - analyse-jvm-lor ::&&/jvm-lor "java.lang.Long" "java.lang.Long" - analyse-jvm-lxor ::&&/jvm-lxor "java.lang.Long" "java.lang.Long" + analyse-jvm-land "jvm-land" "java.lang.Long" "java.lang.Long" + analyse-jvm-lor "jvm-lor" "java.lang.Long" "java.lang.Long" + analyse-jvm-lxor "jvm-lxor" "java.lang.Long" "java.lang.Long" - analyse-jvm-lshl ::&&/jvm-lshl "java.lang.Long" "java.lang.Integer" - analyse-jvm-lshr ::&&/jvm-lshr "java.lang.Long" "java.lang.Integer" - analyse-jvm-lushr ::&&/jvm-lushr "java.lang.Long" "java.lang.Integer" + analyse-jvm-lshl "jvm-lshl" "java.lang.Long" "java.lang.Integer" + analyse-jvm-lshr "jvm-lshr" "java.lang.Long" "java.lang.Integer" + analyse-jvm-lushr "jvm-lushr" "java.lang.Long" "java.lang.Integer" ) (defn analyse-jvm-program [analyse ?args ?body] (exec [=body (&&env/with-local ?args (&/V "Any" nil) (&&/analyse-1 analyse ?body))] - (return (|list [::&&/Statement [::&&/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 f231b744a..3b3d6d9a0 100644 --- a/src/lux/analyser/lambda.clj +++ b/src/lux/analyser/lambda.clj @@ -17,9 +17,9 @@ (return [scope-name =captured =return]))))))) (defn close-over [scope ident register frame] - (match register - [::&&/Expression _ register-type] - (let [register* [::&&/Expression [::&&/captured scope (->> frame (get$ "closure") (get$ "counter")) register] register-type]] + (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* %))) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index f060b68c4..5412bdade 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -23,7 +23,7 @@ =elems-types (|map% &&/expr-type =elems) ;; :let [_ (prn 'analyse-tuple =elems)] ] - (return (|list [::&&/Expression [::&&/tuple =elems] (&/V "Tuple" (&/|->list =elems-types))])))) + (return (|list (&/V "Expression" (&/T (&/V "tuple" =elems) (&/V "Tuple" (&/|->list =elems-types)))))))) (defn analyse-record [analyse ?elems] (exec [=elems (|map% (fn [kv] @@ -40,7 +40,7 @@ =elems) ;; :let [_ (prn 'analyse-tuple =elems)] ] - (return (|list [::&&/Expression [::&&/record =elems] (&/V "Record" (&/|->list =elems-types))])))) + (return (|list (&/V "Expression" (&/T (&/V "record" =elems) (&/V "Record" (&/|->list =elems-types)))))))) (defn analyse-ident [analyse ident] (exec [module-name &/get-module-name] @@ -75,20 +75,23 @@ (defn ^:private analyse-apply* [analyse =fn ?args] (exec [=args (|flat-map% analyse ?args) =fn-type (&&/expr-type =fn) - :let [[=apply =apply-type] (|fold% (fn [[=fn =fn-type] =input] - (exec [=input-type (&&/expr-type =input) - =output-type (&type/apply-lambda =fn-type =input-type)] - [[::&&/apply =fn =input] =output-type])) - [=fn =fn-type] - =args)]] - (return (|list [::&&/Expression =apply =apply-type])))) + =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]))) + [=fn =fn-type] + =args) + :let [[=apply =apply-type] (matchv ::M/objects [=apply+=apply-type] + [[=apply =apply-type]] + [=apply =apply-type])]] + (return (|list (&/V "Expression" (&/T =apply =apply-type)))))) (defn analyse-apply [analyse =fn ?args] (exec [loader &/loader] - (match =fn - [::&&/Expression =fn-form =fn-type] - (match =fn-form - [::&&/global ?module ?name] + (matchv ::M/objects [=fn] + [["Expression" [=fn-form =fn-type]]] + (matchv ::M/objects [=fn-form] + [["global" [?module ?name]]] (exec [macro? (&&def/macro? ?module ?name)] (if macro? (let [macro-class (&host/location (list ?module ?name))] @@ -96,10 +99,10 @@ (return (&/->seq (|flat-map% analyse macro-expansion))))) (analyse-apply* analyse =fn ?args))) - _ + [_] (analyse-apply* analyse =fn ?args)) - :else + [_] (fail "[Analyser Error] Can't call a statement!")) )) @@ -123,7 +126,7 @@ =body-types (map-m &&/expr-type =bodies) =case-type (reduce-m &type/merge (&/V "Nothing" nil) =body-types) :let [=branches (map vector (map first branches) =bodies)]] - (return (|list [::&&/Expression [::&&/case =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] @@ -136,13 +139,13 @@ =lambda-type (exec [_ (&type/solve =return =body-type) =lambda-type** (&type/clean =return =lambda-type*)] (&type/clean =arg =lambda-type**))] - (return (|list [::&&/Expression [::&&/lambda =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 [::&&/Expression [::&&/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) @@ -150,7 +153,7 @@ =record-type (&&/expr-type =record) =slot-type (&type/slot-type =record-type ?slot) _ (&type/solve =slot-type =value)] - (return (|list [::&&/Expression [::&&/set ?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) @@ -160,7 +163,7 @@ (exec [=value (&&/analyse-1 analyse ?value) =value-type (&&/expr-type =value) _ (&&def/define module-name ?name =value-type)] - (return (|list [::&&/Statement [::&&/def ?name =value]])))))) + (return (|list (&/V "Statement" (&/V "def" (&/T ?name =value))))))))) (defn analyse-declare-macro [?ident] (exec [module-name &/get-module-name @@ -177,10 +180,10 @@ _ (&type/solve &type/+type+ =type-type) ==type (eval! =type) =value (&&/analyse-1 analyse ?value)] - (match =value - [::&&/Expression ?expr ?expr-type] + (matchv ::M/objects [=value] + [["Expression" [?expr ?expr-type]]] (exec [_ (&type/solve ==type ?expr-type)] - (return [::&&/Expression ?expr ==type]))))) + (return (&/V "Expression" (&/T ?expr ==type))))))) (defn analyse-coerce [analyse eval! ?type ?value] (exec [=type (&&/analyse-1 analyse ?type) @@ -188,6 +191,6 @@ _ (&type/solve &type/+type+ =type-type) ==type (eval! =type) =value (&&/analyse-1 analyse ?value)] - (match =value - [::&&/Expression ?expr ?expr-type] - (return [::&&/Expression ?expr ==type])))) + (matchv ::M/objects [=value] + [["Expression" [?expr ?expr-type]]] + (return (&/V "Expression" (&/T ?expr ==type)))))) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index bade1e90c..46cddc9b0 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -32,305 +32,305 @@ ;; [Utils/Compilers] (defn ^:private compile-expression [syntax] ;; (prn 'compile-expression syntax) - (match syntax - [::&a/Expression ?form ?type] - (match ?form - [::&a/bool ?value] + (matchv ::M/objects [syntax] + [["Expression" ?form ?type]] + (matchv ::M/objects [?form] + [["bool" ?value]] (&&lux/compile-bool compile-expression ?type ?value) - [::&a/int ?value] + [["int" ?value]] (&&lux/compile-int compile-expression ?type ?value) - [::&a/real ?value] + [["real" ?value]] (&&lux/compile-real compile-expression ?type ?value) - [::&a/char ?value] + [["char" ?value]] (&&lux/compile-char compile-expression ?type ?value) - [::&a/text ?value] + [["text" ?value]] (&&lux/compile-text compile-expression ?type ?value) - [::&a/tuple ?elems] + [["tuple" ?elems]] (&&lux/compile-tuple compile-expression ?type ?elems) - [::&a/record ?elems] + [["record" ?elems]] (&&lux/compile-record compile-expression ?type ?elems) - [::&a/local ?idx] + [["local" ?idx]] (&&lux/compile-local compile-expression ?type ?idx) - [::&a/captured ?scope ?captured-id ?source] + [["captured" [?scope ?captured-id ?source]]] (&&lux/compile-captured compile-expression ?type ?scope ?captured-id ?source) - [::&a/global ?owner-class ?name] + [["global" [?owner-class ?name]]] (&&lux/compile-global compile-expression ?type ?owner-class ?name) - [::&a/call ?fn ?args] + [["call" [?fn ?args]]] (&&lux/compile-call compile-expression ?type ?fn ?args) - [::&a/variant ?tag ?members] + [["variant" [?tag ?members]]] (&&lux/compile-variant compile-expression ?type ?tag ?members) - [::&a/case ?variant ?base-register ?num-registers ?branches] + [["case" [?variant ?base-register ?num-registers ?branches]]] (&&case/compile-case compile-expression ?type ?variant ?base-register ?num-registers ?branches) - [::&a/lambda ?scope ?env ?args ?body] + [["lambda" [?scope ?env ?args ?body]]] (&&lambda/compile-lambda compile-expression ?scope ?env ?args ?body) - [::&a/get ?slot ?record] + [["get" [?slot ?record]]] (&&lux/compile-get compile-expression ?type ?slot ?record) - [::&a/set ?slot ?value ?record] + [["set" [?slot ?value ?record]]] (&&lux/compile-set compile-expression ?type ?slot ?value ?record) ;; Integer arithmetic - [::&a/jvm-iadd ?x ?y] + [["jvm-iadd" [?x ?y]]] (&&host/compile-jvm-iadd compile-expression ?type ?x ?y) - [::&a/jvm-isub ?x ?y] + [["jvm-isub" [?x ?y]]] (&&host/compile-jvm-isub compile-expression ?type ?x ?y) - [::&a/jvm-imul ?x ?y] + [["jvm-imul" [?x ?y]]] (&&host/compile-jvm-imul compile-expression ?type ?x ?y) - [::&a/jvm-idiv ?x ?y] + [["jvm-idiv" [?x ?y]]] (&&host/compile-jvm-idiv compile-expression ?type ?x ?y) - [::&a/jvm-irem ?x ?y] + [["jvm-irem" [?x ?y]]] (&&host/compile-jvm-irem compile-expression ?type ?x ?y) - [::&a/jvm-ieq ?x ?y] + [["jvm-ieq" [?x ?y]]] (&&host/compile-jvm-ieq compile-expression ?type ?x ?y) - [::&a/jvm-ilt ?x ?y] + [["jvm-ilt" [?x ?y]]] (&&host/compile-jvm-ilt compile-expression ?type ?x ?y) - [::&a/jvm-igt ?x ?y] + [["jvm-igt" [?x ?y]]] (&&host/compile-jvm-igt compile-expression ?type ?x ?y) ;; Long arithmetic - [::&a/jvm-ladd ?x ?y] + [["jvm-ladd" [?x ?y]]] (&&host/compile-jvm-ladd compile-expression ?type ?x ?y) - [::&a/jvm-lsub ?x ?y] + [["jvm-lsub" [?x ?y]]] (&&host/compile-jvm-lsub compile-expression ?type ?x ?y) - [::&a/jvm-lmul ?x ?y] + [["jvm-lmul" [?x ?y]]] (&&host/compile-jvm-lmul compile-expression ?type ?x ?y) - [::&a/jvm-ldiv ?x ?y] + [["jvm-ldiv" [?x ?y]]] (&&host/compile-jvm-ldiv compile-expression ?type ?x ?y) - [::&a/jvm-lrem ?x ?y] + [["jvm-lrem" [?x ?y]]] (&&host/compile-jvm-lrem compile-expression ?type ?x ?y) - [::&a/jvm-leq ?x ?y] + [["jvm-leq" [?x ?y]]] (&&host/compile-jvm-leq compile-expression ?type ?x ?y) - [::&a/jvm-llt ?x ?y] + [["jvm-llt" [?x ?y]]] (&&host/compile-jvm-llt compile-expression ?type ?x ?y) - [::&a/jvm-lgt ?x ?y] + [["jvm-lgt" [?x ?y]]] (&&host/compile-jvm-lgt compile-expression ?type ?x ?y) ;; Float arithmetic - [::&a/jvm-fadd ?x ?y] + [["jvm-fadd" [?x ?y]]] (&&host/compile-jvm-fadd compile-expression ?type ?x ?y) - [::&a/jvm-fsub ?x ?y] + [["jvm-fsub" [?x ?y]]] (&&host/compile-jvm-fsub compile-expression ?type ?x ?y) - [::&a/jvm-fmul ?x ?y] + [["jvm-fmul" [?x ?y]]] (&&host/compile-jvm-fmul compile-expression ?type ?x ?y) - [::&a/jvm-fdiv ?x ?y] + [["jvm-fdiv" [?x ?y]]] (&&host/compile-jvm-fdiv compile-expression ?type ?x ?y) - [::&a/jvm-frem ?x ?y] + [["jvm-frem" [?x ?y]]] (&&host/compile-jvm-frem compile-expression ?type ?x ?y) - [::&a/jvm-feq ?x ?y] + [["jvm-feq" [?x ?y]]] (&&host/compile-jvm-feq compile-expression ?type ?x ?y) - [::&a/jvm-flt ?x ?y] + [["jvm-flt" [?x ?y]]] (&&host/compile-jvm-flt compile-expression ?type ?x ?y) - [::&a/jvm-fgt ?x ?y] + [["jvm-fgt" [?x ?y]]] (&&host/compile-jvm-fgt compile-expression ?type ?x ?y) ;; Double arithmetic - [::&a/jvm-dadd ?x ?y] + [["jvm-dadd" [?x ?y]]] (&&host/compile-jvm-dadd compile-expression ?type ?x ?y) - [::&a/jvm-dsub ?x ?y] + [["jvm-dsub" [?x ?y]]] (&&host/compile-jvm-dsub compile-expression ?type ?x ?y) - [::&a/jvm-dmul ?x ?y] + [["jvm-dmul" [?x ?y]]] (&&host/compile-jvm-dmul compile-expression ?type ?x ?y) - [::&a/jvm-ddiv ?x ?y] + [["jvm-ddiv" [?x ?y]]] (&&host/compile-jvm-ddiv compile-expression ?type ?x ?y) - [::&a/jvm-drem ?x ?y] + [["jvm-drem" [?x ?y]]] (&&host/compile-jvm-drem compile-expression ?type ?x ?y) - [::&a/jvm-deq ?x ?y] + [["jvm-deq" [?x ?y]]] (&&host/compile-jvm-deq compile-expression ?type ?x ?y) - [::&a/jvm-dlt ?x ?y] + [["jvm-dlt" [?x ?y]]] (&&host/compile-jvm-dlt compile-expression ?type ?x ?y) - [::&a/jvm-dgt ?x ?y] + [["jvm-dgt" [?x ?y]]] (&&host/compile-jvm-dgt compile-expression ?type ?x ?y) - [::&a/exec ?exprs] + [["exec" ?exprs]] (&&host/compile-exec compile-expression ?type ?exprs) - [::&a/jvm-null] + [["jvm-null" _]] (&&host/compile-jvm-null compile-expression ?type) - [::&a/jvm-null? ?object] + [["jvm-null?" ?object]] (&&host/compile-jvm-null? compile-expression ?type ?object) - [::&a/jvm-new ?class ?classes ?args] + [["jvm-new" [?class ?classes ?args]]] (&&host/compile-jvm-new compile-expression ?type ?class ?classes ?args) - [::&a/jvm-getstatic ?class ?field] + [["jvm-getstatic" [?class ?field]]] (&&host/compile-jvm-getstatic compile-expression ?type ?class ?field) - [::&a/jvm-getfield ?class ?field ?object] + [["jvm-getfield" [?class ?field ?object]]] (&&host/compile-jvm-getfield compile-expression ?type ?class ?field ?object) - [::&a/jvm-putstatic ?class ?field ?value] + [["jvm-putstatic" [?class ?field ?value]]] (&&host/compile-jvm-putstatic compile-expression ?type ?class ?field ?value) - [::&a/jvm-putfield ?class ?field ?object ?value] + [["jvm-putfield" [?class ?field ?object ?value]]] (&&host/compile-jvm-putfield compile-expression ?type ?class ?field ?object ?value) - [::&a/jvm-invokestatic ?class ?method ?classes ?args] + [["jvm-invokestatic" [?class ?method ?classes ?args]]] (&&host/compile-jvm-invokestatic compile-expression ?type ?class ?method ?classes ?args) - [::&a/jvm-invokevirtual ?class ?method ?classes ?object ?args] + [["jvm-invokevirtual" [?class ?method ?classes ?object ?args]]] (&&host/compile-jvm-invokevirtual compile-expression ?type ?class ?method ?classes ?object ?args) - [::&a/jvm-invokeinterface ?class ?method ?classes ?object ?args] + [["jvm-invokeinterface" [?class ?method ?classes ?object ?args]]] (&&host/compile-jvm-invokeinterface compile-expression ?type ?class ?method ?classes ?object ?args) - [::&a/jvm-invokespecial ?class ?method ?classes ?object ?args] + [["jvm-invokespecial" [?class ?method ?classes ?object ?args]]] (&&host/compile-jvm-invokespecial compile-expression ?type ?class ?method ?classes ?object ?args) - [::&a/jvm-new-array ?class ?length] + [["jvm-new-array" [?class ?length]]] (&&host/compile-jvm-new-array compile-expression ?type ?class ?length) - [::&a/jvm-aastore ?array ?idx ?elem] + [["jvm-aastore" [?array ?idx ?elem]]] (&&host/compile-jvm-aastore compile-expression ?type ?array ?idx ?elem) - [::&a/jvm-aaload ?array ?idx] + [["jvm-aaload" [?array ?idx]]] (&&host/compile-jvm-aaload compile-expression ?type ?array ?idx) - [::&a/jvm-try ?body ?catches ?finally] + [["jvm-try" [?body ?catches ?finally]]] (&&host/compile-jvm-try compile-expression ?type ?body ?catches ?finally) - [::&a/jvm-throw ?ex] + [["jvm-throw" ?ex]] (&&host/compile-jvm-throw compile-expression ?type ?ex) - [::&a/jvm-monitorenter ?monitor] + [["jvm-monitorenter" ?monitor]] (&&host/compile-jvm-monitorenter compile-expression ?type ?monitor) - [::&a/jvm-monitorexit ?monitor] + [["jvm-monitorexit" ?monitor]] (&&host/compile-jvm-monitorexit compile-expression ?type ?monitor) - [::&a/jvm-d2f ?value] + [["jvm-d2f" ?value]] (&&host/compile-jvm-d2f compile-expression ?type ?value) - [::&a/jvm-d2i ?value] + [["jvm-d2i" ?value]] (&&host/compile-jvm-d2i compile-expression ?type ?value) - [::&a/jvm-d2l ?value] + [["jvm-d2l" ?value]] (&&host/compile-jvm-d2l compile-expression ?type ?value) - [::&a/jvm-f2d ?value] + [["jvm-f2d" ?value]] (&&host/compile-jvm-f2d compile-expression ?type ?value) - [::&a/jvm-f2i ?value] + [["jvm-f2i" ?value]] (&&host/compile-jvm-f2i compile-expression ?type ?value) - [::&a/jvm-f2l ?value] + [["jvm-f2l" ?value]] (&&host/compile-jvm-f2l compile-expression ?type ?value) - [::&a/jvm-i2b ?value] + [["jvm-i2b" ?value]] (&&host/compile-jvm-i2b compile-expression ?type ?value) - [::&a/jvm-i2c ?value] + [["jvm-i2c" ?value]] (&&host/compile-jvm-i2c compile-expression ?type ?value) - [::&a/jvm-i2d ?value] + [["jvm-i2d" ?value]] (&&host/compile-jvm-i2d compile-expression ?type ?value) - [::&a/jvm-i2f ?value] + [["jvm-i2f" ?value]] (&&host/compile-jvm-i2f compile-expression ?type ?value) - [::&a/jvm-i2l ?value] + [["jvm-i2l" ?value]] (&&host/compile-jvm-i2l compile-expression ?type ?value) - [::&a/jvm-i2s ?value] + [["jvm-i2s" ?value]] (&&host/compile-jvm-i2s compile-expression ?type ?value) - [::&a/jvm-l2d ?value] + [["jvm-l2d" ?value]] (&&host/compile-jvm-l2d compile-expression ?type ?value) - [::&a/jvm-l2f ?value] + [["jvm-l2f" ?value]] (&&host/compile-jvm-l2f compile-expression ?type ?value) - [::&a/jvm-l2i ?value] + [["jvm-l2i" ?value]] (&&host/compile-jvm-l2i compile-expression ?type ?value) - [::&a/jvm-iand ?x y] - (&&host/compile-jvm-iand compile-expression ?type ?x y) + [["jvm-iand" [?x ?y]]] + (&&host/compile-jvm-iand compile-expression ?type ?x ?y) - [::&a/jvm-ior ?x y] - (&&host/compile-jvm-ior compile-expression ?type ?x y) + [["jvm-ior" [?x ?y]]] + (&&host/compile-jvm-ior compile-expression ?type ?x ?y) - [::&a/jvm-land ?x y] - (&&host/compile-jvm-land compile-expression ?type ?x y) + [["jvm-land" [?x ?y]]] + (&&host/compile-jvm-land compile-expression ?type ?x ?y) - [::&a/jvm-lor ?x y] - (&&host/compile-jvm-lor compile-expression ?type ?x y) + [["jvm-lor" [?x ?y]]] + (&&host/compile-jvm-lor compile-expression ?type ?x ?y) - [::&a/jvm-lxor ?x y] - (&&host/compile-jvm-lxor compile-expression ?type ?x y) + [["jvm-lxor" [?x ?y]]] + (&&host/compile-jvm-lxor compile-expression ?type ?x ?y) - [::&a/jvm-lshl ?x y] - (&&host/compile-jvm-lshl compile-expression ?type ?x y) + [["jvm-lshl" [?x ?y]]] + (&&host/compile-jvm-lshl compile-expression ?type ?x ?y) - [::&a/jvm-lshr ?x y] - (&&host/compile-jvm-lshr compile-expression ?type ?x y) + [["jvm-lshr" [?x ?y]]] + (&&host/compile-jvm-lshr compile-expression ?type ?x ?y) - [::&a/jvm-lushr ?x y] - (&&host/compile-jvm-lushr compile-expression ?type ?x y) + [["jvm-lushr" [?x ?y]]] + (&&host/compile-jvm-lushr compile-expression ?type ?x ?y) - [::&a/jvm-program ?body] + [["jvm-program" ?body]] (&&host/compile-jvm-program compile-expression ?type ?body) ) - _ + [_] (fail "[Compiler Error] Can't compile statements as expressions."))) (defn ^:private compile-statement [syntax] ;; (prn 'compile-statement syntax) - (match syntax - [::&a/Statement ?form] - (match ?form - [::&a/def ?name ?body] + (matchv ::M/objects [syntax] + [["Statement" ?form]] + (matchv ::M/objects ?form + [["def" ?name ?body]] (&&lux/compile-def compile-expression ?name ?body) - [::&a/jvm-interface ?package ?name ?methods] + [["jvm-interface" ?package ?name ?methods]] (&&host/compile-jvm-interface compile-expression ?package ?name ?methods) - [::&a/jvm-class ?package ?name ?super-class ?fields ?methods] + [["jvm-class" ?package ?name ?super-class ?fields ?methods]] (&&host/compile-jvm-class compile-expression ?package ?name ?super-class ?fields ?methods)) - _ + [_] (fail "[Compiler Error] Can't compile expressions as top-level forms."))) (defn ^:private eval! [expr] diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj index 394f77d0b..683696537 100644 --- a/src/lux/compiler/base.clj +++ b/src/lux/compiler/base.clj @@ -34,96 +34,97 @@ (return nil))) (defn total-locals [expr] - (match expr - [::&a/case ?variant ?base-register ?num-registers ?branches] - (+ ?num-registers (reduce max 0 (map (comp total-locals second) ?branches))) + (matchv ::M/objects [expr] + [["case" [?variant ?base-register ?num-registers ?branches]]] + (+ ?num-registers (fold max 0 (|map (comp total-locals second) ?branches))) - [::&a/tuple ?members] - (reduce max 0 (map total-locals ?members)) + [["tuple" ?members]] + (fold max 0 (|map total-locals ?members)) - [::&a/variant ?tag ?members] - (reduce max 0 (map total-locals ?members)) + [["variant" ?tag ?value]] + (total-locals ?value) - [::&a/call ?fn ?args] - (reduce max 0 (map total-locals (cons ?fn ?args))) + [["call" [?fn ?args]]] + (fold max 0 (|map total-locals (|cons ?fn ?args))) - [::&a/jvm-iadd ?x ?y] - (reduce max 0 (map total-locals (list ?x ?y))) + [["jvm-iadd" [?x ?y]]] + (fold max 0 (|map total-locals (|list ?x ?y))) - [::&a/jvm-isub ?x ?y] - (reduce max 0 (map total-locals (list ?x ?y))) + [["jvm-isub" [?x ?y]]] + (fold max 0 (|map total-locals (|list ?x ?y))) - [::&a/jvm-imul ?x ?y] - (reduce max 0 (map total-locals (list ?x ?y))) + [["jvm-imul" [?x ?y]]] + (fold max 0 (|map total-locals (|list ?x ?y))) - [::&a/jvm-idiv ?x ?y] - (reduce max 0 (map total-locals (list ?x ?y))) + [["jvm-idiv" [?x ?y]]] + (fold max 0 (|map total-locals (|list ?x ?y))) - [::&a/jvm-irem ?x ?y] - (reduce max 0 (map total-locals (list ?x ?y))) + [["jvm-irem" [?x ?y]]] + (fold max 0 (|map total-locals (|list ?x ?y))) - [::&a/jvm-ladd ?x ?y] - (reduce max 0 (map total-locals (list ?x ?y))) + [["jvm-ladd" [?x ?y]]] + (fold max 0 (|map total-locals (|list ?x ?y))) - [::&a/jvm-lsub ?x ?y] - (reduce max 0 (map total-locals (list ?x ?y))) + [["jvm-lsub" [?x ?y]]] + (fold max 0 (|map total-locals (|list ?x ?y))) - [::&a/jvm-lmul ?x ?y] - (reduce max 0 (map total-locals (list ?x ?y))) + [["jvm-lmul" [?x ?y]]] + (fold max 0 (|map total-locals (|list ?x ?y))) - [::&a/jvm-ldiv ?x ?y] - (reduce max 0 (map total-locals (list ?x ?y))) + [["jvm-ldiv" [?x ?y]]] + (fold max 0 (|map total-locals (|list ?x ?y))) - [::&a/jvm-lrem ?x ?y] - (reduce max 0 (map total-locals (list ?x ?y))) + [["jvm-lrem" [?x ?y]]] + (fold max 0 (|map total-locals (|list ?x ?y))) - [::&a/jvm-fadd ?x ?y] - (reduce max 0 (map total-locals (list ?x ?y))) + [["jvm-fadd" [?x ?y]]] + (fold max 0 (|map total-locals (|list ?x ?y))) - [::&a/jvm-fsub ?x ?y] - (reduce max 0 (map total-locals (list ?x ?y))) + [["jvm-fsub" [?x ?y]]] + (fold max 0 (|map total-locals (|list ?x ?y))) - [::&a/jvm-fmul ?x ?y] - (reduce max 0 (map total-locals (list ?x ?y))) + [["jvm-fmul" [?x ?y]]] + (fold max 0 (|map total-locals (|list ?x ?y))) - [::&a/jvm-fdiv ?x ?y] - (reduce max 0 (map total-locals (list ?x ?y))) + [["jvm-fdiv" [?x ?y]]] + (fold max 0 (|map total-locals (|list ?x ?y))) - [::&a/jvm-frem ?x ?y] - (reduce max 0 (map total-locals (list ?x ?y))) + [["jvm-frem" [?x ?y]]] + (fold max 0 (|map total-locals (|list ?x ?y))) - [::&a/jvm-dadd ?x ?y] - (reduce max 0 (map total-locals (list ?x ?y))) + [["jvm-dadd" [?x ?y]]] + (fold max 0 (|map total-locals (|list ?x ?y))) - [::&a/jvm-dsub ?x ?y] - (reduce max 0 (map total-locals (list ?x ?y))) + [["jvm-dsub" [?x ?y]]] + (fold max 0 (|map total-locals (|list ?x ?y))) - [::&a/jvm-dmul ?x ?y] - (reduce max 0 (map total-locals (list ?x ?y))) + [["jvm-dmul" [?x ?y]]] + (fold max 0 (|map total-locals (|list ?x ?y))) - [::&a/jvm-ddiv ?x ?y] - (reduce max 0 (map total-locals (list ?x ?y))) + [["jvm-ddiv" [?x ?y]]] + (fold max 0 (|map total-locals (|list ?x ?y))) - [::&a/jvm-drem ?x ?y] - (reduce max 0 (map total-locals (list ?x ?y))) + [["jvm-drem" [?x ?y]]] + (fold max 0 (|map total-locals (|list ?x ?y))) - [::&a/exec ?exprs] - (reduce max 0 (map total-locals ?exprs)) + [["exec" ?exprs]] + (fold max 0 (|map total-locals ?exprs)) - [::&a/jvm-new ?class ?classes ?args] - (reduce max 0 (map total-locals ?args)) + [["jvm-new" [?class ?classes ?args]]] + (fold max 0 (|map total-locals ?args)) - [::&a/jvm-invokestatic ?class ?method ?classes ?args] - (reduce max 0 (map total-locals ?args)) + [["jvm-invokestatic" [?class ?method ?classes ?args]]] + (fold max 0 (|map total-locals ?args)) - [::&a/jvm-invokevirtual ?class ?method ?classes ?object ?args] - (reduce max 0 (map total-locals ?args)) + [["jvm-invokevirtual" [?class ?method ?classes ?object ?args]]] + (fold max 0 (|map total-locals ?args)) - [::&a/jvm-aastore ?array ?idx ?elem] - (reduce max 0 (map total-locals (list ?array ?elem))) + [["jvm-aastore" [?array ?idx ?elem]]] + (fold max 0 (|map total-locals (|list ?array ?elem))) - [::&a/jvm-aaload ?array ?idx] + [["jvm-aaload" [?array ?idx]]] (total-locals ?array) - _ - 0)) + ;; [_] + ;; 0 + )) diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj index 4f39e5c66..8d9c129c5 100644 --- a/src/lux/compiler/case.clj +++ b/src/lux/compiler/case.clj @@ -22,22 +22,22 @@ (defn ^:private ->match [$body register token] (matchv ::M/objects [token] [["Ident" ?name]] - [(inc register) [::Pattern $body [::StoreMatch register]]] + [(inc register) (&/V "Pattern" (&/T $body [&/V "StoreMatch" register]))] [["Bool" ?value]] - [register [::Pattern $body [::BoolMatch ?value]]] + [register (&/V "Pattern" (&/T $body [&/V "BoolMatch" ?value]))] [["Int" ?value]] - [register [::Pattern $body [::IntMatch ?value]]] + [register (&/V "Pattern" (&/T $body [&/V "IntMatch" ?value]))] [["Real" ?value]] - [register [::Pattern $body [::RealMatch ?value]]] + [register (&/V "Pattern" (&/T $body [&/V "RealMatch" ?value]))] [["Char" ?value]] - [register [::Pattern $body [::CharMatch ?value]]] + [register (&/V "Pattern" (&/T $body [&/V "CharMatch" ?value]))] [["Text" ?value]] - [register [::Pattern $body [::TextMatch ?value]]] + [register (&/V "Pattern" (&/T $body [&/V "TextMatch" ?value]))] [["Tuple" ?members]] (let [[register* =members] (reduce (fn [[register =members] member] @@ -45,17 +45,17 @@ [register* (cons =member =members)])) [register (list)] (&/->seq ?members))] - [register* [::Pattern $body [::TupleMatch (reverse =members)]]]) + [register* (&/V "Pattern" (&/T $body [&/V "TupleMatch" (reverse =members)]))]) [["Tag" ?tag]] - [register [::Pattern $body [::VariantMatch ?tag [::Pattern $body [::TupleMatch (list)]]]]] + [register (&/V "Pattern" (&/T $body [&/V "VariantMatch" (&/T ?tag [&/V "Pattern" (&/T $body [&/V "TupleMatch" (list)])])]))] [["Form" ["Cons" [["Tag" ?tag] ["Cons" [?value ["Nil" _]]]]]]] (let [[register* =value] (->match $body register ?value)] - [register* [::Pattern $body [::VariantMatch ?tag =value]]]) + [register* (&/V "Pattern" (&/T $body [&/V "VariantMatch" (&/T ?tag =value)]))]) )) (defn ^:private process-branches [base-register branches] @@ -70,13 +70,13 @@ +oclass+ (&host/->class "java.lang.Object") +equals-sig+ (str "(" (&host/->type-signature "java.lang.Object") ")Z")] (defn ^:private compile-match [writer ?match $target $else] - (match ?match - [::StoreMatch ?register] + (matchv ::M/objects [?match] + [["StoreMatch" ?register]] (doto writer (.visitVarInsn Opcodes/ASTORE ?register) (.visitJumpInsn Opcodes/GOTO $target)) - [::BoolMatch ?value] + [["BoolMatch" ?value]] (doto writer (.visitInsn Opcodes/DUP) (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class "java.lang.Boolean") "booleanValue" "()Z") @@ -85,7 +85,7 @@ (.visitInsn Opcodes/POP) (.visitJumpInsn Opcodes/GOTO $target)) - [::IntMatch ?value] + [["IntMatch" ?value]] (doto writer (.visitInsn Opcodes/DUP) (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class "java.lang.Long") "longValue" "()J") @@ -95,7 +95,7 @@ (.visitInsn Opcodes/POP) (.visitJumpInsn Opcodes/GOTO $target)) - [::RealMatch ?value] + [["RealMatch" ?value]] (doto writer (.visitInsn Opcodes/DUP) (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class "java.lang.Double") "doubleValue" "()D") @@ -105,7 +105,7 @@ (.visitInsn Opcodes/POP) (.visitJumpInsn Opcodes/GOTO $target)) - [::CharMatch ?value] + [["CharMatch" ?value]] (doto writer (.visitInsn Opcodes/DUP) (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class "java.lang.Character") "charValue" "()C") @@ -114,7 +114,7 @@ (.visitInsn Opcodes/POP) (.visitJumpInsn Opcodes/GOTO $target)) - [::TextMatch ?value] + [["TextMatch" ?value]] (doto writer (.visitInsn Opcodes/DUP) (.visitLdcInsn ?value) @@ -123,7 +123,7 @@ (.visitInsn Opcodes/POP) (.visitJumpInsn Opcodes/GOTO $target)) - [::TupleMatch ?members] + [["TupleMatch" ?members]] (doto writer (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") (-> (doto (.visitInsn Opcodes/DUP) @@ -140,7 +140,7 @@ (.visitInsn Opcodes/POP) (.visitJumpInsn Opcodes/GOTO $target)) - [::VariantMatch ?tag [::Pattern _ ?value]] + [["VariantMatch" [?tag ["Pattern" [_ ?value]]]]] (doto writer (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") (.visitInsn Opcodes/DUP) diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj index c6595fc5e..1ebfb1568 100644 --- a/src/lux/compiler/lambda.clj +++ b/src/lux/compiler/lambda.clj @@ -41,8 +41,8 @@ (.visitVarInsn Opcodes/ALOAD (inc ?captured-id)) (.visitFieldInsn Opcodes/PUTFIELD class-name captured-name clo-field-sig)) (->> (let [captured-name (str &&/closure-prefix ?captured-id)]) - (match ?captured - [::&a/Expression [::&a/captured _ ?captured-id ?source] _]) + (matchv ::M/objects [?captured] + [["Expression" [["captured" [_ ?captured-id ?source]] _]]]) (doseq [[?name ?captured] env]))) (.visitInsn Opcodes/RETURN) (.visitMaxs 0 0) @@ -83,13 +83,13 @@ (.visitTypeInsn Opcodes/NEW lambda-class) (.visitInsn Opcodes/DUP))] _ (->> closed-over - (sort #(match [(second %1) (second %2)] - [[::&a/Expression [::&a/captured _ ?cid1 _] _] - [::&a/Expression [::&a/captured _ ?cid2 _] _]] + (sort #(matchv ::M/objects [(second %1) (second %2)] + [["Expression" [["captured" [_ ?cid1 _]] _]] + ["Expression" [["captured" [_ ?cid2 _]] _]]] (< ?cid1 ?cid2))) (map-m (fn [[?name ?captured]] - (match ?captured - [::&a/Expression [::&a/captured _ _ ?source] _] + (matchv ::M/objects [?captured] + [["Expression" [["captured" [_ _ ?source]] _]]] (compile ?source))))) :let [_ (.visitMethodInsn *writer* Opcodes/INVOKESPECIAL lambda-class "<init>" init-signature)]] (return nil))) @@ -104,8 +104,8 @@ (-> (doto (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) captured-name clo-field-sig nil nil) (.visitEnd)) (->> (let [captured-name (str &&/closure-prefix ?captured-id)]) - (match ?captured - [::&a/Expression [::&a/captured _ ?captured-id ?source] _]) + (matchv ::M/objects [?captured] + [["Expression" [["captured" [_ ?captured-id ?source]] _]]]) (doseq [[?name ?captured] ?env ;; :let [_ (prn '?captured ?captured)] ]))) |