diff options
Diffstat (limited to '')
| -rw-r--r-- | src/lux/analyser/case.clj | 145 | ||||
| -rw-r--r-- | src/lux/analyser/env.clj | 2 | ||||
| -rw-r--r-- | src/lux/analyser/lux.clj | 10 | ||||
| -rw-r--r-- | src/lux/base.clj | 5 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 4 | ||||
| -rw-r--r-- | src/lux/compiler/case.clj | 19 |
6 files changed, 108 insertions, 77 deletions
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index aaf11ff15..6cf070a52 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -9,12 +9,37 @@ (ns lux.analyser.case (:require clojure.core.match clojure.core.match.array - (lux [base :as & :refer [|do return fail |let |case]] + (lux [base :as & :refer [deftags |do return fail |let |case]] [parser :as &parser] [type :as &type]) (lux.analyser [base :as &&] [env :as &env]))) +;; [Tags] +(deftags "" + "DefaultTotal" + "BoolTotal" + "IntTotal" + "RealTotal" + "CharTotal" + "TextTotal" + "TupleTotal" + "RecordTotal" + "VariantTotal" + ) + +(deftags "" + "StoreTestAC" + "BoolTestAC" + "IntTestAC" + "RealTestAC" + "CharTestAC" + "TextTestAC" + "TupleTestAC" + "RecordTestAC" + "VariantTestAC" + ) + ;; [Utils] (def ^:private unit (&/V &/$Meta (&/T (&/T "" -1 -1) (&/V &/$TupleS (&/|list))))) @@ -119,7 +144,7 @@ (|do [=kont (&env/with-local name value-type kont) idx &env/next-local-idx] - (return (&/T (&/V "StoreTestAC" idx) =kont))) + (return (&/T (&/V $StoreTestAC idx) =kont))) (&/$SymbolS ident) (fail (str "[Pattern-matching Error] Symbols must be unqualified: " (&/ident->text ident))) @@ -127,27 +152,27 @@ (&/$BoolS ?value) (|do [_ (&type/check value-type &type/Bool) =kont kont] - (return (&/T (&/V "BoolTestAC" ?value) =kont))) + (return (&/T (&/V $BoolTestAC ?value) =kont))) (&/$IntS ?value) (|do [_ (&type/check value-type &type/Int) =kont kont] - (return (&/T (&/V "IntTestAC" ?value) =kont))) + (return (&/T (&/V $IntTestAC ?value) =kont))) (&/$RealS ?value) (|do [_ (&type/check value-type &type/Real) =kont kont] - (return (&/T (&/V "RealTestAC" ?value) =kont))) + (return (&/T (&/V $RealTestAC ?value) =kont))) (&/$CharS ?value) (|do [_ (&type/check value-type &type/Char) =kont kont] - (return (&/T (&/V "CharTestAC" ?value) =kont))) + (return (&/T (&/V $CharTestAC ?value) =kont))) (&/$TextS ?value) (|do [_ (&type/check value-type &type/Text) =kont kont] - (return (&/T (&/V "TextTestAC" ?value) =kont))) + (return (&/T (&/V $TextTestAC ?value) =kont))) (&/$TupleS ?members) (|do [value-type* (adjust-type value-type)] @@ -164,7 +189,7 @@ (|do [=kont kont] (return (&/T (&/|list) =kont))) (&/|reverse (&/zip2 ?member-types ?members)))] - (return (&/T (&/V "TupleTestAC" =tests) =kont))))) + (return (&/T (&/V $TupleTestAC =tests) =kont))))) _ (fail (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type*)))))) @@ -194,7 +219,7 @@ (|do [=kont kont] (return (&/T (&/|table) =kont))) (&/|reverse ?slots))] - (return (&/T (&/V "RecordTestAC" =tests) =kont)))) + (return (&/T (&/V $RecordTestAC =tests) =kont)))) _ (fail "[Pattern-matching Error] Record requires record-type."))) @@ -204,7 +229,7 @@ value-type* (adjust-type value-type) case-type (&type/variant-case =tag value-type*) [=test =kont] (analyse-pattern case-type unit kont)] - (return (&/T (&/V "VariantTestAC" (&/T =tag =test)) =kont))) + (return (&/T (&/V $VariantTestAC (&/T =tag =test)) =kont))) (&/$FormS (&/$Cons (&/$Meta _ (&/$TagS ?ident)) ?values)) @@ -216,7 +241,7 @@ 1 (analyse-pattern case-type (&/|head ?values) kont) ;; 1+ (analyse-pattern case-type (&/V &/$Meta (&/T (&/T "" -1 -1) (&/V &/$TupleS ?values))) kont))] - (return (&/T (&/V "VariantTestAC" (&/T =tag =test)) =kont))) + (return (&/T (&/V $VariantTestAC (&/T =tag =test)) =kont))) ))) (defn ^:private analyse-branch [analyse exo-type value-type pattern body patterns] @@ -228,68 +253,68 @@ (defn ^:private merge-total [struct test+body] (|let [[test ?body] test+body] (|case [struct test] - [("DefaultTotal" total?) ("StoreTestAC" ?idx)] - (return (&/V "DefaultTotal" true)) + [($DefaultTotal total?) ($StoreTestAC ?idx)] + (return (&/V $DefaultTotal true)) - [[?tag [total? ?values]] ("StoreTestAC" ?idx)] + [[?tag [total? ?values]] ($StoreTestAC ?idx)] (return (&/V ?tag (&/T true ?values))) - [("DefaultTotal" total?) ("BoolTestAC" ?value)] - (return (&/V "BoolTotal" (&/T total? (&/|list ?value)))) + [($DefaultTotal total?) ($BoolTestAC ?value)] + (return (&/V $BoolTotal (&/T total? (&/|list ?value)))) - [("BoolTotal" total? ?values) ("BoolTestAC" ?value)] - (return (&/V "BoolTotal" (&/T total? (&/|cons ?value ?values)))) + [($BoolTotal total? ?values) ($BoolTestAC ?value)] + (return (&/V $BoolTotal (&/T total? (&/|cons ?value ?values)))) - [("DefaultTotal" total?) ("IntTestAC" ?value)] - (return (&/V "IntTotal" (&/T total? (&/|list ?value)))) + [($DefaultTotal total?) ($IntTestAC ?value)] + (return (&/V $IntTotal (&/T total? (&/|list ?value)))) - [("IntTotal" total? ?values) ("IntTestAC" ?value)] - (return (&/V "IntTotal" (&/T total? (&/|cons ?value ?values)))) + [($IntTotal total? ?values) ($IntTestAC ?value)] + (return (&/V $IntTotal (&/T total? (&/|cons ?value ?values)))) - [("DefaultTotal" total?) ("RealTestAC" ?value)] - (return (&/V "RealTotal" (&/T total? (&/|list ?value)))) + [($DefaultTotal total?) ($RealTestAC ?value)] + (return (&/V $RealTotal (&/T total? (&/|list ?value)))) - [("RealTotal" total? ?values) ("RealTestAC" ?value)] - (return (&/V "RealTotal" (&/T total? (&/|cons ?value ?values)))) + [($RealTotal total? ?values) ($RealTestAC ?value)] + (return (&/V $RealTotal (&/T total? (&/|cons ?value ?values)))) - [("DefaultTotal" total?) ("CharTestAC" ?value)] - (return (&/V "CharTotal" (&/T total? (&/|list ?value)))) + [($DefaultTotal total?) ($CharTestAC ?value)] + (return (&/V $CharTotal (&/T total? (&/|list ?value)))) - [("CharTotal" total? ?values) ("CharTestAC" ?value)] - (return (&/V "CharTotal" (&/T total? (&/|cons ?value ?values)))) + [($CharTotal total? ?values) ($CharTestAC ?value)] + (return (&/V $CharTotal (&/T total? (&/|cons ?value ?values)))) - [("DefaultTotal" total?) ("TextTestAC" ?value)] - (return (&/V "TextTotal" (&/T total? (&/|list ?value)))) + [($DefaultTotal total?) ($TextTestAC ?value)] + (return (&/V $TextTotal (&/T total? (&/|list ?value)))) - [("TextTotal" total? ?values) ("TextTestAC" ?value)] - (return (&/V "TextTotal" (&/T total? (&/|cons ?value ?values)))) + [($TextTotal total? ?values) ($TextTestAC ?value)] + (return (&/V $TextTotal (&/T total? (&/|cons ?value ?values)))) - [("DefaultTotal" total?) ("TupleTestAC" ?tests)] + [($DefaultTotal total?) ($TupleTestAC ?tests)] (|do [structs (&/map% (fn [t] - (merge-total (&/V "DefaultTotal" total?) (&/T t ?body))) + (merge-total (&/V $DefaultTotal total?) (&/T t ?body))) ?tests)] - (return (&/V "TupleTotal" (&/T total? structs)))) + (return (&/V $TupleTotal (&/T total? structs)))) - [("TupleTotal" total? ?values) ("TupleTestAC" ?tests)] + [($TupleTotal total? ?values) ($TupleTestAC ?tests)] (if (.equals ^Object (&/|length ?values) (&/|length ?tests)) (|do [structs (&/map2% (fn [v t] (merge-total v (&/T t ?body))) ?values ?tests)] - (return (&/V "TupleTotal" (&/T total? structs)))) + (return (&/V $TupleTotal (&/T total? structs)))) (fail "[Pattern-matching Error] Inconsistent tuple-size.")) - [("DefaultTotal" total?) ("RecordTestAC" ?tests)] + [($DefaultTotal total?) ($RecordTestAC ?tests)] (|do [structs (&/map% (fn [t] (|let [[slot value] t] - (|do [struct* (merge-total (&/V "DefaultTotal" total?) (&/T value ?body))] + (|do [struct* (merge-total (&/V $DefaultTotal total?) (&/T value ?body))] (return (&/T slot struct*))))) (->> ?tests &/->seq (sort compare-kv) &/->list))] - (return (&/V "RecordTotal" (&/T total? structs)))) + (return (&/V $RecordTotal (&/T total? structs)))) - [("RecordTotal" total? ?values) ("RecordTestAC" ?tests)] + [($RecordTotal total? ?values) ($RecordTestAC ?tests)] (if (.equals ^Object (&/|length ?values) (&/|length ?tests)) (|do [structs (&/map2% (fn [left right] (|let [[lslot sub-struct] left @@ -303,40 +328,40 @@ &/->seq (sort compare-kv) &/->list))] - (return (&/V "RecordTotal" (&/T total? structs)))) + (return (&/V $RecordTotal (&/T total? structs)))) (fail "[Pattern-matching Error] Inconsistent record-size.")) - [("DefaultTotal" total?) ("VariantTestAC" ?tag ?test)] - (|do [sub-struct (merge-total (&/V "DefaultTotal" total?) + [($DefaultTotal total?) ($VariantTestAC ?tag ?test)] + (|do [sub-struct (merge-total (&/V $DefaultTotal total?) (&/T ?test ?body))] - (return (&/V "VariantTotal" (&/T total? (&/|put ?tag sub-struct (&/|table)))))) + (return (&/V $VariantTotal (&/T total? (&/|put ?tag sub-struct (&/|table)))))) - [("VariantTotal" total? ?branches) ("VariantTestAC" ?tag ?test)] + [($VariantTotal total? ?branches) ($VariantTestAC ?tag ?test)] (|do [sub-struct (merge-total (or (&/|get ?tag ?branches) - (&/V "DefaultTotal" total?)) + (&/V $DefaultTotal total?)) (&/T ?test ?body))] - (return (&/V "VariantTotal" (&/T total? (&/|put ?tag sub-struct ?branches))))) + (return (&/V $VariantTotal (&/T total? (&/|put ?tag sub-struct ?branches))))) )))) (defn ^:private check-totality [value-type struct] (|case struct - ("BoolTotal" ?total ?values) + ($BoolTotal ?total ?values) (return (or ?total (= #{true false} (set (&/->seq ?values))))) - ("IntTotal" ?total _) + ($IntTotal ?total _) (return ?total) - ("RealTotal" ?total _) + ($RealTotal ?total _) (return ?total) - ("CharTotal" ?total _) + ($CharTotal ?total _) (return ?total) - ("TextTotal" ?total _) + ($TextTotal ?total _) (return ?total) - ("TupleTotal" ?total ?structs) + ($TupleTotal ?total ?structs) (if ?total (return true) (|do [value-type* (resolve-type value-type)] @@ -350,7 +375,7 @@ _ (fail "[Pattern-maching Error] Tuple is not total.")))) - ("RecordTotal" ?total ?structs) + ($RecordTotal ?total ?structs) (if ?total (return true) (|do [value-type* (resolve-type value-type)] @@ -367,7 +392,7 @@ _ (fail "[Pattern-maching Error] Record is not total.")))) - ("VariantTotal" ?total ?structs) + ($VariantTotal ?total ?structs) (if ?total (return true) (|do [value-type* (resolve-type value-type)] @@ -384,7 +409,7 @@ _ (fail "[Pattern-maching Error] Variant is not total.")))) - ("DefaultTotal" ?total) + ($DefaultTotal ?total) (return ?total) )) @@ -395,7 +420,7 @@ (analyse-branch analyse exo-type value-type pattern body patterns))) (&/|list) branches) - struct (&/fold% merge-total (&/V "DefaultTotal" false) patterns) + struct (&/fold% merge-total (&/V $DefaultTotal false) patterns) ? (check-totality value-type struct)] (if ? (return patterns) diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj index 9a8a6a3d7..2f35218d8 100644 --- a/src/lux/analyser/env.clj +++ b/src/lux/analyser/env.clj @@ -24,7 +24,7 @@ (let [old-mappings (->> state (&/get$ &/$ENVS) &/|head (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS)) =return (body (&/update$ &/$ENVS (fn [stack] - (let [bound-unit (&/V "lux;Local" (->> (&/|head stack) (&/get$ &/$LOCALS) (&/get$ &/$COUNTER)))] + (let [bound-unit (&/V &/$Local (->> (&/|head stack) (&/get$ &/$LOCALS) (&/get$ &/$COUNTER)))] (&/|cons (&/update$ &/$LOCALS #(->> % (&/update$ &/$COUNTER inc) (&/update$ &/$MAPPINGS (fn [m] (&/|put name (&/T bound-unit type) m)))) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 6503fe2ea..843cfef96 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -157,7 +157,7 @@ (clojure.lang.Util/identical &type/Type exo-type)) (return nil) (&type/check exo-type endo-type))] - (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name)) + (return (&/|list (&/T (&/V &/$Global (&/T r-module r-name)) endo-type))))) (defn ^:private analyse-local [analyse exo-type name] @@ -177,7 +177,7 @@ (if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get name))] (do ;; (prn 'analyse-symbol/_2.1 ?module name name (aget global 0)) (|case global - [("lux;Global" ?module* name*) _] + [(&/$Global ?module* name*) _] ((|do [[[r-module r-name] $def] (&&module/find-def ?module* name*) ;; :let [_ (prn 'analyse-symbol/_2.1.1 r-module r-name)] endo-type (|case $def @@ -193,7 +193,7 @@ (clojure.lang.Util/identical &type/Type exo-type)) (return nil) (&type/check exo-type endo-type))] - (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name)) + (return (&/|list (&/T (&/V &/$Global (&/T r-module r-name)) endo-type)))) state) @@ -272,7 +272,7 @@ (|do [loader &/loader] (|let [[=fn-form =fn-type] =fn] (|case =fn-form - ("lux;Global" ?module ?name) + (&/$Global ?module ?name) (|do [[[r-module r-name] $def] (&&module/find-def ?module ?name)] (|case $def ("lux;MacroD" macro) @@ -387,7 +387,7 @@ (analyse-1+ analyse ?value)) =value-type (&&/expr-type =value)] (|case =value - [("lux;Global" ?r-module ?r-name) _] + [(&/$Global ?r-module ?r-name) _] (|do [_ (&&module/def-alias module-name ?name ?r-module ?r-name =value-type) ;; :let [_ (println 'analyse-def/ALIAS (str module-name ";" ?name) '=> (str ?r-module ";" ?r-name)) ;; _ (println)] diff --git a/src/lux/base.clj b/src/lux/base.clj index 66b972f94..b496be449 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -82,6 +82,11 @@ (def $SOURCE 7) (def $TYPES 8) +;; Vars +(deftags "lux;" + "Local" + "Global") + ;; [Exports] (def +name-separator+ ";") diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 86359d26e..2565c3b20 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -61,13 +61,13 @@ ("record" ?elems) (&&lux/compile-record compile-expression ?type ?elems) - ("lux;Local" ?idx) + (&/$Local ?idx) (&&lux/compile-local compile-expression ?type ?idx) ("captured" ?scope ?captured-id ?source) (&&lux/compile-captured compile-expression ?type ?scope ?captured-id ?source) - ("lux;Global" ?owner-class ?name) + (&/$Global ?owner-class ?name) (&&lux/compile-global compile-expression ?type ?owner-class ?name) ("apply" ?fn ?args) diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj index d27577be1..e2cbe77a2 100644 --- a/src/lux/compiler/case.clj +++ b/src/lux/compiler/case.clj @@ -17,6 +17,7 @@ [parser :as &parser] [analyser :as &analyser] [host :as &host]) + [lux.analyser.case :as &a-case] [lux.compiler.base :as &&]) (:import (org.objectweb.asm Opcodes Label @@ -27,12 +28,12 @@ (let [compare-kv #(.compareTo ^String (aget ^objects %1 0) ^String (aget ^objects %2 0))] (defn ^:private compile-match [^MethodVisitor writer ?match $target $else] (|case ?match - ("StoreTestAC" ?idx) + (&a-case/$StoreTestAC ?idx) (doto writer (.visitVarInsn Opcodes/ASTORE ?idx) (.visitJumpInsn Opcodes/GOTO $target)) - ("BoolTestAC" ?value) + (&a-case/$BoolTestAC ?value) (doto writer (.visitTypeInsn Opcodes/CHECKCAST "java/lang/Boolean") (.visitInsn Opcodes/DUP) @@ -42,7 +43,7 @@ (.visitInsn Opcodes/POP) (.visitJumpInsn Opcodes/GOTO $target)) - ("IntTestAC" ?value) + (&a-case/$IntTestAC ?value) (doto writer (.visitTypeInsn Opcodes/CHECKCAST "java/lang/Long") (.visitInsn Opcodes/DUP) @@ -53,7 +54,7 @@ (.visitInsn Opcodes/POP) (.visitJumpInsn Opcodes/GOTO $target)) - ("RealTestAC" ?value) + (&a-case/$RealTestAC ?value) (doto writer (.visitTypeInsn Opcodes/CHECKCAST "java/lang/Double") (.visitInsn Opcodes/DUP) @@ -64,7 +65,7 @@ (.visitInsn Opcodes/POP) (.visitJumpInsn Opcodes/GOTO $target)) - ("CharTestAC" ?value) + (&a-case/$CharTestAC ?value) (doto writer (.visitTypeInsn Opcodes/CHECKCAST "java/lang/Character") (.visitInsn Opcodes/DUP) @@ -74,7 +75,7 @@ (.visitInsn Opcodes/POP) (.visitJumpInsn Opcodes/GOTO $target)) - ("TextTestAC" ?value) + (&a-case/$TextTestAC ?value) (doto writer (.visitInsn Opcodes/DUP) (.visitLdcInsn ?value) @@ -83,7 +84,7 @@ (.visitInsn Opcodes/POP) (.visitJumpInsn Opcodes/GOTO $target)) - ("TupleTestAC" ?members) + (&a-case/$TupleTestAC ?members) (doto writer (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") (-> (doto (.visitInsn Opcodes/DUP) @@ -101,7 +102,7 @@ (.visitInsn Opcodes/POP) (.visitJumpInsn Opcodes/GOTO $target)) - ("RecordTestAC" ?slots) + (&a-case/$RecordTestAC ?slots) (doto writer (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") (-> (doto (.visitInsn Opcodes/DUP) @@ -124,7 +125,7 @@ (.visitInsn Opcodes/POP) (.visitJumpInsn Opcodes/GOTO $target)) - ("VariantTestAC" ?tag ?test) + (&a-case/$VariantTestAC ?tag ?test) (doto writer (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") (.visitInsn Opcodes/DUP) |