aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser/case.clj145
-rw-r--r--src/lux/analyser/env.clj2
-rw-r--r--src/lux/analyser/lux.clj10
-rw-r--r--src/lux/base.clj5
-rw-r--r--src/lux/compiler.clj4
-rw-r--r--src/lux/compiler/case.clj19
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)