diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/lux/analyser.clj | 32 | ||||
| -rw-r--r-- | src/lux/analyser/lux.clj | 12 | ||||
| -rw-r--r-- | src/lux/compiler/case.clj | 44 |
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] |