diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/lux/analyser/case.clj | 49 | ||||
| -rw-r--r-- | src/lux/base.clj | 33 | ||||
| -rw-r--r-- | src/lux/compiler/case.clj | 2 |
3 files changed, 69 insertions, 15 deletions
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index 34cbf8b48..148e2822a 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -223,13 +223,14 @@ value-type* (adjust-type value-type) ;; :let [_ (println "#02")] idx (&module/tag-index =module =name) + group (&module/tag-group =module =name) ;; :let [_ (println "#03")] case-type (&type/variant-case idx value-type*) ;; :let [_ (println "#04")] [=test =kont] (analyse-pattern case-type unit kont) ;; :let [_ (println "#05")] ] - (return (&/T (&/V $VariantTestAC (&/T idx =test)) =kont))) + (return (&/T (&/V $VariantTestAC (&/T idx (&/|length group) =test)) =kont))) (&/$FormS (&/$Cons (&/$Meta _ (&/$TagS ?ident)) ?values)) @@ -239,6 +240,7 @@ value-type* (adjust-type value-type) ;; :let [_ (println "#12" (&type/show-type value-type*))] idx (&module/tag-index =module =name) + group (&module/tag-group =module =name) ;; :let [_ (println "#13")] case-type (&type/variant-case idx value-type*) ;; :let [_ (println "#14" (&type/show-type case-type))] @@ -249,7 +251,7 @@ (analyse-pattern case-type (&/V &/$Meta (&/T (&/T "" -1 -1) (&/V &/$TupleS ?values))) kont)) ;; :let [_ (println "#15")] ] - (return (&/T (&/V $VariantTestAC (&/T idx =test)) =kont))) + (return (&/T (&/V $VariantTestAC (&/T idx (&/|length group) =test)) =kont))) ))) (defn ^:private analyse-branch [analyse exo-type value-type pattern body patterns] @@ -311,21 +313,40 @@ (return (&/V $TupleTotal (&/T total? structs)))) (fail "[Pattern-matching Error] Inconsistent tuple-size.")) - [($DefaultTotal total?) ($VariantTestAC ?tag ?test)] + [($DefaultTotal total?) ($VariantTestAC ?tag ?count ?test)] (|do [sub-struct (merge-total (&/V $DefaultTotal total?) - (&/T ?test ?body))] - (return (&/V $VariantTotal (&/T total? (&/|put ?tag sub-struct (&/|table)))))) - - [($VariantTotal total? ?branches) ($VariantTestAC ?tag ?test)] - (|do [sub-struct (merge-total (or (&/|get ?tag ?branches) - (&/V $DefaultTotal total?)) - (&/T ?test ?body))] - (return (&/V $VariantTotal (&/T total? (&/|put ?tag sub-struct ?branches))))) + (&/T ?test ?body)) + structs (|case (&/|list-put ?tag sub-struct (&/|repeat ?count (&/V $DefaultTotal total?))) + (&/$Some list) + (return list) + + (&/$None) + (fail "[Pattern-matching Error] YOLO"))] + (return (&/V $VariantTotal (&/T total? structs)))) + + [($VariantTotal total? ?branches) ($VariantTestAC ?tag ?count ?test)] + (|do [sub-struct (merge-total (|case (&/|at ?tag ?branches) + (&/$Some sub) + sub + + (&/$None) + (&/V $DefaultTotal total?)) + (&/T ?test ?body)) + structs (|case (&/|list-put ?tag sub-struct ?branches) + (&/$Some list) + (return list) + + (&/$None) + (fail "[Pattern-matching Error] YOLO"))] + (return (&/V $VariantTotal (&/T total? structs)))) )))) (defn ^:private check-totality [value-type struct] ;; (prn 'check-totality (&type/show-type value-type) (&/adt->text struct)) (|case struct + ($DefaultTotal ?total) + (return ?total) + ($BoolTotal ?total ?values) (return (or ?total (= #{true false} (set (&/->seq ?values))))) @@ -369,6 +390,9 @@ (|case value-type* (&/$VariantT ?members) (|do [totals (&/map2% (fn [sub-struct ?member] + ;; (prn '$VariantTotal + ;; (&/adt->text sub-struct) + ;; (&type/show-type ?member)) (check-totality ?member sub-struct)) ?structs ?members)] (return (&/fold #(and %1 %2) true totals))) @@ -376,9 +400,6 @@ _ (fail "[Pattern-maching Error] Variant is not total.")))) - ($DefaultTotal ?total) - (return ?total) - ;; _ ;; (assert false (prn-str 'check-totality (&type/show-type value-type) ;; (&/adt->text struct))) diff --git a/src/lux/base.clj b/src/lux/base.clj index b8b7118f4..89620ce97 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -116,6 +116,13 @@ (defn R [& kvs] (to-array kvs)) +;; Constructors +(def None$ (V $None nil)) +(defn Some$ [x] (V $Some x)) + +(def Nil$ (V $Nil nil)) +(defn Cons$ [h t] (V $Cons (T h t))) + (defn get$ [slot ^objects record] (aget record slot)) @@ -894,3 +901,29 @@ [ymodule yname] y] (and (= xmodule ymodule) (= xname yname)))) + +;; (defn |list-put [idx val xs] +;; (|case [idx xs] +;; [_ ($Nil)] +;; (V $None nil) + +;; [0 ($Cons x xs*)] +;; (V $Some (V $Cons (T val xs*))) + +;; [_ ($Cons x xs*)] +;; (|case (|list-put idx val xs*) +;; ($None) (V $None nil) +;; ($Some xs**) (V $Some (V $Cons (T x xs**)))))) + +(defn |list-put [idx val xs] + (|case xs + ($Nil) + (V $None nil) + + ($Cons x xs*) + (if (= idx 0) + (V $Some (V $Cons (T val xs*))) + (|case (|list-put (dec idx) val xs*) + ($None) (V $None nil) + ($Some xs**) (V $Some (V $Cons (T x xs**)))) + ))) diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj index 4d8ac2190..dd3258059 100644 --- a/src/lux/compiler/case.clj +++ b/src/lux/compiler/case.clj @@ -102,7 +102,7 @@ (.visitInsn Opcodes/POP) (.visitJumpInsn Opcodes/GOTO $target)) - (&a-case/$VariantTestAC ?tag ?test) + (&a-case/$VariantTestAC ?tag ?count ?test) (doto writer (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") (.visitInsn Opcodes/DUP) |