aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/lux/analyser.clj32
-rw-r--r--src/lux/analyser/lux.clj12
-rw-r--r--src/lux/compiler/case.clj44
3 files changed, 48 insertions, 40 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index e261420c3..25bb09b6d 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -19,24 +19,28 @@
[parser :as &&a-parser])))
;; [Utils]
-(defn analyse-variant+ [analyser exo-type ident values]
+(defn analyse-variant+ [analyse exo-type ident values]
(|do [[module tag-name] (&/normalize ident)
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 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 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 is-last? values)
- )))
+ (if (= 1 (&/|length group))
+ (|do [_cursor &/cursor]
+ (analyse exo-type (&/T [_cursor (&/V &/$TupleS values)])))
+ (|case exo-type
+ (&/$VarT id)
+ (|do [? (&type/bound? id)]
+ (if (or ? (&&/type-tag? module tag-name))
+ (&&lux/analyse-variant analyse (&/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 analyse (&/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 analyse (&/V &/$Right exo-type) idx is-last? values)
+ ))
+ ))
(defn ^:private add-loc [meta ^String msg]
(if (.startsWith msg "@")
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index fba8ea15b..8d2736f9d 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -198,8 +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*))))
+ :let [num-variant-types (&/|length (&type/flatten-sum exo-type*))
+ is-last?* (if (nil? is-last?)
+ (= idx (dec num-variant-types))
is-last?)]
=value (&/with-attempt
(analyse-variant-body analyse vtype ?values)
@@ -214,9 +215,10 @@
'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 is-last?* =value]))
- ))))
+ (if (= 1 num-variant-types)
+ (return (&/|list =value))
+ (return (&/|list (&&/|meta exo-type _cursor (&/V &&/$variant (&/T [idx is-last?* =value])))))
+ ))
(&/$UnivQ _)
(|do [$var &type/existential
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index 1b0e023eb..c7a7145f8 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -116,27 +116,29 @@
(.visitJumpInsn Opcodes/GOTO $target))))
(&a-case/$VariantTestAC ?tag ?count ?test)
- (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)))
+ (if (= 1 ?count)
+ (compile-match ?test $target $else)
+ (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]