From 891b1cfc82322f8017f0a4f6b707d6fe52024545 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 3 Sep 2021 21:51:30 -0400 Subject: Unified tuple and record syntax. --- lux-bootstrapper/src/lux/analyser.clj | 4 -- lux-bootstrapper/src/lux/analyser/case.clj | 86 ++++++++++++++-------------- lux-bootstrapper/src/lux/analyser/lux.clj | 30 +++++----- lux-bootstrapper/src/lux/analyser/record.clj | 81 ++++++++++++++++---------- lux-bootstrapper/src/lux/base.clj | 22 +++---- 5 files changed, 122 insertions(+), 101 deletions(-) (limited to 'lux-bootstrapper') diff --git a/lux-bootstrapper/src/lux/analyser.clj b/lux-bootstrapper/src/lux/analyser.clj index ccd0144f6..27323be2b 100644 --- a/lux-bootstrapper/src/lux/analyser.clj +++ b/lux-bootstrapper/src/lux/analyser.clj @@ -87,10 +87,6 @@ (return (&/|list (&&/|meta exo-type location (&&/$text ?value))))) (&/$Tuple ?elems) - (&/with-analysis-meta location exo-type - (&&lux/analyse-tuple analyse (&/$Right exo-type) ?elems)) - - (&/$Record ?elems) (&/with-analysis-meta location exo-type (&&lux/analyse-record analyse exo-type ?elems)) diff --git a/lux-bootstrapper/src/lux/analyser/case.clj b/lux-bootstrapper/src/lux/analyser/case.clj index 062467ca3..49d781c3b 100644 --- a/lux-bootstrapper/src/lux/analyser/case.clj +++ b/lux-bootstrapper/src/lux/analyser/case.clj @@ -298,51 +298,51 @@ =kont kont] (return (&/T [($TextTestAC ?value) =kont]))) - (&/$Tuple ?members) - (|case ?members - (&/$End) - (|do [_ (&type/check value-type &type/Any) - =kont kont] - (return (&/T [($TupleTestAC (&/|list)) =kont]))) + (&/$Tuple (&/$End)) + (|do [_ (&type/check value-type &type/Any) + =kont kont] + (return (&/T [($TupleTestAC (&/|list)) =kont]))) - (&/$Item ?member (&/$End)) - (analyse-pattern var?? value-type ?member kont) + (&/$Tuple (&/$Item ?member (&/$End))) + (analyse-pattern var?? value-type ?member kont) - _ - (|do [must-infer? (&type/unknown? value-type) - value-type* (if must-infer? - (|do [member-types (&/map% (fn [_] &type/create-var+) (&/|range (&/|length ?members)))] - (return (&type/fold-prod member-types))) - (adjust-type value-type))] - (|case value-type* - (&/$Product _) - (|let [num-elems (&/|length ?members) - [_shorter _tuple-types] (&type/tuple-types-for (&/|length ?members) value-type*)] - (if (= num-elems _shorter) - (|do [[=tests =kont] (&/fold (fn [kont* vm] - (|let [[v m] vm] - (|do [[=test [=tests =kont]] (analyse-pattern &/$None v m kont*)] - (return (&/T [(&/$Item =test =tests) =kont]))))) - (|do [=kont kont] - (return (&/T [&/$End =kont]))) - (&/|reverse (&/zip2 _tuple-types ?members)))] - (return (&/T [($TupleTestAC =tests) =kont]))) - (&/fail-with-loc (str "[Pattern-matching Error] Pattern-matching mismatch. Requires tuple[" (&/|length (&type/flatten-prod value-type*)) "]. Given tuple [" (&/|length ?members) "].\n" - " At: " (&/show-ast pattern) "\n" - "Expected type: " (&type/show-type value-type*) "\n" - " Actual type: " (&type/show-type value-type))))) - - _ - (&/fail-with-loc (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type)))))) - - (&/$Record pairs) - (|do [[rec-members rec-type] (&&record/order-record pairs) - must-infer? (&type/unknown? value-type) - rec-type* (if must-infer? - (&type/instantiate-inference rec-type) - (return value-type)) - _ (&type/check value-type rec-type*)] - (analyse-pattern &/$None rec-type* (&/T [meta (&/$Tuple rec-members)]) kont)) + (&/$Tuple ?members) + (|do [rec-members&rec-type (&&record/order-record ?members)] + (|case rec-members&rec-type + (&/$Some [rec-members rec-type]) + (|do [must-infer? (&type/unknown? value-type) + rec-type* (if must-infer? + (&type/instantiate-inference rec-type) + (return value-type)) + _ (&type/check value-type rec-type*)] + (analyse-pattern &/$None rec-type* (&/T [meta (&/$Tuple rec-members)]) kont)) + + (&/$None) + (|do [must-infer? (&type/unknown? value-type) + value-type* (if must-infer? + (|do [member-types (&/map% (fn [_] &type/create-var+) (&/|range (&/|length ?members)))] + (return (&type/fold-prod member-types))) + (adjust-type value-type))] + (|case value-type* + (&/$Product _) + (|let [num-elems (&/|length ?members) + [_shorter _tuple-types] (&type/tuple-types-for (&/|length ?members) value-type*)] + (if (= num-elems _shorter) + (|do [[=tests =kont] (&/fold (fn [kont* vm] + (|let [[v m] vm] + (|do [[=test [=tests =kont]] (analyse-pattern &/$None v m kont*)] + (return (&/T [(&/$Item =test =tests) =kont]))))) + (|do [=kont kont] + (return (&/T [&/$End =kont]))) + (&/|reverse (&/zip2 _tuple-types ?members)))] + (return (&/T [($TupleTestAC =tests) =kont]))) + (&/fail-with-loc (str "[Pattern-matching Error] Pattern-matching mismatch. Requires tuple[" (&/|length (&type/flatten-prod value-type*)) "]. Given tuple [" (&/|length ?members) "].\n" + " At: " (&/show-ast pattern) "\n" + "Expected type: " (&type/show-type value-type*) "\n" + " Actual type: " (&type/show-type value-type))))) + + _ + (&/fail-with-loc (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type))))))) (&/$Tag ?ident) (|do [[=module =name] (&&/resolved-ident ?ident) diff --git a/lux-bootstrapper/src/lux/analyser/lux.clj b/lux-bootstrapper/src/lux/analyser/lux.clj index 8b93faea8..7b8019211 100644 --- a/lux-bootstrapper/src/lux/analyser/lux.clj +++ b/lux-bootstrapper/src/lux/analyser/lux.clj @@ -245,20 +245,24 @@ ))) (defn analyse-record [analyse exo-type ?elems] - (|do [[rec-members rec-type] (&&record/order-record ?elems)] - (|case exo-type - (&/$Var id) - (|do [verdict (&type/bound? id)] - (if verdict - (analyse-tuple analyse (&/$Right exo-type) rec-members) - (|do [[[tuple-type tuple-location] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/$Left rec-type) rec-members)) - _ (&type/check exo-type tuple-type)] - (return (&/|list (&&/|meta exo-type tuple-location - tuple-analysis)))))) + (|do [rec-members&rec-type (&&record/order-record ?elems)] + (|case rec-members&rec-type + (&/$Some [rec-members rec-type]) + (|case exo-type + (&/$Var id) + (|do [verdict (&type/bound? id)] + (if verdict + (analyse-tuple analyse (&/$Right exo-type) rec-members) + (|do [[[tuple-type tuple-location] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/$Left rec-type) rec-members)) + _ (&type/check exo-type tuple-type)] + (return (&/|list (&&/|meta exo-type tuple-location + tuple-analysis)))))) - _ - (analyse-tuple analyse (&/$Right exo-type) rec-members) - ))) + _ + (analyse-tuple analyse (&/$Right exo-type) rec-members)) + + (&/$None) + (analyse-tuple analyse (&/$Right exo-type) ?elems)))) (defn ^:private analyse-global [analyse exo-type module name] (|do [[[r-module r-name] [exported? endo-type ?annotations ?value]] (&&module/find-def module name) diff --git a/lux-bootstrapper/src/lux/analyser/record.clj b/lux-bootstrapper/src/lux/analyser/record.clj index 7af3c17ac..09fd8b988 100644 --- a/lux-bootstrapper/src/lux/analyser/record.clj +++ b/lux-bootstrapper/src/lux/analyser/record.clj @@ -8,37 +8,56 @@ ;; [Exports] (defn order-record - "(-> (List (, Syntax Syntax)) (Lux (List Syntax)))" + "(-> (List Syntax) (Lux (Maybe (List Syntax))))" [pairs] - (|do [[module slot-group slot-type] (|case pairs - (&/$End) - (|do [module &/get-module-name] - (return (&/T [module &/$End &type/Any]))) - - (&/$Item [[_ (&/$Tag slot1)] _] _) - (|do [[module name] (&&/resolved-ident slot1) - [_exported? type slots _index] (&&module/find-slot module (str "#" name))] - (return (&/T [module slots type]))) + (if (even? (&/|length pairs)) + (let [pairs (&/|as-pairs pairs)] + (|do [module&slot-group&slot-type (|case pairs + (&/$End) + (|do [module &/get-module-name] + (return (&/$Some (&/T [module &/$End &type/Any])))) + + (&/$Item [[_ (&/$Tag slot0)] _] _) + (|do [[module name] (&&/resolved-ident slot0) + _exported?&type&slots&_index (fn [lux] + (|case ((&&module/find-slot module (str "#" name)) lux) + (&/$Left error) + (&/$Right (&/T [lux &/$None])) + + (&/$Right [lux* output]) + (&/$Right (&/T [lux* (&/$Some output)]))))] + (|case _exported?&type&slots&_index + (&/$Some [_exported? type slots _index]) + (return (&/$Some (&/T [module slots type]))) - _ - (&/fail-with-loc "[Analyser Error] Wrong syntax for records. Odd elements must be slots.")) - =pairs (&/map% (fn [kv] - (|case kv - [[_ (&/$Tag k)] v] - (|do [=k (&&/resolved-ident k)] - (return (&/T [(&/ident->text =k) v]))) + (&/$None) + (return &/$None))) - _ - (&/fail-with-loc "[Analyser Error] Wrong syntax for records. Odd elements must be slots."))) - pairs) - _ (let [num-expected (&/|length slot-group) - num-got (&/|length =pairs)] - (&/assert! (= num-expected num-got) - (str "[Analyser Error] Wrong number of record members. Expected " num-expected ", but got " num-got "."))) - =members (&/map% (fn [slot] - (let [slot (&/ident->text (&/T [module slot]))] - (if-let [member (&/|get slot =pairs)] - (return member) - (&/fail-with-loc (str "[Analyser Error] Missing slot: " slot))))) - slot-group)] - (return (&/T [=members slot-type])))) + _ + (return &/$None))] + (|case module&slot-group&slot-type + (&/$Some [module slot-group slot-type]) + (|do [=pairs (&/map% (fn [kv] + (|case kv + [[_ (&/$Tag k)] v] + (|do [=k (&&/resolved-ident k)] + (return (&/T [(&/ident->text =k) v]))) + + _ + (&/fail-with-loc "[Analyser Error] Wrong syntax for records. Odd elements must be slots."))) + pairs) + _ (let [num-expected (&/|length slot-group) + num-got (&/|length =pairs)] + (&/assert! (= num-expected num-got) + (str "[Analyser Error] Wrong number of record members. Expected " num-expected ", but got " num-got "."))) + =members (&/map% (fn [slot] + (let [slot (&/ident->text (&/T [module slot]))] + (if-let [member (&/|get slot =pairs)] + (return member) + (&/fail-with-loc (str "[Analyser Error] Missing slot: " slot))))) + slot-group)] + (return (&/$Some (&/T [=members slot-type])))) + + (&/$None) + (return &/$None)))) + (return &/$None))) diff --git a/lux-bootstrapper/src/lux/base.clj b/lux-bootstrapper/src/lux/base.clj index f95c4d6d5..b19bb4fae 100644 --- a/lux-bootstrapper/src/lux/base.clj +++ b/lux-bootstrapper/src/lux/base.clj @@ -273,7 +273,7 @@ :else pattern)) (defmacro |case [value & branches] - (assert (= 0 (mod (count branches) 2))) + (assert (even? (count branches))) (let [value* (if (vector? value) [`(T [~@value])] [value])] @@ -381,7 +381,7 @@ )))) (defmacro |do [steps return] - (assert (= 0 (rem (count steps) 2)) "The number of steps must be even!") + (assert (even? (count steps)) "The number of steps must be even!") (reduce (fn [inner [label computation]] (case label :let `(|let ~computation ~inner) @@ -580,20 +580,22 @@ (defn list-join [xss] (fold |++ $End xss)) -(defn |as-pairs [xs] - (|case xs - ($Item x ($Item y xs*)) - ($Item (T [x y]) (|as-pairs xs*)) - - _ - $End)) - (defn |reverse [xs] (fold (fn [tail head] ($Item head tail)) $End xs)) +(defn |as-pairs [xs] + (loop [input xs + output $End] + (|case input + ($Item headL ($Item headR tail)) + (recur tail ($Item (T [headL headR]) output)) + + _ + (|reverse output)))) + (defn add-loc [meta ^String msg] (if (.startsWith msg "@") msg -- cgit v1.2.3