aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/lux/analyser.clj12
-rw-r--r--src/lux/analyser/host.clj2
-rw-r--r--src/lux/analyser/lux.clj17
-rw-r--r--src/lux/analyser/parser.clj2
-rw-r--r--src/lux/base.clj25
-rw-r--r--src/lux/compiler.clj4
-rw-r--r--src/lux/compiler/base.clj1
-rw-r--r--src/lux/compiler/case.clj43
-rw-r--r--src/lux/compiler/host.clj52
-rw-r--r--src/lux/compiler/lux.clj16
-rw-r--r--src/lux/compiler/type.clj4
-rw-r--r--src/lux/lexer.clj2
-rw-r--r--src/lux/type.clj4
-rw-r--r--src/lux/type/host.clj4
14 files changed, 123 insertions, 65 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index f143e2a12..e261420c3 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -21,19 +21,21 @@
;; [Utils]
(defn analyse-variant+ [analyser exo-type ident values]
(|do [[module tag-name] (&/normalize ident)
- idx (&&module/tag-index module tag-name)]
+ idx (&&module/tag-index module tag-name)
+ group (&&module/tag-group module tag-name)
+ :let [is-last? (= idx (dec (&/|length group)))]]
(|case exo-type
(&/$VarT id)
(|do [? (&type/bound? id)]
(if (or ? (&&/type-tag? module tag-name))
- (&&lux/analyse-variant analyser (&/V &/$Right exo-type) idx values)
+ (&&lux/analyse-variant analyser (&/V &/$Right exo-type) idx is-last? values)
(|do [wanted-type (&&module/tag-type module tag-name)
- [[variant-type variant-cursor] variant-analysis] (&&/cap-1 (&&lux/analyse-variant analyser (&/V &/$Left wanted-type) idx values))
+ [[variant-type variant-cursor] variant-analysis] (&&/cap-1 (&&lux/analyse-variant analyser (&/V &/$Left wanted-type) idx is-last? values))
_ (&type/check exo-type variant-type)]
(return (&/|list (&&/|meta exo-type variant-cursor variant-analysis))))))
_
- (&&lux/analyse-variant analyser (&/V &/$Right exo-type) idx values)
+ (&&lux/analyse-variant analyser (&/V &/$Right exo-type) idx is-last? values)
)))
(defn ^:private add-loc [meta ^String msg]
@@ -661,7 +663,7 @@
(&/with-expected-type exo-type
(|case token
[meta (&/$FormS (&/$Cons [_ (&/$IntS idx)] ?values))]
- (&&lux/analyse-variant (partial analyse-ast eval! compile-module compile-token) (&/V &/$Right exo-type) idx ?values)
+ (&&lux/analyse-variant (partial analyse-ast eval! compile-module compile-token) (&/V &/$Right exo-type) idx nil ?values)
[meta (&/$FormS (&/$Cons [_ (&/$TagS ?ident)] ?values))]
(analyse-variant+ (partial analyse-ast eval! compile-module compile-token) exo-type ?ident ?values)
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 86e73723d..24a67be87 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -341,7 +341,7 @@
_ (&type/check exo-type output-type)
_cursor &/cursor]
(return (&/|list (&&/|meta output-type _cursor
- (&/V &&/$jvm-null nil))))))
+ (&/V &&/$jvm-null &/unit-tag))))))
(defn ^:private analyse-jvm-new-helper [analyse gtype gtype-env gtype-vars gtype-args args]
(|case gtype-vars
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 68e329af2..7adc32b22 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -158,7 +158,7 @@
_
(fail "[Analyser Error] Can't expand to other than 1 element."))))
-(defn analyse-variant [analyse ?exo-type idx ?values]
+(defn analyse-variant [analyse ?exo-type idx is-last? ?values]
(|case ?exo-type
(&/$Left exo-type)
(|do [exo-type* (&type/actual-type exo-type)]
@@ -167,7 +167,7 @@
(&type/with-var
(fn [$var]
(|do [exo-type** (&type/apply-type exo-type* $var)
- [[variant-type variant-cursor] variant-analysis] (&&/cap-1 (analyse-variant analyse (&/V &/$Left exo-type**) idx ?values))
+ [[variant-type variant-cursor] variant-analysis] (&&/cap-1 (analyse-variant analyse (&/V &/$Left exo-type**) idx is-last? ?values))
=var (&type/resolve-type $var)
inferred-type (|case =var
(&/$VarT iid)
@@ -182,7 +182,7 @@
variant-analysis))))))
_
- (analyse-variant analyse (&/V &/$Right exo-type*) idx ?values)))
+ (analyse-variant analyse (&/V &/$Right exo-type*) idx is-last? ?values)))
(&/$Right exo-type)
(|do [exo-type* (|case exo-type
@@ -198,6 +198,9 @@
(|case exo-type*
(&/$SumT _)
(|do [vtype (&type/sum-at idx exo-type*)
+ :let [is-last?* (if (nil? is-last?)
+ (= idx (dec (&/|length (&type/flatten-sum exo-type*))))
+ is-last?)]
=value (&/with-attempt
(analyse-variant-body analyse vtype ?values)
(fn [err]
@@ -208,23 +211,23 @@
_
(return exo-type))]
(fail (str err "\n"
- 'analyse-variant " " idx " " (&type/show-type exo-type) " " (&type/show-type _exo-type)
+ 'analyse-variant " " idx " " is-last? " " is-last?* " " (&type/show-type exo-type) " " (&type/show-type _exo-type)
" " (->> ?values (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))))))
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$variant (&/T [idx =value]))
+ (&/V &&/$variant (&/T [idx is-last?* =value]))
))))
(&/$UnivQ _)
(|do [$var &type/existential
exo-type** (&type/apply-type exo-type* $var)]
- (analyse-variant analyse (&/V &/$Right exo-type**) idx ?values))
+ (analyse-variant analyse (&/V &/$Right exo-type**) idx is-last? ?values))
(&/$ExQ _)
(&type/with-var
(fn [$var]
(|do [exo-type** (&type/apply-type exo-type* $var)]
- (analyse-variant analyse (&/V &/$Right exo-type**) idx ?values))))
+ (analyse-variant analyse (&/V &/$Right exo-type**) idx is-last? ?values))))
_
(fail (str "[Analyser Error] Can't create variant if the expected type is " (&type/show-type exo-type*))))
diff --git a/src/lux/analyser/parser.clj b/src/lux/analyser/parser.clj
index 611d65a83..f30b73692 100644
--- a/src/lux/analyser/parser.clj
+++ b/src/lux/analyser/parser.clj
@@ -38,7 +38,7 @@
(defn parse-gclass [ast]
(|case ast
[_ (&/$TextS "*")]
- (return (&/V &/$GenericWildcard nil))
+ (return (&/V &/$GenericWildcard &/unit-tag))
[_ (&/$TextS var-name)]
(return (&/V &/$GenericTypeVar var-name))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index d74b02402..044f22df6 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -144,13 +144,14 @@
(def tags-field "_tags")
(def module-class-name "_")
(def +name-separator+ ";")
+(def unit-tag (.intern (str (char 0) "unit" (char 0))))
(def sum-tag (.intern (str (char 0) "sum" (char 0))))
(def product-tag (.intern (str (char 0) "product" (char 0))))
(defn T [elems]
(case (count elems)
0
- nil
+ unit-tag
1
(first elems)
@@ -159,13 +160,13 @@
(to-array (conj elems product-tag))))
(defn V [^Long tag value]
- (to-array [sum-tag tag value]))
+ (to-array [sum-tag (int tag) false value]))
;; Constructors
-(def None$ (V $None nil))
+(def None$ (V $None unit-tag))
(defn Some$ [x] (V $Some x))
-(def Nil$ (V $Nil nil))
+(def Nil$ (V $Nil unit-tag))
(defn Cons$ [h t] (V $Cons (T [h t])))
(def empty-cursor (T ["" -1 -1]))
@@ -191,21 +192,17 @@
(defn transform-pattern [pattern]
(cond (vector? pattern) (case (count pattern)
0
- nil
+ unit-tag
1
- (first pattern)
+ (transform-pattern (first pattern))
;; else
(conj (mapv transform-pattern pattern) '_))
- (seq? pattern) (let [parts (mapv transform-pattern (rest pattern))]
- ['_
- (eval (first pattern))
- (case (count parts)
- 0 nil
- 1 (first parts)
- ;; else
- (conj parts '_))])
+ (seq? pattern) ['_
+ (eval (first pattern))
+ '_
+ (transform-pattern (vec (rest pattern)))]
:else pattern
))
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 8d748df53..31e0ca3a2 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -79,8 +79,8 @@
(&o/$apply ?fn ?args)
(&&lux/compile-apply compile-expression ?fn ?args)
- (&o/$variant ?tag ?members)
- (&&lux/compile-variant compile-expression ?tag ?members)
+ (&o/$variant ?tag ?tail ?members)
+ (&&lux/compile-variant compile-expression ?tag ?tail ?members)
(&o/$case ?value ?match)
(&&case/compile-case compile-expression ?value ?match)
diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj
index 6ad21aef7..b046b237f 100644
--- a/src/lux/compiler/base.clj
+++ b/src/lux/compiler/base.clj
@@ -31,6 +31,7 @@
(def ^String output-package (str output-dir "/" "program.jar"))
(def ^String function-class "lux/Function")
(def ^String lux-utils-class "lux/LuxUtils")
+(def ^String unit-tag-field "unit_tag")
(def ^String sum-tag-field "sum_tag")
(def ^String product-tag-field "product_tag")
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index 314e7a6d3..1b0e023eb 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -23,6 +23,7 @@
;; [Utils]
(defn ^:private compile-match [^MethodVisitor writer ?match $target $else]
+ "(-> [MethodVisitor CaseAnalysis Label Label] Unit)"
(|case ?match
(&a-case/$StoreTestAC ?idx)
(if (< ?idx 0)
@@ -115,27 +116,27 @@
(.visitJumpInsn Opcodes/GOTO $target))))
(&a-case/$VariantTestAC ?tag ?count ?test)
- (doto writer
- (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int 1))
- (.visitInsn Opcodes/AALOAD)
- (.visitLdcInsn ?tag)
- (&&/wrap-long)
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Object" "equals" "(Ljava/lang/Object;)Z")
- (.visitJumpInsn Opcodes/IFEQ $else)
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int 2))
- (.visitInsn Opcodes/AALOAD)
- (-> (doto (compile-match ?test $value-then $value-else)
- (.visitLabel $value-then)
- (.visitInsn Opcodes/POP)
- (.visitJumpInsn Opcodes/GOTO $target)
- (.visitLabel $value-else)
- (.visitInsn Opcodes/POP)
- (.visitJumpInsn Opcodes/GOTO $else))
- (->> (let [$value-then (new Label)
- $value-else (new Label)]))))
+ (let [$variant-else (new Label)]
+ (doto writer
+ (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int ?tag))
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxUtils" "sum_get" "([Ljava/lang/Object;I)Ljava/lang/Object;")
+ (.visitInsn Opcodes/DUP)
+ (.visitInsn Opcodes/ACONST_NULL)
+ (.visitJumpInsn Opcodes/IF_ACMPEQ $variant-else)
+ (-> (doto (compile-match ?test $value-then $value-else)
+ (.visitLabel $value-then)
+ (.visitInsn Opcodes/POP)
+ (.visitJumpInsn Opcodes/GOTO $target)
+ (.visitLabel $value-else)
+ (.visitInsn Opcodes/POP)
+ (.visitJumpInsn Opcodes/GOTO $else))
+ (->> (let [$value-then (new Label)
+ $value-else (new Label)])))
+ (.visitLabel $variant-else)
+ (.visitInsn Opcodes/POP)
+ (.visitJumpInsn Opcodes/GOTO $else)))
))
(defn ^:private separate-bodies [patterns]
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index f4e7ab740..e7982a8ca 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -699,6 +699,8 @@
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
full-name nil super-class (into-array String [])))
+ =unit-tag (doto (.visitField =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) &&/unit-tag-field tag-sig nil &/unit-tag)
+ (.visitEnd))
=sum-tag (doto (.visitField =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) &&/sum-tag-field tag-sig nil &/sum-tag)
(.visitEnd))
=product-tag (doto (.visitField =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) &&/product-tag-field tag-sig nil &/product-tag)
@@ -768,7 +770,55 @@
(.visitInsn Opcodes/AALOAD) ;; elem
(.visitInsn Opcodes/ARETURN)
(.visitMaxs 0 0)
- (.visitEnd)))]]
+ (.visitEnd)))
+ =sum-get-method (let [$begin (new Label)
+ $then (new Label)
+ $further (new Label)
+ $not-right (new Label)]
+ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "sum_get" "([Ljava/lang/Object;I)Ljava/lang/Object;" nil nil)
+ (.visitCode)
+ (.visitLabel $begin)
+ (.visitVarInsn Opcodes/ILOAD 1) ;; tag
+ (.visitVarInsn Opcodes/ALOAD 0) ;; tag, sum
+ (.visitLdcInsn (int 1)) ;; tag, sum, sum-tag-idx
+ (.visitInsn Opcodes/AALOAD) ;; tag, sum-tag'
+ &&/unwrap-int ;; tag, sum-tag
+ (.visitInsn Opcodes/DUP2) ;; tag, sum-tag, tag, sum-tag
+ (.visitJumpInsn Opcodes/IF_ICMPEQ $then) ;; tag, sum-tag
+ (.visitInsn Opcodes/DUP2) ;; tag, sum-tag, tag, sum-tag
+ (.visitJumpInsn Opcodes/IF_ICMPGT $further) ;; tag, sum-tag
+ (.visitInsn Opcodes/POP2)
+ (.visitInsn Opcodes/ACONST_NULL)
+ (.visitInsn Opcodes/ARETURN)
+ (.visitLabel $then) ;; tag, sum-tag
+ (.visitFrame Opcodes/F_NEW (int 2) (to-array ["[Ljava/lang/Object;" Opcodes/INTEGER]) (int 2) (to-array [Opcodes/INTEGER Opcodes/INTEGER]))
+ (.visitInsn Opcodes/POP2)
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitLdcInsn (int 3))
+ (.visitInsn Opcodes/AALOAD)
+ (.visitInsn Opcodes/ARETURN)
+ (.visitLabel $further) ;; tag, sum-tag
+ (.visitFrame Opcodes/F_NEW (int 2) (to-array ["[Ljava/lang/Object;" Opcodes/INTEGER]) (int 2) (to-array [Opcodes/INTEGER Opcodes/INTEGER]))
+ (.visitVarInsn Opcodes/ALOAD 0) ;; tag, sum-tag, sum
+ (.visitLdcInsn (int 2)) ;; tag, sum-tag, sum, last-index?
+ (.visitInsn Opcodes/AALOAD) ;; tag, sum-tag, last?'
+ &&/unwrap-boolean ;; tag, sum-tag, last?
+ (.visitJumpInsn Opcodes/IFEQ $not-right) ;; tag, sum-tag
+ (.visitInsn Opcodes/ISUB) ;; sub-tag
+ (.visitVarInsn Opcodes/ALOAD 0) ;; sub-tag, sum
+ (.visitLdcInsn (int 3)) ;; sub-tag, sum, sub-sum-idx
+ (.visitInsn Opcodes/AALOAD) ;; sub-tag, sub-sum
+ (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
+ (.visitVarInsn Opcodes/ASTORE 0) ;; sub-tag
+ (.visitVarInsn Opcodes/ISTORE 1) ;;
+ (.visitJumpInsn Opcodes/GOTO $begin)
+ (.visitLabel $not-right) ;; tag, sum-tag
+ (.visitFrame Opcodes/F_NEW (int 2) (to-array ["[Ljava/lang/Object;" Opcodes/INTEGER]) (int 2) (to-array [Opcodes/INTEGER Opcodes/INTEGER]))
+ (.visitInsn Opcodes/POP2)
+ (.visitInsn Opcodes/ACONST_NULL)
+ (.visitInsn Opcodes/ARETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd)))]]
(&&/save-class! (second (string/split &&/lux-utils-class #"/"))
(.toByteArray (doto =class .visitEnd)))))
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 31f2fdb8c..3c09f6362 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -58,7 +58,7 @@
:let [num-elems (&/|length ?elems)]]
(|case num-elems
0
- (|do [:let [_ (.visitInsn *writer* Opcodes/ACONST_NULL)]]
+ (|do [:let [_ (.visitLdcInsn *writer* &/unit-tag)]]
(return nil))
1
@@ -83,10 +83,10 @@
(.visitInsn Opcodes/AASTORE))]]
(return nil)))))
-(defn compile-variant [compile ?tag ?value]
+(defn compile-variant [compile ?tag tail? ?value]
(|do [^MethodVisitor *writer* &/get-writer
:let [_ (doto *writer*
- (.visitLdcInsn (int 3))
+ (.visitLdcInsn (int 4))
(.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object")
(.visitInsn Opcodes/DUP)
(.visitLdcInsn (int 0))
@@ -94,11 +94,15 @@
(.visitInsn Opcodes/AASTORE)
(.visitInsn Opcodes/DUP)
(.visitLdcInsn (int 1))
- (.visitLdcInsn ?tag)
- (&&/wrap-long)
+ (.visitLdcInsn (int ?tag))
+ (&&/wrap-int)
(.visitInsn Opcodes/AASTORE)
(.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int 2)))]
+ (.visitLdcInsn (int 2))
+ (.visitFieldInsn Opcodes/GETSTATIC "java/lang/Boolean" (if tail? "TRUE" "FALSE") "Ljava/lang/Boolean;")
+ (.visitInsn Opcodes/AASTORE)
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int 3)))]
_ (compile ?value)
:let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
(return nil)))
diff --git a/src/lux/compiler/type.clj b/src/lux/compiler/type.clj
index 1bfca2c1f..8a63aaa17 100644
--- a/src/lux/compiler/type.clj
+++ b/src/lux/compiler/type.clj
@@ -13,9 +13,9 @@
;; [Utils]
(defn ^:private variant$ [tag body]
- "(-> Text Analysis Analysis)"
+ "(-> Int Analysis Analysis)"
(&a/|meta &type/$Void &/empty-cursor
- (&/V &a/$variant (&/T [tag body]))))
+ (&/V &a/$variant (&/T [tag false body]))))
(defn ^:private tuple$ [members]
"(-> (List Analysis) Analysis)"
diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj
index b6de8091b..59f49d6a1 100644
--- a/src/lux/lexer.clj
+++ b/src/lux/lexer.clj
@@ -172,7 +172,7 @@
(do-template [<name> <text> <tag>]
(def <name>
(|do [[meta _] (&reader/read-text <text>)]
- (return (&/T [meta (&/V <tag> nil)]))))
+ (return (&/T [meta (&/V <tag> &/unit-tag)]))))
^:private lex-open-paren "(" $Open_Paren
^:private lex-close-paren ")" $Close_Paren
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 33c012806..cae91e588 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -47,8 +47,8 @@
(defn Named$ [name type]
(&/V &/$NamedT (&/T [name type])))
-(def $Void (&/V &/$VoidT nil))
-(def Unit (&/V &/$UnitT nil))
+(def $Void (&/V &/$VoidT &/unit-tag))
+(def Unit (&/V &/$UnitT &/unit-tag))
(def Bool (Named$ (&/T ["lux" "Bool"]) (Data$ "java.lang.Boolean" &/Nil$)))
(def Int (Named$ (&/T ["lux" "Int"]) (Data$ "java.lang.Long" &/Nil$)))
(def Real (Named$ (&/T ["lux" "Real"]) (Data$ "java.lang.Double" &/Nil$)))
diff --git a/src/lux/type/host.clj b/src/lux/type/host.clj
index b06895945..ae225db1f 100644
--- a/src/lux/type/host.clj
+++ b/src/lux/type/host.clj
@@ -64,7 +64,7 @@
;; [Exports]
(let [class-name-re #"((\[+)L([\.a-zA-Z0-9]+);|([\.a-zA-Z0-9]+)|(\[+)([ZBSIJFDC]))"
- Unit (&/V &/$UnitT nil)
+ Unit (&/V &/$UnitT &/unit-tag)
jprim->lprim (fn [prim]
(case prim
"Z" "boolean"
@@ -272,4 +272,4 @@
(instance? WildcardType gtype)
(if-let [bound (->> ^WildcardType gtype .getUpperBounds seq first)]
(gtype->gclass bound)
- (&/V &/$GenericWildcard nil))))
+ (&/V &/$GenericWildcard &/unit-tag))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 06:45:15 +0000