diff options
32 files changed, 1267 insertions, 1267 deletions
diff --git a/luxc/src/lux/analyser.clj b/luxc/src/lux/analyser.clj index 18bfdcd3e..1c854acb9 100644 --- a/luxc/src/lux/analyser.clj +++ b/luxc/src/lux/analyser.clj @@ -26,7 +26,7 @@ (|do [_cursor &/cursor] (analyse exo-type (&/T [_cursor (&/$Tuple values)]))) (|case exo-type - (&/$VarT id) + (&/$Var id) (|do [? (&type/bound? id)] (if (or ? (&&/type-tag? module tag-name)) (&&lux/analyse-variant analyse (&/$Right exo-type) idx is-last? values) @@ -46,7 +46,7 @@ (fn [?var] (|do [[[?output-type ?output-cursor] ?output-term] (&&/analyse-1 analyser ?var syntax)] (|case [?var ?output-type] - [(&/$VarT ?e-id) (&/$VarT ?a-id)] + [(&/$Var ?e-id) (&/$Var ?a-id)] (if (= ?e-id ?a-id) (|do [=output-type (&type/clean ?var ?output-type)] (return (&&/|meta =output-type ?output-cursor ?output-term))) @@ -203,7 +203,7 @@ ;; [Resources] (defn analyse [optimize eval! compile-module compilers] (|do [asts &parser/parse] - (&/flat-map% (partial analyse-ast optimize eval! compile-module compilers &/$VoidT) asts))) + (&/flat-map% (partial analyse-ast optimize eval! compile-module compilers &/$Void) asts))) (defn clean-output [?var analysis] (|do [:let [[[?output-type ?output-cursor] ?output-term] analysis] diff --git a/luxc/src/lux/analyser/base.clj b/luxc/src/lux/analyser/base.clj index e1678fb2b..e762c3870 100644 --- a/luxc/src/lux/analyser/base.clj +++ b/luxc/src/lux/analyser/base.clj @@ -75,7 +75,7 @@ (return ?module))] (return (&/T [module* ?name])))) -(let [tag-names #{"HostT" "VoidT" "UnitT" "SumT" "ProdT" "FunctionT" "BoundT" "VarT" "ExT" "UnivQ" "ExQ" "AppT" "NamedT"}] +(let [tag-names #{"Host" "Void" "Unit" "Sum" "Product" "Function" "Bound" "Var" "Ex" "UnivQ" "ExQ" "App" "Named"}] (defn type-tag? [module name] (and (= "lux" module) (contains? tag-names name)))) diff --git a/luxc/src/lux/analyser/case.clj b/luxc/src/lux/analyser/case.clj index 1e3214dad..613e415f5 100644 --- a/luxc/src/lux/analyser/case.clj +++ b/luxc/src/lux/analyser/case.clj @@ -41,7 +41,7 @@ (defn ^:private resolve-type [type] (|case type - (&/$VarT ?id) + (&/$Var ?id) (|do [type* (&/try-all% (&/|list (&type/deref ?id) (&/fail-with-loc "##1##")))] (resolve-type type*)) @@ -65,30 +65,30 @@ (defn clean! [level ?tid bound-idx type] (|case type - (&/$VarT ?id) + (&/$Var ?id) (if (= ?tid ?id) - (&/$BoundT (+ (* 2 level) bound-idx)) + (&/$Bound (+ (* 2 level) bound-idx)) type) - (&/$HostT ?name ?params) - (&/$HostT ?name (&/|map (partial clean! level ?tid bound-idx) - ?params)) + (&/$Host ?name ?params) + (&/$Host ?name (&/|map (partial clean! level ?tid bound-idx) + ?params)) - (&/$FunctionT ?arg ?return) - (&/$FunctionT (clean! level ?tid bound-idx ?arg) - (clean! level ?tid bound-idx ?return)) + (&/$Function ?arg ?return) + (&/$Function (clean! level ?tid bound-idx ?arg) + (clean! level ?tid bound-idx ?return)) - (&/$AppT ?lambda ?param) - (&/$AppT (clean! level ?tid bound-idx ?lambda) - (clean! level ?tid bound-idx ?param)) + (&/$App ?lambda ?param) + (&/$App (clean! level ?tid bound-idx ?lambda) + (clean! level ?tid bound-idx ?param)) - (&/$ProdT ?left ?right) - (&/$ProdT (clean! level ?tid bound-idx ?left) - (clean! level ?tid bound-idx ?right)) + (&/$Product ?left ?right) + (&/$Product (clean! level ?tid bound-idx ?left) + (clean! level ?tid bound-idx ?right)) - (&/$SumT ?left ?right) - (&/$SumT (clean! level ?tid bound-idx ?left) - (clean! level ?tid bound-idx ?right)) + (&/$Sum ?left ?right) + (&/$Sum (clean! level ?tid bound-idx ?left) + (clean! level ?tid bound-idx ?right)) (&/$UnivQ ?env ?body) (&/$UnivQ (&/|map (partial clean! level ?tid bound-idx) ?env) @@ -104,20 +104,20 @@ (defn beta-reduce! [level env type] (|case type - (&/$HostT ?name ?params) - (&/$HostT ?name (&/|map (partial beta-reduce! level env) ?params)) + (&/$Host ?name ?params) + (&/$Host ?name (&/|map (partial beta-reduce! level env) ?params)) - (&/$SumT ?left ?right) - (&/$SumT (beta-reduce! level env ?left) - (beta-reduce! level env ?right)) + (&/$Sum ?left ?right) + (&/$Sum (beta-reduce! level env ?left) + (beta-reduce! level env ?right)) - (&/$ProdT ?left ?right) - (&/$ProdT (beta-reduce! level env ?left) - (beta-reduce! level env ?right)) + (&/$Product ?left ?right) + (&/$Product (beta-reduce! level env ?left) + (beta-reduce! level env ?right)) - (&/$AppT ?type-fn ?type-arg) - (&/$AppT (beta-reduce! level env ?type-fn) - (beta-reduce! level env ?type-arg)) + (&/$App ?type-fn ?type-arg) + (&/$App (beta-reduce! level env ?type-fn) + (beta-reduce! level env ?type-arg)) (&/$UnivQ ?local-env ?local-def) (|case ?local-env @@ -135,11 +135,11 @@ _ type) - (&/$FunctionT ?input ?output) - (&/$FunctionT (beta-reduce! level env ?input) - (beta-reduce! level env ?output)) + (&/$Function ?input ?output) + (&/$Function (beta-reduce! level env ?input) + (beta-reduce! level env ?output)) - (&/$BoundT ?idx) + (&/$Bound ?idx) (|case (&/|at (- ?idx (* 2 level)) env) (&/$Some bound) (beta-reduce! level env bound) @@ -165,17 +165,17 @@ (&/$Cons type-fn)) local-def)) - (&/$AppT F A) + (&/$App F A) (|do [type-fn* (apply-type! F A)] (apply-type! type-fn* param)) - (&/$NamedT ?name ?type) + (&/$Named ?name ?type) (apply-type! ?type param) - (&/$ExT id) - (return (&/$AppT type-fn param)) + (&/$Ex id) + (return (&/$App type-fn param)) - (&/$VarT id) + (&/$Var id) (|do [=type-fun (deref id)] (apply-type! =type-fun param)) @@ -199,9 +199,9 @@ =type (apply-type! type $var)] (adjust-type* up =type)) - (&/$ProdT ?left ?right) + (&/$Product ?left ?right) (let [=type (&/fold (fn [_abody ena] - (|let [[_aenv _aidx (&/$VarT _avar)] ena] + (|let [[_aenv _aidx (&/$Var _avar)] ena] (clean! 0 _avar _aidx _abody))) type up) @@ -214,9 +214,9 @@ (return (&type/Tuple$ (&/|map distributor (&type/flatten-prod =type))))) - (&/$SumT ?left ?right) + (&/$Sum ?left ?right) (let [=type (&/fold (fn [_abody ena] - (|let [[_aenv _aidx (&/$VarT _avar)] ena] + (|let [[_aenv _aidx (&/$Var _avar)] ena] (clean! 0 _avar _aidx _abody))) type up) @@ -229,19 +229,19 @@ (return (&type/Variant$ (&/|map distributor (&type/flatten-sum =type))))) - (&/$AppT ?tfun ?targ) + (&/$App ?tfun ?targ) (|do [=type (apply-type! ?tfun ?targ)] (adjust-type* up =type)) - (&/$VarT ?id) + (&/$Var ?id) (|do [type* (&/try-all% (&/|list (&type/deref ?id) (&/fail-with-loc (str "##2##: " ?id))))] (adjust-type* up type*)) - (&/$NamedT ?name ?type) + (&/$Named ?name ?type) (adjust-type* up ?type) - (&/$UnitT) + (&/$Unit) (return type) _ @@ -309,7 +309,7 @@ (&/$Tuple ?members) (|case ?members (&/$Nil) - (|do [_ (&type/check value-type &/$UnitT) + (|do [_ (&type/check value-type &/$Unit) =kont kont] (return (&/T [($TupleTestAC (&/|list)) =kont]))) @@ -323,7 +323,7 @@ (return (&type/fold-prod member-types))) (adjust-type value-type))] (|case value-type* - (&/$ProdT _) + (&/$Product _) (|let [num-elems (&/|length ?members) [_shorter _tuple-types] (&type/tuple-types-for (&/|length ?members) value-type*)] (if (= num-elems _shorter) @@ -604,7 +604,7 @@ (&/$Nil) (|do [value-type* (resolve-type value-type)] (|case value-type* - (&/$UnitT) + (&/$Unit) (return true) _ @@ -616,7 +616,7 @@ (|do [=structs (&/map% (check-totality+ check-totality) ?structs) _ (&type/check value-type (|case (->> (&/|map &/|second =structs) (&/|reverse)) (&/$Cons last prevs) - (&/fold (fn [right left] (&/$ProdT left right)) + (&/fold (fn [right left] (&/$Product left right)) last prevs)))] (return (or ?total (&/fold #(and %1 %2) true (&/|map &/|first =structs))))) @@ -624,7 +624,7 @@ (return true) (|do [value-type* (resolve-type value-type)] (|case value-type* - (&/$ProdT _) + (&/$Product _) (|let [num-elems (&/|length ?structs) [_shorter _tuple-types] (&type/tuple-types-for (&/|length ?structs) value-type*) _ (&/assert! (= num-elems _shorter) @@ -640,7 +640,7 @@ (return true) (|do [value-type* (resolve-type value-type)] (|case value-type* - (&/$SumT _) + (&/$Sum _) (|do [totals (&/map2% check-totality (&type/flatten-sum value-type*) ?structs)] diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj index 95dc9af59..2a76ec86a 100644 --- a/luxc/src/lux/analyser/lux.clj +++ b/luxc/src/lux/analyser/lux.clj @@ -31,7 +31,7 @@ ;; nested quantifications that cannot be directly counted. (defn ^:private next-bound-type [type] "(-> Type Type)" - (&/$BoundT (->> (count-univq type) (* 2) (+ 1)))) + (&/$Bound (->> (count-univq type) (* 2) (+ 1)))) (defn ^:private embed-inferred-input [input output] "(-> Type Type Type)" @@ -40,12 +40,12 @@ (&/$UnivQ env (embed-inferred-input input output*)) _ - (&/$FunctionT input output))) + (&/$Function input output))) ;; [Exports] (defn analyse-unit [analyse ?exo-type] (|do [_cursor &/cursor - _ (&type/check ?exo-type &/$UnitT)] + _ (&type/check ?exo-type &/$Unit)] (return (&/|list (&&/|meta ?exo-type _cursor (&&/$tuple (&/|list))))))) @@ -74,7 +74,7 @@ [[tuple-type tuple-cursor] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/$Left exo-type**) ?elems)) =var (&type/resolve-type $var) inferred-type (|case =var - (&/$VarT iid) + (&/$Var iid) (|do [:let [=var* (next-bound-type tuple-type)] _ (&type/set-var iid =var*) tuple-type* (&type/clean $var tuple-type)] @@ -96,7 +96,7 @@ ?elems) _ (&type/check exo-type (|case (->> (&/|map &&/expr-type* =elems) (&/|reverse)) (&/$Cons last prevs) - (&/fold (fn [right left] (&/$ProdT left right)) + (&/fold (fn [right left] (&/$Product left right)) last prevs))) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor @@ -105,7 +105,7 @@ (|do [exo-type* (&type/actual-type exo-type)] (&/with-attempt (|case exo-type* - (&/$ProdT _) + (&/$Product _) (|let [num-elems (&/|length ?elems) [_shorter _tuple-types] (&type/tuple-types-for num-elems exo-type*)] (if (= num-elems _shorter) @@ -139,7 +139,7 @@ (&/$UnivQ _) (|do [$var &type/existential - :let [(&/$ExT $var-id) $var] + :let [(&/$Ex $var-id) $var] exo-type** (&type/apply-type exo-type* $var) [[tuple-type tuple-cursor] tuple-analysis] (&/with-scope-type-var $var-id (&&/cap-1 (analyse-tuple analyse (&/$Right exo-type**) ?elems)))] @@ -183,7 +183,7 @@ [[variant-type variant-cursor] variant-analysis] (&&/cap-1 (analyse-variant analyse (&/$Left exo-type**) idx is-last? ?values)) =var (&type/resolve-type $var) inferred-type (|case =var - (&/$VarT iid) + (&/$Var iid) (|do [:let [=var* (next-bound-type variant-type)] _ (&type/set-var iid =var*) variant-type* (&type/clean $var variant-type)] @@ -199,7 +199,7 @@ (&/$Right exo-type) (|do [exo-type* (|case exo-type - (&/$VarT ?id) + (&/$Var ?id) (&/try-all% (&/|list (|do [exo-type* (&type/deref ?id)] (&type/actual-type exo-type*)) (|do [_ (&type/set-var ?id &type/Type)] @@ -209,7 +209,7 @@ (&type/actual-type exo-type))] (&/with-attempt (|case exo-type* - (&/$SumT _) + (&/$Sum _) (|do [vtype (&type/sum-at idx exo-type*) :let [num-variant-types (&/|length (&type/flatten-sum exo-type*)) is-last?* (if (nil? is-last?) @@ -238,7 +238,7 @@ (&/fail-with-loc (str "[Analyser Error] Cannot create variant if the expected type is " (&type/show-type exo-type*) " " idx " " (->> ?values (&/|map &/show-ast) (&/|interpose " ") (&/fold str ""))))) (fn [err] (|case exo-type - (&/$VarT ?id) + (&/$Var ?id) (|do [=exo-type (&type/deref ?id)] (&/fail-with-loc (str err "\n" "[Analyser Error] Cannot create variant if the expected type is " (&type/show-type =exo-type) " " idx " " (->> ?values (&/|map &/show-ast) (&/|interpose " ") (&/fold str ""))))) @@ -249,7 +249,7 @@ (defn analyse-record [analyse exo-type ?elems] (|do [[rec-members rec-type] (&&record/order-record ?elems)] (|case exo-type - (&/$VarT id) + (&/$Var id) (|do [? (&type/bound? id)] (if ? (analyse-tuple analyse (&/$Right exo-type) rec-members) @@ -324,7 +324,7 @@ [=output-t =args] (analyse-apply* analyse exo-type type* ?args) ==args (&/map% (partial &&/clean-analysis $var) =args)] (|case $var - (&/$VarT ?id) + (&/$Var ?id) (|do [? (&type/bound? ?id) type** (if ? (&type/clean $var =output-t) @@ -341,7 +341,7 @@ type* (&type/apply-type ?fun-type* $var)] (analyse-apply* analyse exo-type type* ?args)) - (&/$FunctionT ?input-t ?output-t) + (&/$Function ?input-t ?output-t) (|do [[=output-t =args] (analyse-apply* analyse exo-type ?output-t ?args*) =arg (&/with-attempt (&&/analyse-1 analyse ?input-t ?arg) @@ -411,7 +411,7 @@ (defn ^:private unravel-inf-appt [type] (|case type - (&/$AppT =input+ (&/$VarT _inf-var)) + (&/$App =input+ (&/$Var _inf-var)) (&/$Cons _inf-var (unravel-inf-appt =input+)) _ @@ -419,16 +419,16 @@ (defn ^:private clean-func-inference [$input $output =input =func] (|case =input - (&/$VarT iid) + (&/$Var iid) (|do [:let [=input* (next-bound-type =func)] _ (&type/set-var iid =input*) =func* (&type/clean $input =func) =func** (&type/clean $output =func*)] (return (&/$UnivQ &/$Nil =func**))) - (&/$AppT =input+ (&/$VarT _inf-var)) + (&/$App =input+ (&/$Var _inf-var)) (&/fold% (fn [_func _inf-var] - (|do [:let [$inf-var (&/$VarT _inf-var)] + (|do [:let [$inf-var (&/$Var _inf-var)] =inf-var (&type/resolve-type $inf-var) _func* (clean-func-inference $inf-var $output =inf-var _func) _ (&type/delete-var _inf-var)] @@ -436,9 +436,9 @@ =func (unravel-inf-appt =input)) - (&/$ProdT _ _) + (&/$Product _ _) (&/fold% (fn [_func _inf-var] - (|do [:let [$inf-var (&/$VarT _inf-var)] + (|do [:let [$inf-var (&/$Var _inf-var)] =inf-var (&type/resolve-type $inf-var) _func* (clean-func-inference $inf-var $output =inf-var _func) _ (&type/delete-var _inf-var)] @@ -453,7 +453,7 @@ (defn analyse-function* [analyse exo-type ?self ?arg ?body] (|case exo-type - (&/$VarT id) + (&/$Var id) (|do [? (&type/bound? id)] (if ? (|do [exo-type* (&type/deref id)] @@ -463,7 +463,7 @@ (fn [$input] (&type/with-var (fn [$output] - (|do [[[function-type function-cursor] function-analysis] (analyse-function* analyse (&/$FunctionT $input $output) ?self ?arg ?body) + (|do [[[function-type function-cursor] function-analysis] (analyse-function* analyse (&/$Function $input $output) ?self ?arg ?body) =input (&type/resolve-type $input) =output (&type/resolve-type $output) inferred-type (clean-func-inference $input $output =input (embed-inferred-input =input =output)) @@ -478,7 +478,7 @@ (|case exo-type* (&/$UnivQ _) (|do [$var &type/existential - :let [(&/$ExT $var-id) $var] + :let [(&/$Ex $var-id) $var] exo-type** (&type/apply-type exo-type* $var)] (&/with-scope-type-var $var-id (analyse-function* analyse exo-type** ?self ?arg ?body))) @@ -490,7 +490,7 @@ =expr (analyse-function* analyse exo-type** ?self ?arg ?body)] (&&/clean-analysis $var =expr)))) - (&/$FunctionT ?arg-t ?return-t) + (&/$Function ?arg-t ?return-t) (|do [[=scope =captured =body] (&&function/with-function ?self exo-type* ?arg ?arg-t (&&/analyse-1 analyse ?return-t ?body)) @@ -509,14 +509,14 @@ (|case exo-type (&/$UnivQ _) (|do [$var &type/existential - :let [(&/$ExT $var-id) $var] + :let [(&/$Ex $var-id) $var] exo-type* (&type/apply-type exo-type $var) [_ _expr] (&/with-scope-type-var $var-id (analyse-function** analyse exo-type* ?self ?arg ?body)) _cursor &/cursor] (return (&&/|meta exo-type _cursor _expr))) - (&/$VarT id) + (&/$Var id) (|do [? (&type/bound? id)] (if ? (|do [exo-type* (&type/actual-type exo-type)] @@ -683,8 +683,8 @@ =value (&&/analyse-1+ analyse ?value)] (return (&/|list (coerce ==type =value))))) -(let [input-type (&/$AppT &type/List &type/Text) - output-type (&/$AppT &type/IO &/$UnitT)] +(let [input-type (&/$App &type/List &type/Text) + output-type (&/$App &type/IO &/$Unit)] (defn analyse-program [analyse optimize compile-program ?args ?body] (|do [_ &/ensure-statement =body (&/with-scope "" diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index b6727ff53..29797224f 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -21,10 +21,10 @@ (&type/with-var (fn [$var] (|do [:let [(&/$Cons op (&/$Nil)) ?values] - =op (&&/analyse-1 analyse (&/$AppT &type/IO $var) op) - _ (&type/check exo-type (&/$SumT &type/Text ;; lux;Left - $var ;; lux;Right - )) + =op (&&/analyse-1 analyse (&/$App &type/IO $var) op) + _ (&type/check exo-type (&/$Sum &type/Text ;; lux;Left + $var ;; lux;Right + )) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["lux" "try"]) (&/|list =op) (&/|list))))))))) @@ -57,8 +57,8 @@ (&/|list =text =part =start) (&/|list))))))) - ^:private analyse-text-index "index" (&/$AppT &type/Maybe &type/Nat) - ^:private analyse-text-last-index "last-index" (&/$AppT &type/Maybe &type/Nat) + ^:private analyse-text-index "index" (&/$App &type/Maybe &type/Nat) + ^:private analyse-text-last-index "last-index" (&/$App &type/Maybe &type/Nat) ) (defn ^:private analyse-text-contains? [analyse exo-type ?values] @@ -77,7 +77,7 @@ =text (&&/analyse-1 analyse &type/Text text) =from (&&/analyse-1 analyse &type/Nat from) =to (&&/analyse-1 analyse &type/Nat to) - _ (&type/check exo-type (&/$AppT &type/Maybe &type/Text)) + _ (&type/check exo-type (&/$App &type/Maybe &type/Text)) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["text" "clip"]) @@ -131,7 +131,7 @@ (|do [:let [(&/$Cons text (&/$Cons idx (&/$Nil))) ?values] =text (&&/analyse-1 analyse &type/Text text) =idx (&&/analyse-1 analyse &type/Nat idx) - _ (&type/check exo-type (&/$AppT &type/Maybe &type/Char)) + _ (&type/check exo-type (&/$App &type/Maybe &type/Char)) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["text" "char"]) @@ -245,7 +245,7 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T <encode-op>) (&/|list =x) (&/|list))))))) - (let [decode-type (&/$AppT &type/Maybe <type>)] + (let [decode-type (&/$App &type/Maybe <type>)] (defn <decode> [analyse exo-type ?values] (|do [:let [(&/$Cons x (&/$Nil)) ?values] =x (&&/analyse-1 analyse &type/Text x) @@ -306,7 +306,7 @@ ^:private analyse-deg-to-real &type/Deg &type/Real ["deg" "to-real"] ^:private analyse-real-to-deg &type/Real &type/Deg ["real" "to-deg"] - ^:private analyse-io-log &type/Text &/$UnitT ["io" "log"] + ^:private analyse-io-log &type/Text &/$Unit ["io" "log"] ^:private analyse-io-error &type/Text &type/Bottom ["io" "error"] ^:private analyse-io-exit &type/Int &type/Bottom ["io" "exit"] ) @@ -321,7 +321,7 @@ (defn ^:private analyse-array-new [analyse exo-type ?values] (|do [:let [(&/$Cons length (&/$Nil)) ?values] =length (&&/analyse-1 analyse &type/Nat length) - _ (&type/check exo-type (&/$UnivQ (&/|list) (&type/Array (&/$BoundT 1)))) + _ (&type/check exo-type (&/$UnivQ (&/|list) (&type/Array (&/$Bound 1)))) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["array" "new"]) (&/|list =length) (&/|list))))))) @@ -332,7 +332,7 @@ (|do [:let [(&/$Cons array (&/$Cons idx (&/$Nil))) ?values] =array (&&/analyse-1 analyse (&type/Array $var) array) =idx (&&/analyse-1 analyse &type/Nat idx) - _ (&type/check exo-type (&/$AppT &type/Maybe $var)) + _ (&type/check exo-type (&/$App &type/Maybe $var)) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["array" "get"]) (&/|list =array =idx) (&/|list))))))))) @@ -466,8 +466,8 @@ (defn ^:private analyse-process-future [analyse exo-type ?values] (|do [:let [(&/$Cons ?procedure (&/$Nil)) ?values] - =procedure (&&/analyse-1 analyse (&/$AppT &type/IO &type/Top) ?procedure) - _ (&type/check exo-type &/$UnitT) + =procedure (&&/analyse-1 analyse (&/$App &type/IO &type/Top) ?procedure) + _ (&type/check exo-type &/$Unit) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["process" "future"]) (&/|list =procedure) (&/|list))))))) @@ -475,8 +475,8 @@ (defn ^:private analyse-process-schedule [analyse exo-type ?values] (|do [:let [(&/$Cons ?milliseconds (&/$Cons ?procedure (&/$Nil))) ?values] =milliseconds (&&/analyse-1 analyse &type/Nat ?milliseconds) - =procedure (&&/analyse-1 analyse (&/$AppT &type/IO &type/Top) ?procedure) - _ (&type/check exo-type &/$UnitT) + =procedure (&&/analyse-1 analyse (&/$App &type/IO &type/Top) ?procedure) + _ (&type/check exo-type &/$Unit) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["process" "schedule"]) (&/|list =milliseconds =procedure) (&/|list))))))) diff --git a/luxc/src/lux/analyser/proc/js.clj b/luxc/src/lux/analyser/proc/js.clj index 986720108..33fa7816d 100644 --- a/luxc/src/lux/analyser/proc/js.clj +++ b/luxc/src/lux/analyser/proc/js.clj @@ -10,9 +10,9 @@ (do-template [<name> <proc>] (defn <name> [analyse exo-type ?values] (|do [:let [(&/$Cons ?function ?args) ?values] - =function (&&/analyse-1 analyse (&/$HostT "function" &/$Nil) ?function) + =function (&&/analyse-1 analyse (&/$Host "function" &/$Nil) ?function) =args (&/map% (partial &&/analyse-1+ analyse) ?args) - _ (&type/check exo-type (&/$HostT "object" &/$Nil)) + _ (&type/check exo-type (&/$Host "object" &/$Nil)) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["js" <proc>]) (&/$Cons =function =args) (&/|list))))))) @@ -23,17 +23,17 @@ (defn ^:private analyse-js-object-call [analyse exo-type ?values] (|do [:let [(&/$Cons ?object (&/$Cons ?field ?args)) ?values] - =object (&&/analyse-1 analyse (&/$HostT "object" &/$Nil) ?object) + =object (&&/analyse-1 analyse (&/$Host "object" &/$Nil) ?object) =field (&&/analyse-1 analyse &type/Text ?field) =args (&/map% (partial &&/analyse-1+ analyse) ?args) - _ (&type/check exo-type (&/$HostT "object" &/$Nil)) + _ (&type/check exo-type (&/$Host "object" &/$Nil)) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["js" "object-call"]) (&/$Cons =object (&/$Cons =field =args)) (&/|list))))))) (defn ^:private analyse-js-ref [analyse exo-type ?values] (|do [:let [(&/$Cons [_ (&/$Text ?ref-name)] (&/$Nil)) ?values] - _ (&type/check exo-type (&/$HostT "object" &/$Nil)) + _ (&type/check exo-type (&/$Host "object" &/$Nil)) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["js" "ref"]) (&/|list) (&/|list ?ref-name))))))) @@ -41,9 +41,9 @@ (do-template [<name> <proc>] (defn <name> [analyse exo-type ?values] (|do [:let [(&/$Cons ?object (&/$Cons ?field (&/$Nil))) ?values] - =object (&&/analyse-1 analyse (&/$HostT "object" &/$Nil) ?object) + =object (&&/analyse-1 analyse (&/$Host "object" &/$Nil) ?object) =field (&&/analyse-1 analyse &type/Text ?field) - _ (&type/check exo-type (&/$HostT "object" &/$Nil)) + _ (&type/check exo-type (&/$Host "object" &/$Nil)) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["js" <proc>]) (&/|list =object =field) (&/|list))))))) @@ -54,10 +54,10 @@ (defn ^:private analyse-js-set-field [analyse exo-type ?values] (|do [:let [(&/$Cons ?object (&/$Cons ?field (&/$Cons ?value (&/$Nil)))) ?values] - =object (&&/analyse-1 analyse (&/$HostT "object" &/$Nil) ?object) + =object (&&/analyse-1 analyse (&/$Host "object" &/$Nil) ?object) =field (&&/analyse-1 analyse &type/Text ?field) =value (&&/analyse-1+ analyse ?value) - _ (&type/check exo-type (&/$HostT "object" &/$Nil)) + _ (&type/check exo-type (&/$Host "object" &/$Nil)) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["js" "set-field"]) (&/|list =object =field =value) (&/|list))))))) @@ -65,7 +65,7 @@ (do-template [<name> <proc> <type>] (defn <name> [analyse exo-type ?values] (|do [:let [(&/$Nil) ?values] - :let [output-type (&/$HostT <type> &/$Nil)] + :let [output-type (&/$Host <type> &/$Nil)] _ (&type/check exo-type output-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor diff --git a/luxc/src/lux/analyser/proc/jvm.clj b/luxc/src/lux/analyser/proc/jvm.clj index ba9be52b1..977c07787 100644 --- a/luxc/src/lux/analyser/proc/jvm.clj +++ b/luxc/src/lux/analyser/proc/jvm.clj @@ -21,16 +21,16 @@ (defn ^:private ensure-object [type] "(-> Type (Lux (, Text (List Type))))" (|case type - (&/$HostT payload) + (&/$Host payload) (return payload) - (&/$VarT id) + (&/$Var id) (return (&/T ["java.lang.Object" (&/|list)])) - (&/$ExT id) + (&/$Ex id) (return (&/T ["java.lang.Object" (&/|list)])) - (&/$NamedT _ type*) + (&/$Named _ type*) (ensure-object type*) (&/$UnivQ _ type*) @@ -39,7 +39,7 @@ (&/$ExQ _ type*) (ensure-object type*) - (&/$AppT F A) + (&/$App F A) (|do [type* (&type/apply-type F A)] (ensure-object type*)) @@ -49,8 +49,8 @@ (defn ^:private as-object [type] "(-> Type Type)" (|case type - (&/$HostT class params) - (&/$HostT (&host-type/as-obj class) params) + (&/$Host class params) + (&/$Host (&host-type/as-obj class) params) _ type)) @@ -72,19 +72,19 @@ (defn ^:private as-otype+ [type] "(-> Type Type)" (|case type - (&/$HostT name params) - (&/$HostT (as-otype name) params) + (&/$Host name params) + (&/$Host (as-otype name) params) _ type)) (defn ^:private clean-gtype-var [idx gtype-var] - (|let [(&/$VarT id) gtype-var] + (|let [(&/$Var id) gtype-var] (|do [? (&type/bound? id)] (if ? (|do [real-type (&type/deref id)] (return (&/T [idx real-type]))) - (return (&/T [(+ 2 idx) (&/$BoundT idx)])))))) + (return (&/T [(+ 2 idx) (&/$Bound idx)])))))) (defn ^:private clean-gtype-vars [gtype-vars] (|do [[_ clean-types] (&/fold% (fn [idx+types gtype-var] @@ -99,19 +99,19 @@ "(-> Text (List Type) Type)" (&/fold (fn [base-type type-arg] (|case type-arg - (&/$BoundT _) + (&/$Bound _) (&/$UnivQ &type/empty-env base-type) _ base-type)) - (&/$HostT class-name type-args) + (&/$Host class-name type-args) type-args)) ;; [Resources] (defn ^:private analyse-field-access-helper [obj-type gvars gtype] "(-> Type (List (^ java.lang.reflect.Type)) (^ java.lang.reflect.Type) (Lux Type))" (|case obj-type - (&/$HostT class targs) + (&/$Host class targs) (if (= (&/|length targs) (&/|length gvars)) (|let [gtype-env (&/fold2 (fn [m ^TypeVariable g t] (&/$Cons (&/T [(.getName g) t]) m)) (&/|table) @@ -186,25 +186,25 @@ (&/$GenericClass name params) (case name - "boolean" (return (&/$HostT "java.lang.Boolean" &/$Nil)) - "byte" (return (&/$HostT "java.lang.Byte" &/$Nil)) - "short" (return (&/$HostT "java.lang.Short" &/$Nil)) - "int" (return (&/$HostT "java.lang.Integer" &/$Nil)) - "long" (return (&/$HostT "java.lang.Long" &/$Nil)) - "float" (return (&/$HostT "java.lang.Float" &/$Nil)) - "double" (return (&/$HostT "java.lang.Double" &/$Nil)) - "char" (return (&/$HostT "java.lang.Character" &/$Nil)) - "void" (return &/$UnitT) + "boolean" (return (&/$Host "java.lang.Boolean" &/$Nil)) + "byte" (return (&/$Host "java.lang.Byte" &/$Nil)) + "short" (return (&/$Host "java.lang.Short" &/$Nil)) + "int" (return (&/$Host "java.lang.Integer" &/$Nil)) + "long" (return (&/$Host "java.lang.Long" &/$Nil)) + "float" (return (&/$Host "java.lang.Float" &/$Nil)) + "double" (return (&/$Host "java.lang.Double" &/$Nil)) + "char" (return (&/$Host "java.lang.Character" &/$Nil)) + "void" (return &/$Unit) ;; else (|do [=params (&/map% (partial generic-class->type env) params)] - (return (&/$HostT name =params)))) + (return (&/$Host name =params)))) (&/$GenericArray param) (|do [=param (generic-class->type env param)] - (return (&/$HostT &host-type/array-data-tag (&/|list =param)))) + (return (&/$Host &host-type/array-data-tag (&/|list =param)))) (&/$GenericWildcard _) - (return (&/$ExQ &/$Nil (&/$BoundT 1))) + (return (&/$ExQ &/$Nil (&/$Bound 1))) )) (defn gen-super-env [class-env supers class-decl] @@ -252,7 +252,7 @@ itype (generic-class->type full-env itype*)] (if (double-register-gclass? itype*) (&&env/with-local iname itype - (&&env/with-local "" &/$VoidT + (&&env/with-local "" &/$Void body*)) (&&env/with-local iname itype body*))))) @@ -260,12 +260,12 @@ (defn ^:private analyse-method [analyse class-decl class-env all-supers method] "(-> Analyser ClassDecl (List (, TypeVar Type)) (List SuperClassDecl) MethodSyntax (Lux MethodAnalysis))" (|let [[?cname ?cparams] class-decl - class-type (&/$HostT ?cname (&/|map &/|second class-env))] + class-type (&/$Host ?cname (&/|map &/|second class-env))] (|case method (&/$ConstructorMethodSyntax =privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs ?ctor-args ?body) (|do [method-env (make-type-env ?gvars) :let [full-env (&/|++ class-env method-env)] - :let [output-type &/$UnitT] + :let [output-type &/$Unit] =ctor-args (&/map% (fn [ctor-arg] (|do [:let [[ca-type ca-term] ctor-arg] =ca-type (generic-class->type full-env ca-type) @@ -383,10 +383,10 @@ )) (do-template [<name> <proc> <from-class> <to-class>] - (let [output-type (&/$HostT <to-class> &/$Nil)] + (let [output-type (&/$Host <to-class> &/$Nil)] (defn <name> [analyse exo-type _?value] (|do [:let [(&/$Cons ?value (&/$Nil)) _?value] - =value (&&/analyse-1 analyse (&/$HostT <from-class> &/$Nil) ?value) + =value (&&/analyse-1 analyse (&/$Host <from-class> &/$Nil) ?value) _ (&type/check exo-type output-type) _cursor &/cursor] (return (&/|list (&&/|meta output-type _cursor (&&/$proc (&/T ["jvm" <proc>]) (&/|list =value) (&/|list)))))))) @@ -423,11 +423,11 @@ ) (do-template [<name> <proc> <v1-class> <v2-class> <to-class>] - (let [output-type (&/$HostT <to-class> &/$Nil)] + (let [output-type (&/$Host <to-class> &/$Nil)] (defn <name> [analyse exo-type ?values] (|do [:let [(&/$Cons ?value1 (&/$Cons ?value2 (&/$Nil))) ?values] - =value1 (&&/analyse-1 analyse (&/$HostT <v1-class> &/$Nil) ?value1) - =value2 (&&/analyse-1 analyse (&/$HostT <v2-class> &/$Nil) ?value2) + =value1 (&&/analyse-1 analyse (&/$Host <v1-class> &/$Nil) ?value1) + =value2 (&&/analyse-1 analyse (&/$Host <v2-class> &/$Nil) ?value2) _ (&type/check exo-type output-type) _cursor &/cursor] (return (&/|list (&&/|meta output-type _cursor (&&/$proc (&/T ["jvm" <proc>]) (&/|list =value1 =value2) (&/|list)))))))) @@ -448,8 +448,8 @@ ) (do-template [<name> <proc> <input-class> <output-class>] - (let [input-type (&/$HostT <input-class> &/$Nil) - output-type (&/$HostT <output-class> &/$Nil)] + (let [input-type (&/$Host <input-class> &/$Nil) + output-type (&/$Host <output-class> &/$Nil)] (defn <name> [analyse exo-type ?values] (|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values] =x (&&/analyse-1 analyse input-type x) @@ -503,8 +503,8 @@ (let [length-type &type/Nat idx-type &type/Nat] (do-template [<elem-class> <array-class> <new-name> <new-tag> <load-name> <load-tag> <store-name> <store-tag>] - (let [elem-type (&/$HostT <elem-class> &/$Nil) - array-type (&/$HostT <array-class> &/$Nil)] + (let [elem-type (&/$Host <elem-class> &/$Nil) + array-type (&/$Host <array-class> &/$Nil)] (defn <new-name> [analyse exo-type ?values] (|do [:let [(&/$Cons length (&/$Nil)) ?values] =length (&&/analyse-1 analyse length-type length) @@ -558,7 +558,7 @@ &&a-parser/parse-gclass) gtype-env &/get-type-env =gclass (&host-type/instance-gtype &type/existential gtype-env gclass) - :let [array-type (&/$HostT &host-type/array-data-tag (&/|list =gclass))] + :let [array-type (&/$Host &host-type/array-data-tag (&/|list =gclass))] =length (&&/analyse-1 analyse length-type length) _ (&type/check exo-type array-type) _cursor &/cursor] @@ -614,7 +614,7 @@ (defn ^:private analyse-jvm-null [analyse exo-type ?values] (|do [:let [(&/$Nil) ?values] - :let [output-type (&/$HostT &host-type/null-data-tag &/$Nil)] + :let [output-type (&/$Host &host-type/null-data-tag &/$Nil)] _ (&type/check exo-type output-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor @@ -632,7 +632,7 @@ (defn ^:private analyse-jvm-throw [analyse exo-type ?values] (|do [:let [(&/$Cons ?ex (&/$Nil)) ?values] =ex (&&/analyse-1+ analyse ?ex) - _ (&type/check (&/$HostT "java.lang.Throwable" &/$Nil) (&&/expr-type* =ex)) + _ (&type/check (&/$Host "java.lang.Throwable" &/$Nil) (&&/expr-type* =ex)) [throw-class throw-params] (ensure-object (&&/expr-type* =ex)) _cursor &/cursor _ (&type/check exo-type &type/Bottom)] @@ -673,7 +673,7 @@ :let [gclass (&host-type/gtype->gclass gtype)] =type (&host-type/instance-param &type/existential &/$Nil gtype) =value (&&/analyse-1 analyse =type value) - :let [output-type &/$UnitT] + :let [output-type &/$Unit] _ (&type/check exo-type output-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor @@ -690,7 +690,7 @@ :let [gclass (&host-type/gtype->gclass gtype)] =type (analyse-field-access-helper obj-type gvars gtype) =value (&&/analyse-1 analyse =type value) - :let [output-type &/$UnitT] + :let [output-type &/$Unit] _ (&type/check exo-type output-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor @@ -709,7 +709,7 @@ (&/$Cons ^TypeVariable gtv gtype-vars*) (&type/with-var (fn [$var] - (|do [:let [(&/$VarT _id) $var + (|do [:let [(&/$Var _id) $var gtype-env* (&/$Cons (&/T [(.getName gtv) $var]) gtype-env)] [=gret =args] (analyse-method-call-helper analyse exo-type gret gtype-env* gtype-vars* gtype-args args) ==gret (&type/clean $var =gret) @@ -717,7 +717,7 @@ (return (&/T [==gret ==args]))))) )) -(let [dummy-type-param (&/$HostT "java.lang.Object" &/$Nil)] +(let [dummy-type-param (&/$Host "java.lang.Object" &/$Nil)] (do-template [<name> <tag> <only-interface?>] (defn <name> [analyse exo-type class method classes ?values] (|do [!class! (&/de-alias-class class) @@ -735,10 +735,10 @@ (&host/lookup-virtual-method class-loader !class! method classes)) =object (&&/analyse-1+ analyse object) [sub-class sub-params] (ensure-object (&&/expr-type* =object)) - (&/$HostT super-class* super-params*) (&host-type/->super-type &type/existential class-loader !class! (if (= sub-class class) - !class! - sub-class) - sub-params) + (&/$Host super-class* super-params*) (&host-type/->super-type &type/existential class-loader !class! (if (= sub-class class) + !class! + sub-class) + sub-params) :let [gtype-env (&/fold2 (fn [m ^TypeVariable g t] (&/$Cons (&/T [(.getName g) t]) m)) (&/|table) parent-gvars @@ -811,7 +811,7 @@ (return nil)) (catch Exception e (&/fail-with-loc (str "[Analyser Error] Unknown class: " _class-name)))) - :let [output-type (&/$HostT "java.lang.Class" (&/|list (&/$HostT _class-name (&/|list))))] + :let [output-type (&/$Host "java.lang.Class" (&/|list (&/$Host _class-name (&/|list))))] _ (&type/check exo-type output-type) _cursor &/cursor] (return (&/|list (&&/|meta output-type _cursor @@ -822,7 +822,7 @@ _ (compile-interface interface-decl supers =anns =methods) :let [_ (println 'INTERFACE (str module "." (&/|first interface-decl)))] _cursor &/cursor] - (return (&/|list (&&/|meta &/$UnitT _cursor + (return (&/|list (&&/|meta &/$Unit _cursor (&&/$tuple (&/|list))))))) (defn ^:private analyse-jvm-class [analyse compile-class class-decl super-class interfaces =inheritance-modifier =anns ?fields methods] @@ -841,7 +841,7 @@ _ &/pop-dummy-name :let [_ (println 'CLASS full-name)] _cursor &/cursor] - (return (&/|list (&&/|meta &/$UnitT _cursor + (return (&/|list (&&/|meta &/$Unit _cursor (&&/$tuple (&/|list)))))))) (defn ^:private captured-source [env-entry] @@ -866,7 +866,7 @@ :let [name (->> scope &/|reverse &/|tail &host/location) class-decl (&/T [name &/$Nil]) anon-class (str (string/replace module "/" ".") "." name) - anon-class-type (&/$HostT anon-class &/$Nil)] + anon-class-type (&/$Host anon-class &/$Nil)] =ctor-args (&/map% (fn [ctor-arg] (|let [[arg-type arg-term] ctor-arg] (|do [=arg-term (&&/analyse-1+ analyse arg-term)] diff --git a/luxc/src/lux/analyser/record.clj b/luxc/src/lux/analyser/record.clj index 90be7d330..ac9a0e64d 100644 --- a/luxc/src/lux/analyser/record.clj +++ b/luxc/src/lux/analyser/record.clj @@ -11,7 +11,7 @@ "(-> (List (, Syntax Syntax)) (Lux (List Syntax)))" (|do [[tag-group tag-type] (|case pairs (&/$Nil) - (return (&/T [&/$Nil &/$UnitT])) + (return (&/T [&/$Nil &/$Unit])) (&/$Cons [[_ (&/$Tag tag1)] _] _) (|do [[module name] (&&/resolved-ident tag1) diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj index 98b6ce4e8..6ce50c06f 100644 --- a/luxc/src/lux/base.clj +++ b/luxc/src/lux/base.clj @@ -86,19 +86,19 @@ ;; Type (defvariant - ("HostT" 2) - ("VoidT" 0) - ("UnitT" 0) - ("SumT" 2) - ("ProdT" 2) - ("FunctionT" 2) - ("BoundT" 1) - ("VarT" 1) - ("ExT" 1) + ("Host" 2) + ("Void" 0) + ("Unit" 0) + ("Sum" 2) + ("Product" 2) + ("Function" 2) + ("Bound" 1) + ("Var" 1) + ("Ex" 1) ("UnivQ" 2) ("ExQ" 2) - ("AppT" 2) - ("NamedT" 2)) + ("App" 2) + ("Named" 2)) ;; Vars (defvariant diff --git a/luxc/src/lux/compiler/cache/type.clj b/luxc/src/lux/compiler/cache/type.clj index 5715866f7..f6f06f03c 100644 --- a/luxc/src/lux/compiler/cache/type.clj +++ b/luxc/src/lux/compiler/cache/type.clj @@ -24,22 +24,22 @@ (if (clojure.lang.Util/identical &type/Type type) "T" (|case type - (&/$HostT name params) + (&/$Host name params) (str "^" name stop (serialize-list serialize-type params)) - (&/$VoidT) + (&/$Void) "0" - (&/$UnitT) + (&/$Unit) "1" - (&/$ProdT left right) + (&/$Product left right) (str "*" (serialize-type left) (serialize-type right)) - (&/$SumT left right) + (&/$Sum left right) (str "+" (serialize-type left) (serialize-type right)) - (&/$FunctionT left right) + (&/$Function left right) (str ">" (serialize-type left) (serialize-type right)) (&/$UnivQ env body) @@ -48,19 +48,19 @@ (&/$ExQ env body) (str "E" (serialize-list serialize-type env) (serialize-type body)) - (&/$BoundT idx) + (&/$Bound idx) (str "$" idx stop) - (&/$ExT idx) + (&/$Ex idx) (str "!" idx stop) - (&/$VarT idx) + (&/$Var idx) (str "?" idx stop) - (&/$AppT left right) + (&/$App left right) (str "%" (serialize-type left) (serialize-type right)) - (&/$NamedT [module name] type*) + (&/$Named [module name] type*) (str "@" module ident-separator name stop (serialize-type type*)) _ @@ -85,8 +85,8 @@ [<type> (.substring input 1)] )) - ^:private deserialize-void "0" &/$VoidT - ^:private deserialize-unit "1" &/$UnitT + ^:private deserialize-void "0" &/$Void + ^:private deserialize-unit "1" &/$Unit ^:private deserialize-type* "T" &type/Type ) @@ -98,10 +98,10 @@ [(<type> left right) input*])) )) - ^:private deserialize-sum "+" &/$SumT - ^:private deserialize-prod "*" &/$ProdT - ^:private deserialize-lambda ">" &/$FunctionT - ^:private deserialize-app "%" &/$AppT + ^:private deserialize-sum "+" &/$Sum + ^:private deserialize-prod "*" &/$Product + ^:private deserialize-lambda ">" &/$Function + ^:private deserialize-app "%" &/$App ) (do-template [<name> <signal> <type>] @@ -110,9 +110,9 @@ (let [[idx ^String input*] (.split (.substring input 1) stop 2)] [(<type> (Long/parseLong idx)) input*]))) - ^:private deserialize-bound "$" &/$BoundT - ^:private deserialize-ex "!" &/$ExT - ^:private deserialize-var "?" &/$VarT + ^:private deserialize-bound "$" &/$Bound + ^:private deserialize-ex "!" &/$Ex + ^:private deserialize-var "?" &/$Var ) (defn ^:private deserialize-named [^String input] @@ -120,7 +120,7 @@ (let [[^String module+name ^String input*] (.split (.substring input 1) stop 2) [module name] (.split module+name ident-separator 2)] (when-let [[type* ^String input*] (deserialize-type input*)] - [(&/$NamedT (&/T [module name]) type*) input*])))) + [(&/$Named (&/T [module name]) type*) input*])))) (do-template [<name> <signal> <type>] (defn <name> [^String input] @@ -137,7 +137,7 @@ (when (.startsWith input "^") (let [[name ^String input*] (.split (.substring input 1) stop 2)] (when-let [[params ^String input*] (deserialize-list input*)] - [(&/$HostT name params) input*])))) + [(&/$Host name params) input*])))) (defn deserialize-type "(-> Text Type)" diff --git a/luxc/src/lux/compiler/jvm/proc/host.clj b/luxc/src/lux/compiler/jvm/proc/host.clj index 2c5bbc6cd..94b7ca0d8 100644 --- a/luxc/src/lux/compiler/jvm/proc/host.clj +++ b/luxc/src/lux/compiler/jvm/proc/host.clj @@ -48,40 +48,40 @@ char-class "java.lang.Character"] (defn prepare-return! [^MethodVisitor *writer* *type*] (|case *type* - (&/$UnitT) + (&/$Unit) (.visitLdcInsn *writer* &/unit-tag) - (&/$HostT "boolean" (&/$Nil)) + (&/$Host "boolean" (&/$Nil)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name boolean-class) "valueOf" (str "(Z)" (&host-generics/->type-signature boolean-class))) - (&/$HostT "byte" (&/$Nil)) + (&/$Host "byte" (&/$Nil)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name byte-class) "valueOf" (str "(B)" (&host-generics/->type-signature byte-class))) - (&/$HostT "short" (&/$Nil)) + (&/$Host "short" (&/$Nil)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name short-class) "valueOf" (str "(S)" (&host-generics/->type-signature short-class))) - (&/$HostT "int" (&/$Nil)) + (&/$Host "int" (&/$Nil)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name int-class) "valueOf" (str "(I)" (&host-generics/->type-signature int-class))) - (&/$HostT "long" (&/$Nil)) + (&/$Host "long" (&/$Nil)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name long-class) "valueOf" (str "(J)" (&host-generics/->type-signature long-class))) - (&/$HostT "float" (&/$Nil)) + (&/$Host "float" (&/$Nil)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name float-class) "valueOf" (str "(F)" (&host-generics/->type-signature float-class))) - (&/$HostT "double" (&/$Nil)) + (&/$Host "double" (&/$Nil)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name double-class) "valueOf" (str "(D)" (&host-generics/->type-signature double-class))) - (&/$HostT "char" (&/$Nil)) + (&/$Host "char" (&/$Nil)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name char-class) "valueOf" (str "(C)" (&host-generics/->type-signature char-class))) - (&/$HostT _ _) + (&/$Host _ _) nil - (&/$NamedT ?name ?type) + (&/$Named ?name ?type) (prepare-return! *writer* ?type) - (&/$ExT _) + (&/$Ex _) nil _ diff --git a/luxc/src/lux/host.clj b/luxc/src/lux/host.clj index e222baf10..f602376fb 100644 --- a/luxc/src/lux/host.clj +++ b/luxc/src/lux/host.clj @@ -30,7 +30,7 @@ (defn unfold-array [type] "(-> Type (, Int Type))" (|case type - (&/$HostT "#Array" (&/$Cons param (&/$Nil))) + (&/$Host "#Array" (&/$Cons param (&/$Nil))) (|let [[count inner] (unfold-array param)] (&/T [(inc count) inner])) @@ -42,10 +42,10 @@ (defn ->java-sig [^objects type] "(-> Type (Lux Text))" (|case type - (&/$HostT ?name params) + (&/$Host ?name params) (cond (= &host-type/array-data-tag ?name) (|do [:let [[level base] (unfold-array type)] base-sig (|case base - (&/$HostT base-class _) + (&/$Host base-class _) (return (&host-generics/->type-signature base-class)) _ @@ -55,26 +55,26 @@ (= &host-type/null-data-tag ?name) (return (&host-generics/->type-signature "java.lang.Object")) :else (return (&host-generics/->type-signature ?name))) - (&/$FunctionT _ _) + (&/$Function _ _) (return (&host-generics/->type-signature function-class)) - (&/$UnitT) + (&/$Unit) (return "V") - (&/$SumT _) + (&/$Sum _) (return object-array) - (&/$ProdT _) + (&/$Product _) (return object-array) - (&/$NamedT ?name ?type) + (&/$Named ?name ?type) (->java-sig ?type) - (&/$AppT ?F ?A) + (&/$App ?F ?A) (|do [type* (&type/apply-type ?F ?A)] (->java-sig type*)) - (&/$ExT _) + (&/$Ex _) (return ex-type-class) _ diff --git a/luxc/src/lux/type.clj b/luxc/src/lux/type.clj index f69542442..85ce1613b 100644 --- a/luxc/src/lux/type.clj +++ b/luxc/src/lux/type.clj @@ -23,145 +23,145 @@ (def empty-env &/$Nil) -(def Bool (&/$NamedT (&/T ["lux" "Bool"]) (&/$HostT "#Bool" &/$Nil))) -(def Nat (&/$NamedT (&/T ["lux" "Nat"]) (&/$HostT &&host/nat-data-tag &/$Nil))) -(def Deg (&/$NamedT (&/T ["lux" "Deg"]) (&/$HostT &&host/deg-data-tag &/$Nil))) -(def Int (&/$NamedT (&/T ["lux" "Int"]) (&/$HostT "#Int" &/$Nil))) -(def Real (&/$NamedT (&/T ["lux" "Real"]) (&/$HostT "#Real" &/$Nil))) -(def Char (&/$NamedT (&/T ["lux" "Char"]) (&/$HostT "#Char" &/$Nil))) -(def Text (&/$NamedT (&/T ["lux" "Text"]) (&/$HostT "#Text" &/$Nil))) -(def Ident (&/$NamedT (&/T ["lux" "Ident"]) (&/$ProdT Text Text))) +(def Bool (&/$Named (&/T ["lux" "Bool"]) (&/$Host "#Bool" &/$Nil))) +(def Nat (&/$Named (&/T ["lux" "Nat"]) (&/$Host &&host/nat-data-tag &/$Nil))) +(def Deg (&/$Named (&/T ["lux" "Deg"]) (&/$Host &&host/deg-data-tag &/$Nil))) +(def Int (&/$Named (&/T ["lux" "Int"]) (&/$Host "#Int" &/$Nil))) +(def Real (&/$Named (&/T ["lux" "Real"]) (&/$Host "#Real" &/$Nil))) +(def Char (&/$Named (&/T ["lux" "Char"]) (&/$Host "#Char" &/$Nil))) +(def Text (&/$Named (&/T ["lux" "Text"]) (&/$Host "#Text" &/$Nil))) +(def Ident (&/$Named (&/T ["lux" "Ident"]) (&/$Product Text Text))) (do-template [<name> <tag>] (defn <name> [elem-type] - (&/$HostT <tag> (&/|list elem-type))) + (&/$Host <tag> (&/|list elem-type))) Array "#Array" Atom "#Atom" ) (def Bottom - (&/$NamedT (&/T ["lux" "Bottom"]) - (&/$UnivQ empty-env - (&/$BoundT 1)))) + (&/$Named (&/T ["lux" "Bottom"]) + (&/$UnivQ empty-env + (&/$Bound 1)))) (def Top - (&/$NamedT (&/T ["lux" "Top"]) - (&/$ExQ empty-env - (&/$BoundT 1)))) + (&/$Named (&/T ["lux" "Top"]) + (&/$ExQ empty-env + (&/$Bound 1)))) (def IO - (&/$NamedT (&/T ["lux/codata" "IO"]) - (&/$UnivQ empty-env - (&/$FunctionT &/$VoidT (&/$BoundT 1))))) + (&/$Named (&/T ["lux/codata" "IO"]) + (&/$UnivQ empty-env + (&/$Function &/$Void (&/$Bound 1))))) (def List - (&/$NamedT (&/T ["lux" "List"]) - (&/$UnivQ empty-env - (&/$SumT - ;; lux;Nil - &/$UnitT - ;; lux;Cons - (&/$ProdT (&/$BoundT 1) - (&/$AppT (&/$BoundT 0) - (&/$BoundT 1))))))) + (&/$Named (&/T ["lux" "List"]) + (&/$UnivQ empty-env + (&/$Sum + ;; lux;Nil + &/$Unit + ;; lux;Cons + (&/$Product (&/$Bound 1) + (&/$App (&/$Bound 0) + (&/$Bound 1))))))) (def Maybe - (&/$NamedT (&/T ["lux" "Maybe"]) - (&/$UnivQ empty-env - (&/$SumT - ;; lux;None - &/$UnitT - ;; lux;Some - (&/$BoundT 1)) - ))) + (&/$Named (&/T ["lux" "Maybe"]) + (&/$UnivQ empty-env + (&/$Sum + ;; lux;None + &/$Unit + ;; lux;Some + (&/$Bound 1)) + ))) (def Type - (&/$NamedT (&/T ["lux" "Type"]) - (let [Type (&/$AppT (&/$BoundT 0) (&/$BoundT 1)) - TypeList (&/$AppT List Type) - TypePair (&/$ProdT Type Type)] - (&/$AppT (&/$UnivQ empty-env - (&/$SumT - ;; HostT - (&/$ProdT Text TypeList) - (&/$SumT - ;; VoidT - &/$UnitT - (&/$SumT - ;; UnitT - &/$UnitT - (&/$SumT - ;; SumT + (&/$Named (&/T ["lux" "Type"]) + (let [Type (&/$App (&/$Bound 0) (&/$Bound 1)) + TypeList (&/$App List Type) + TypePair (&/$Product Type Type)] + (&/$App (&/$UnivQ empty-env + (&/$Sum + ;; Host + (&/$Product Text TypeList) + (&/$Sum + ;; Void + &/$Unit + (&/$Sum + ;; Unit + &/$Unit + (&/$Sum + ;; Sum + TypePair + (&/$Sum + ;; Product + TypePair + (&/$Sum + ;; Function TypePair - (&/$SumT - ;; ProdT - TypePair - (&/$SumT - ;; FunctionT - TypePair - (&/$SumT - ;; BoundT + (&/$Sum + ;; Bound + Nat + (&/$Sum + ;; Var + Nat + (&/$Sum + ;; Ex Nat - (&/$SumT - ;; VarT - Nat - (&/$SumT - ;; ExT - Nat - (&/$SumT - ;; UnivQ - (&/$ProdT TypeList Type) - (&/$SumT - ;; ExQ - (&/$ProdT TypeList Type) - (&/$SumT - ;; AppT - TypePair - ;; NamedT - (&/$ProdT Ident Type))))))))))))) - ) - &/$VoidT)))) + (&/$Sum + ;; UnivQ + (&/$Product TypeList Type) + (&/$Sum + ;; ExQ + (&/$Product TypeList Type) + (&/$Sum + ;; App + TypePair + ;; Named + (&/$Product Ident Type))))))))))))) + ) + &/$Void)))) (def Ann-Value - (&/$NamedT (&/T ["lux" "Ann-Value"]) - (let [Ann-Value (&/$AppT (&/$BoundT 0) (&/$BoundT 1))] - (&/$AppT (&/$UnivQ empty-env - (&/$SumT - ;; BoolA - Bool - (&/$SumT - ;; NatA - Nat - (&/$SumT - ;; IntA - Int - (&/$SumT - ;; DegA - Deg - (&/$SumT - ;; RealA - Real - (&/$SumT - ;; CharA - Char - (&/$SumT - ;; TextA - Text - (&/$SumT - ;; IdentA - Ident - (&/$SumT - ;; ListA - (&/$AppT List Ann-Value) - ;; DictA - (&/$AppT List (&/$ProdT Text Ann-Value))))))))))) - ) - &/$VoidT)))) + (&/$Named (&/T ["lux" "Ann-Value"]) + (let [Ann-Value (&/$App (&/$Bound 0) (&/$Bound 1))] + (&/$App (&/$UnivQ empty-env + (&/$Sum + ;; BoolA + Bool + (&/$Sum + ;; NatA + Nat + (&/$Sum + ;; IntA + Int + (&/$Sum + ;; DegA + Deg + (&/$Sum + ;; RealA + Real + (&/$Sum + ;; CharA + Char + (&/$Sum + ;; TextA + Text + (&/$Sum + ;; IdentA + Ident + (&/$Sum + ;; ListA + (&/$App List Ann-Value) + ;; DictA + (&/$App List (&/$Product Text Ann-Value))))))))))) + ) + &/$Void)))) (def Anns - (&/$NamedT (&/T ["lux" "Anns"]) - (&/$AppT List (&/$ProdT Ident Ann-Value)))) + (&/$Named (&/T ["lux" "Anns"]) + (&/$App List (&/$Product Ident Ann-Value)))) (def Macro) @@ -196,7 +196,7 @@ (defn deref+ [type] (|case type - (&/$VarT id) + (&/$Var id) (deref id) _ @@ -270,7 +270,7 @@ (->> compiler (&/get$ &/$type-context) (&/get$ &/$ex-counter) - &/$ExT)))) + &/$Ex)))) (declare clean*) (defn delete-var [id] @@ -290,7 +290,7 @@ (&/$Some ?type*) (|case ?type* - (&/$VarT ?id*) + (&/$Var ?id*) (if (= id ?id*) (return (&/T [?id &/$None])) (return binding)) @@ -308,13 +308,13 @@ (defn with-var [k] (|do [id create-var - output (k (&/$VarT id)) + output (k (&/$Var id)) _ (delete-var id)] (return output))) (defn clean* [?tid type] (|case type - (&/$VarT ?id) + (&/$Var ?id) (if (= ?tid ?id) (|do [? (bound? ?id)] (if ? @@ -325,7 +325,7 @@ (|do [=type (deref ?id) ==type (clean* ?tid =type)] (|case ==type - (&/$VarT =id) + (&/$Var =id) (if (= ?tid =id) (|do [_ (unset-var ?id)] (return type)) @@ -338,38 +338,38 @@ (return type))) ) - (&/$HostT ?name ?params) + (&/$Host ?name ?params) (|do [=params (&/map% (partial clean* ?tid) ?params)] - (return (&/$HostT ?name =params))) + (return (&/$Host ?name =params))) - (&/$FunctionT ?arg ?return) + (&/$Function ?arg ?return) (|do [=arg (clean* ?tid ?arg) =return (clean* ?tid ?return)] - (return (&/$FunctionT =arg =return))) + (return (&/$Function =arg =return))) - (&/$AppT ?lambda ?param) + (&/$App ?lambda ?param) (|do [=lambda (clean* ?tid ?lambda) =param (clean* ?tid ?param)] - (return (&/$AppT =lambda =param))) + (return (&/$App =lambda =param))) - (&/$ProdT ?left ?right) + (&/$Product ?left ?right) (|do [=left (clean* ?tid ?left) =right (clean* ?tid ?right)] - (return (&/$ProdT =left =right))) + (return (&/$Product =left =right))) - (&/$SumT ?left ?right) + (&/$Sum ?left ?right) (|do [=left (clean* ?tid ?left) =right (clean* ?tid ?right)] - (return (&/$SumT =left =right))) + (return (&/$Sum =left =right))) (&/$UnivQ ?env ?body) (|do [=env (&/map% (partial clean* ?tid) ?env) - body* (clean* ?tid ?body)] ;; TODO: DON'T CLEAN THE BODY + body* (clean* ?tid ?body)] ;; TODO: DO NOT CLEAN THE BODY (return (&/$UnivQ =env body*))) (&/$ExQ ?env ?body) (|do [=env (&/map% (partial clean* ?tid) ?env) - body* (clean* ?tid ?body)] ;; TODO: DON'T CLEAN THE BODY + body* (clean* ?tid ?body)] ;; TODO: DO NOT CLEAN THE BODY (return (&/$ExQ =env body*))) _ @@ -378,7 +378,7 @@ (defn clean [tvar type] (|case tvar - (&/$VarT ?id) + (&/$Var ?id) (clean* ?id type) _ @@ -386,7 +386,7 @@ (defn ^:private unravel-fun [type] (|case type - (&/$FunctionT ?in ?out) + (&/$Function ?in ?out) (|let [[??out ?args] (unravel-fun ?out)] (&/T [??out (&/$Cons ?in ?args)])) @@ -395,7 +395,7 @@ (defn ^:private unravel-app [fun-type] (|case fun-type - (&/$AppT ?left ?right) + (&/$App ?left ?right) (|let [[?fun-type ?args] (unravel-app ?left)] (&/T [?fun-type (&/|++ ?args (&/|list ?right))])) @@ -415,7 +415,7 @@ (defn <at> [tag type] "(-> Int Type (Lux Type))" (|case type - (&/$NamedT ?name ?type) + (&/$Named ?name ?type) (<at> tag ?type) (<tag> ?left ?right) @@ -429,8 +429,8 @@ _ (&/fail-with-loc (str "[Type Error] Type is not a " <desc> ": " (show-type type)))))) - &/$SumT flatten-sum sum-at "Sum" - &/$ProdT flatten-prod prod-at "Product" + &/$Sum flatten-sum sum-at "Sum" + &/$Product flatten-prod prod-at "Product" ) (do-template [<name> <ctor> <unit>] @@ -443,13 +443,13 @@ (&/$Nil) <unit>)) - Variant$ &/$SumT &/$VoidT - Tuple$ &/$ProdT &/$UnitT + Variant$ &/$Sum &/$Void + Tuple$ &/$Product &/$Unit ) (defn show-type [^objects type] (|case type - (&/$HostT name params) + (&/$Host name params) (|case params (&/$Nil) (str "(host " name ")") @@ -457,32 +457,32 @@ _ (str "(host " name " " (->> params (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")")) - (&/$VoidT) + (&/$Void) "Void" - (&/$UnitT) + (&/$Unit) "Unit" - (&/$ProdT _) + (&/$Product _) (str "[" (->> (flatten-prod type) (&/|map show-type) (&/|interpose " ") (&/fold str "")) "]") - (&/$SumT _) + (&/$Sum _) (str "(| " (->> (flatten-sum type) (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")") - (&/$FunctionT input output) + (&/$Function input output) (|let [[?out ?ins] (unravel-fun type)] (str "(-> " (->> ?ins (&/|map show-type) (&/|interpose " ") (&/fold str "")) " " (show-type ?out) ")")) - (&/$VarT id) + (&/$Var id) (str "⌈v:" id "⌋") - (&/$ExT ?id) + (&/$Ex ?id) (str "⟨e:" ?id "⟩") - (&/$BoundT idx) + (&/$Bound idx) (str idx) - (&/$AppT _ _) + (&/$App _ _) (|let [[?call-fun ?call-args] (unravel-app type)] (str "(" (show-type ?call-fun) " " (->> ?call-args (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")")) @@ -494,7 +494,7 @@ (str "(Ex " "{" (->> ?env (&/|map show-type) (&/|interpose " ") (&/fold str "")) "} " (show-type ?body) ")") - (&/$NamedT ?name ?type) + (&/$Named ?name ?type) (&/ident->text ?name) _ @@ -503,52 +503,52 @@ (defn type= [x y] (or (clojure.lang.Util/identical x y) (let [output (|case [x y] - [(&/$NamedT [?xmodule ?xname] ?xtype) (&/$NamedT [?ymodule ?yname] ?ytype)] + [(&/$Named [?xmodule ?xname] ?xtype) (&/$Named [?ymodule ?yname] ?ytype)] (and (= ?xmodule ?ymodule) (= ?xname ?yname)) - [(&/$HostT xname xparams) (&/$HostT yname yparams)] + [(&/$Host xname xparams) (&/$Host yname yparams)] (and (.equals ^Object xname yname) (= (&/|length xparams) (&/|length yparams)) (&/fold2 #(and %1 (type= %2 %3)) true xparams yparams)) - [(&/$VoidT) (&/$VoidT)] + [(&/$Void) (&/$Void)] true - [(&/$UnitT) (&/$UnitT)] + [(&/$Unit) (&/$Unit)] true - [(&/$ProdT xL xR) (&/$ProdT yL yR)] + [(&/$Product xL xR) (&/$Product yL yR)] (and (type= xL yL) (type= xR yR)) - [(&/$SumT xL xR) (&/$SumT yL yR)] + [(&/$Sum xL xR) (&/$Sum yL yR)] (and (type= xL yL) (type= xR yR)) - [(&/$FunctionT xinput xoutput) (&/$FunctionT yinput youtput)] + [(&/$Function xinput xoutput) (&/$Function yinput youtput)] (and (type= xinput yinput) (type= xoutput youtput)) - [(&/$VarT xid) (&/$VarT yid)] + [(&/$Var xid) (&/$Var yid)] (= xid yid) - [(&/$BoundT xidx) (&/$BoundT yidx)] + [(&/$Bound xidx) (&/$Bound yidx)] (= xidx yidx) - [(&/$ExT xid) (&/$ExT yid)] + [(&/$Ex xid) (&/$Ex yid)] (= xid yid) - [(&/$AppT xlambda xparam) (&/$AppT ylambda yparam)] + [(&/$App xlambda xparam) (&/$App ylambda yparam)] (and (type= xlambda ylambda) (type= xparam yparam)) [(&/$UnivQ xenv xbody) (&/$UnivQ yenv ybody)] (type= xbody ybody) - [(&/$NamedT ?xname ?xtype) _] + [(&/$Named ?xname ?xtype) _] (type= ?xtype y) - [_ (&/$NamedT ?yname ?ytype)] + [_ (&/$Named ?yname ?ytype)] (type= x ?ytype) [_ _] @@ -574,7 +574,7 @@ (defn show-type+ [type] (|case type - (&/$VarT ?id) + (&/$Var ?id) (fn [state] (|case ((deref ?id) state) (&/$Right state* bound) @@ -597,17 +597,17 @@ (defn beta-reduce [env type] (|case type - (&/$HostT ?name ?params) - (&/$HostT ?name (&/|map (partial beta-reduce env) ?params)) + (&/$Host ?name ?params) + (&/$Host ?name (&/|map (partial beta-reduce env) ?params)) - (&/$SumT ?left ?right) - (&/$SumT (beta-reduce env ?left) (beta-reduce env ?right)) + (&/$Sum ?left ?right) + (&/$Sum (beta-reduce env ?left) (beta-reduce env ?right)) - (&/$ProdT ?left ?right) - (&/$ProdT (beta-reduce env ?left) (beta-reduce env ?right)) + (&/$Product ?left ?right) + (&/$Product (beta-reduce env ?left) (beta-reduce env ?right)) - (&/$AppT ?type-fn ?type-arg) - (&/$AppT (beta-reduce env ?type-fn) (beta-reduce env ?type-arg)) + (&/$App ?type-fn ?type-arg) + (&/$App (beta-reduce env ?type-fn) (beta-reduce env ?type-arg)) (&/$UnivQ ?local-env ?local-def) (|case ?local-env @@ -625,10 +625,10 @@ _ type) - (&/$FunctionT ?input ?output) - (&/$FunctionT (beta-reduce env ?input) (beta-reduce env ?output)) + (&/$Function ?input ?output) + (&/$Function (beta-reduce env ?input) (beta-reduce env ?output)) - (&/$BoundT ?idx) + (&/$Bound ?idx) (|case (&/|at ?idx env) (&/$Some bound) (beta-reduce env bound) @@ -654,18 +654,18 @@ (&/$Cons type-fn)) local-def)) - (&/$AppT F A) + (&/$App F A) (|do [type-fn* (apply-type F A)] (apply-type type-fn* param)) - (&/$NamedT ?name ?type) + (&/$Named ?name ?type) (apply-type ?type param) ;; TODO: This one must go... - (&/$ExT id) - (return (&/$AppT type-fn param)) + (&/$Ex id) + (return (&/$App type-fn param)) - (&/$VarT id) + (&/$Var id) (|do [=type-fun (deref id)] (apply-type =type-fun param)) @@ -679,7 +679,7 @@ (return fixpoints) (&/with-attempt (|case [expected actual] - [(&/$VarT ?eid) (&/$VarT ?aid)] + [(&/$Var ?eid) (&/$Var ?aid)] (if (= ?eid ?aid) (return fixpoints) (|do [ebound (fn [state] @@ -710,7 +710,7 @@ [(&/$Some etype) (&/$Some atype)] (check* fixpoints invariant?? etype atype)))) - [(&/$VarT ?id) _] + [(&/$Var ?id) _] (fn [state] (|case ((set-var ?id actual) state) (&/$Right state* _) @@ -721,7 +721,7 @@ (check* fixpoints invariant?? bound actual)) state))) - [_ (&/$VarT ?id)] + [_ (&/$Var ?id)] (fn [state] (|case ((set-var ?id expected) state) (&/$Right state* _) @@ -732,15 +732,15 @@ (check* fixpoints invariant?? expected bound)) state))) - [(&/$AppT (&/$ExT eid) eA) (&/$AppT (&/$ExT aid) aA)] + [(&/$App (&/$Ex eid) eA) (&/$App (&/$Ex aid) aA)] (if (= eid aid) (check* fixpoints invariant?? eA aA) (check-error "" expected actual)) - [(&/$AppT (&/$VarT ?id) A1) (&/$AppT F2 A2)] + [(&/$App (&/$Var ?id) A1) (&/$App F2 A2)] (fn [state] (|case ((|do [F1 (deref ?id)] - (check* fixpoints invariant?? (&/$AppT F1 A1) actual)) + (check* fixpoints invariant?? (&/$App F1 A1) actual)) state) (&/$Right state* output) (return* state* output) @@ -752,34 +752,34 @@ (check* fixpoints invariant?? expected actual*)) state) - (&/$ExT _) - ((|do [fixpoints* (check* fixpoints invariant?? (&/$VarT ?id) F2)] + (&/$Ex _) + ((|do [fixpoints* (check* fixpoints invariant?? (&/$Var ?id) F2)] (check* fixpoints* invariant?? A1 A2)) state) _ - ((|do [fixpoints* (check* fixpoints invariant?? (&/$VarT ?id) F2) + ((|do [fixpoints* (check* fixpoints invariant?? (&/$Var ?id) F2) e* (apply-type F2 A1) a* (apply-type F2 A2)] (check* fixpoints* invariant?? e* a*)) state)))) - [(&/$AppT F1 A1) (&/$AppT (&/$VarT ?id) A2)] + [(&/$App F1 A1) (&/$App (&/$Var ?id) A2)] (fn [state] (|case ((|do [F2 (deref ?id)] - (check* fixpoints invariant?? expected (&/$AppT F2 A2))) + (check* fixpoints invariant?? expected (&/$App F2 A2))) state) (&/$Right state* output) (return* state* output) (&/$Left _) - ((|do [fixpoints* (check* fixpoints invariant?? F1 (&/$VarT ?id)) + ((|do [fixpoints* (check* fixpoints invariant?? F1 (&/$Var ?id)) e* (apply-type F1 A1) a* (apply-type F1 A2)] (check* fixpoints* invariant?? e* a*)) state))) - [(&/$AppT F A) _] + [(&/$App F A) _] (let [fp-pair (&/T [expected actual]) _ (when (> (&/|length fixpoints) 64) (&/|log! (println-str 'FIXPOINTS (->> (&/|keys fixpoints) @@ -789,7 +789,7 @@ (show-type a))))) (&/|interpose "\n\n") (&/fold str "")))) - (assert false (prn-str 'check* '[(&/$AppT F A) _] (&/|length fixpoints) (show-type expected) (show-type actual))))] + (assert false (prn-str 'check* '[(&/$App F A) _] (&/|length fixpoints) (show-type expected) (show-type actual))))] (|case (fp-get fp-pair fixpoints) (&/$Some ?) (if ? @@ -800,10 +800,10 @@ (|do [expected* (apply-type F A)] (check* (fp-put fp-pair true fixpoints) invariant?? expected* actual)))) - [_ (&/$AppT (&/$ExT aid) A)] + [_ (&/$App (&/$Ex aid) A)] (check-error "" expected actual) - [_ (&/$AppT F A)] + [_ (&/$App F A)] (|do [actual* (apply-type F A)] (check* fixpoints invariant?? expected actual*)) @@ -833,7 +833,7 @@ actual* (apply-type actual $arg)] (check* fixpoints invariant?? expected actual*)) - [(&/$HostT e!data) (&/$HostT a!data)] + [(&/$Host e!data) (&/$Host a!data)] (|do [? &/jvm?] (if ? (|do [class-loader &/loader] @@ -853,33 +853,33 @@ (return fixpoints)) (check-error "" expected actual))))) - [(&/$VoidT) (&/$VoidT)] + [(&/$Void) (&/$Void)] (return fixpoints) - [(&/$UnitT) (&/$UnitT)] + [(&/$Unit) (&/$Unit)] (return fixpoints) - [(&/$FunctionT eI eO) (&/$FunctionT aI aO)] + [(&/$Function eI eO) (&/$Function aI aO)] (|do [fixpoints* (check* fixpoints invariant?? aI eI)] (check* fixpoints* invariant?? eO aO)) - [(&/$ProdT eL eR) (&/$ProdT aL aR)] + [(&/$Product eL eR) (&/$Product aL aR)] (|do [fixpoints* (check* fixpoints invariant?? eL aL)] (check* fixpoints* invariant?? eR aR)) - [(&/$SumT eL eR) (&/$SumT aL aR)] + [(&/$Sum eL eR) (&/$Sum aL aR)] (|do [fixpoints* (check* fixpoints invariant?? eL aL)] (check* fixpoints* invariant?? eR aR)) - [(&/$ExT e!id) (&/$ExT a!id)] + [(&/$Ex e!id) (&/$Ex a!id)] (if (= e!id a!id) (return fixpoints) (check-error "" expected actual)) - [(&/$NamedT _ ?etype) _] + [(&/$Named _ ?etype) _] (check* fixpoints invariant?? ?etype actual) - [_ (&/$NamedT _ ?atype)] + [_ (&/$Named _ ?atype)] (check* fixpoints invariant?? expected ?atype) [_ _] @@ -894,15 +894,15 @@ (defn actual-type [type] "(-> Type (Lux Type))" (|case type - (&/$AppT ?all ?param) + (&/$App ?all ?param) (|do [type* (apply-type ?all ?param)] (actual-type type*)) - (&/$VarT id) + (&/$Var id) (|do [=type (deref id)] (actual-type =type)) - (&/$NamedT ?name ?type) + (&/$Named ?name ?type) (actual-type ?type) _ @@ -912,7 +912,7 @@ (defn type-name [type] "(-> Type (Lux Ident))" (|case type - (&/$NamedT name _) + (&/$Named name _) (return name) _ @@ -922,7 +922,7 @@ (defn unknown? [type] "(-> Type (Lux Bool))" (|case type - (&/$VarT id) + (&/$Var id) (|do [? (bound? id)] (return (not ?))) @@ -932,7 +932,7 @@ (defn resolve-type [type] "(-> Type (Lux Type))" (|case type - (&/$VarT id) + (&/$Var id) (|do [? (bound? id)] (if ? (deref id) @@ -949,7 +949,7 @@ (&/T [size-members (&/|++ (&/|take (dec size-members) ?member-types) (&/|list (|case (->> ?member-types (&/|drop (dec size-members)) (&/|reverse)) (&/$Cons last prevs) - (&/fold (fn [right left] (&/$ProdT left right)) + (&/fold (fn [right left] (&/$Product left right)) last prevs))))]) (&/T [size-types ?member-types]) ))) @@ -966,48 +966,48 @@ (&/$Cons last prevs) (&/fold (fn [r l] (<plus> l r)) last prevs))) - fold-prod &/$UnitT &/$ProdT - fold-sum &/$VoidT &/$SumT + fold-prod &/$Unit &/$Product + fold-sum &/$Void &/$Sum ) (def create-var+ (|do [id create-var] - (return (&/$VarT id)))) + (return (&/$Var id)))) (defn ^:private push-app [inf-type inf-var] (|case inf-type - (&/$AppT inf-type* inf-var*) - (&/$AppT (push-app inf-type* inf-var) inf-var*) + (&/$App inf-type* inf-var*) + (&/$App (push-app inf-type* inf-var) inf-var*) _ - (&/$AppT inf-type inf-var))) + (&/$App inf-type inf-var))) (defn ^:private push-name [name inf-type] (|case inf-type - (&/$AppT inf-type* inf-var*) - (&/$AppT (push-name name inf-type*) inf-var*) + (&/$App inf-type* inf-var*) + (&/$App (push-name name inf-type*) inf-var*) _ - (&/$NamedT name inf-type))) + (&/$Named name inf-type))) (defn ^:private push-univq [env inf-type] (|case inf-type - (&/$AppT inf-type* inf-var*) - (&/$AppT (push-univq env inf-type*) inf-var*) + (&/$App inf-type* inf-var*) + (&/$App (push-univq env inf-type*) inf-var*) _ (&/$UnivQ env inf-type))) (defn instantiate-inference [type] (|case type - (&/$NamedT ?name ?type) + (&/$Named ?name ?type) (|do [output (instantiate-inference ?type)] (return (push-name ?name output))) (&/$UnivQ _aenv _abody) (|do [inf-var create-var output (instantiate-inference _abody)] - (return (push-univq _aenv (push-app output (&/$VarT inf-var))))) + (return (push-univq _aenv (push-app output (&/$Var inf-var))))) _ (return type))) diff --git a/luxc/src/lux/type/host.clj b/luxc/src/lux/type/host.clj index e2f7c1c1f..7d894b4df 100644 --- a/luxc/src/lux/type/host.clj +++ b/luxc/src/lux/type/host.clj @@ -77,18 +77,18 @@ (let [gclass-name (.getName class)] (case gclass-name ("[Z" "[B" "[S" "[I" "[J" "[F" "[D" "[C") - (&/$HostT gclass-name (&/|list)) + (&/$Host gclass-name (&/|list)) ;; else (if-let [[_ _ arr-obrackets arr-obase simple-base arr-pbrackets arr-pbase] (re-find class-name-re gclass-name)] (let [base (or arr-obase simple-base (jprim->lprim arr-pbase))] (if (.equals "void" base) - &/$UnitT - (reduce (fn [inner _] (&/$HostT array-data-tag (&/|list inner))) - (&/$HostT base (try (-> (Class/forName base) .getTypeParameters - seq count (repeat (&/$HostT "java.lang.Object" &/$Nil)) - &/->list) - (catch Exception e - (&/|list)))) + &/$Unit + (reduce (fn [inner _] (&/$Host array-data-tag (&/|list inner))) + (&/$Host base (try (-> (Class/forName base) .getTypeParameters + seq count (repeat (&/$Host "java.lang.Object" &/$Nil)) + &/->list) + (catch Exception e + (&/|list)))) (range (count (or arr-obrackets arr-pbrackets ""))))) )))))) @@ -99,7 +99,7 @@ (instance? GenericArrayType refl-type) (|do [inner-type (instance-param existential matchings (.getGenericComponentType ^GenericArrayType refl-type))] - (return (&/$HostT array-data-tag (&/|list inner-type)))) + (return (&/$Host array-data-tag (&/|list inner-type)))) (instance? ParameterizedType refl-type) (|do [:let [refl-type* ^ParameterizedType refl-type] @@ -107,8 +107,8 @@ .getActualTypeArguments seq &/->list (&/map% (partial instance-param existential matchings)))] - (return (&/$HostT (->> refl-type* ^Class (.getRawType) .getName) - params*))) + (return (&/$Host (->> refl-type* ^Class (.getRawType) .getName) + params*))) (instance? TypeVariable refl-type) (let [gvar (.getName ^TypeVariable refl-type)] @@ -127,13 +127,13 @@ (defn principal-class [refl-type] (cond (instance? Class refl-type) (|case (class->type refl-type) - (&/$HostT "#Array" (&/$Cons (&/$HostT class-name _) (&/$Nil))) + (&/$Host "#Array" (&/$Cons (&/$Host class-name _) (&/$Nil))) (str "[" (&host-generics/->type-signature class-name)) - (&/$HostT class-name _) + (&/$Host class-name _) (&host-generics/->type-signature class-name) - (&/$UnitT) + (&/$Unit) "V") (instance? GenericArrayType refl-type) @@ -157,7 +157,7 @@ (|case gtype (&/$GenericArray component-type) (|do [inner-type (instance-gtype existential matchings component-type)] - (return (&/$HostT array-data-tag (&/|list inner-type)))) + (return (&/$Host array-data-tag (&/|list inner-type)))) (&/$GenericClass type-name type-params) ;; When referring to type-parameters during class or method @@ -171,7 +171,7 @@ (return m-type) (|do [params* (&/map% (partial instance-gtype existential matchings) type-params)] - (return (&/$HostT type-name params*)))) + (return (&/$Host type-name params*)))) (&/$GenericTypeVar var-name) (if-let [m-type (&/|get var-name matchings)] @@ -232,7 +232,7 @@ (if (.isAssignableFrom super-class+ sub-class+) (let [lineage (trace-lineage sub-class+ super-class+)] (|do [[^Class sub-class* sub-params*] (raise existential lineage sub-class+ sub-params)] - (return (&/$HostT (.getName sub-class*) sub-params*)))) + (return (&/$Host (.getName sub-class*) sub-params*)))) (&/fail-with-loc (str "[Host Error] Classes do not have a subtyping relationship: " sub-class " </= " super-class))))) (defn as-obj [class] @@ -271,7 +271,7 @@ (if (= (&/|length e!params) (&/|length a!params)) (|do [_ (&/map2% check e!params a!params)] (return fixpoints)) - (check-error "" (&/$HostT e!name e!params) (&/$HostT a!name a!params))) + (check-error "" (&/$Host e!name e!params) (&/$Host a!name a!params))) (or (lux-type? e!name) (lux-type? a!name)) @@ -280,14 +280,14 @@ (and (not (primitive-type? e!name)) (= null-data-tag a!name))) (return fixpoints) - (check-error "" (&/$HostT e!name e!params) (&/$HostT a!name a!params))) + (check-error "" (&/$Host e!name e!params) (&/$Host a!name a!params))) (not invariant??) (|do [actual* (->super-type existential class-loader e!name a!name a!params)] - (check (&/$HostT e!name e!params) actual*)) + (check (&/$Host e!name e!params) actual*)) :else - (check-error "" (&/$HostT e!name e!params) (&/$HostT a!name a!params)))) + (check-error "" (&/$Host e!name e!params) (&/$Host a!name a!params)))) (catch Exception e (throw e))))) diff --git a/luxc/test/test/lux/type.clj b/luxc/test/test/lux/type.clj index a12e5c89b..5a9a7ff1b 100644 --- a/luxc/test/test/lux/type.clj +++ b/luxc/test/test/lux/type.clj @@ -7,9 +7,9 @@ ;; [Tests] (deftest check-base-types - (|case (&/run-state (|do [_ (&type/check &/$UnitT &/$UnitT) + (|case (&/run-state (|do [_ (&type/check &/$Unit &/$Unit) - _ (&type/check &/$VoidT &/$VoidT)] + _ (&type/check &/$Void &/$Void)] (return nil)) (&/init-state nil)) (&/$Right state nil) @@ -20,11 +20,11 @@ )) (deftest check-simple-host-types - (|case (&/run-state (|do [_ (&type/check (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil)) + (|case (&/run-state (|do [_ (&type/check (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil)) - _ (&type/check (&/$HostT "java.lang.Object" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil))] + _ (&type/check (&/$Host "java.lang.Object" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil))] (return nil)) (&/init-state nil)) (&/$Right state nil) @@ -35,14 +35,14 @@ )) (deftest check-complex-host-types - (|case (&/run-state (|do [_ (&type/check (&/$HostT "java.util.List" (&/|list (&/$HostT "java.lang.Boolean" &/$Nil))) - (&/$HostT "java.util.List" (&/|list (&/$HostT "java.lang.Boolean" &/$Nil)))) + (|case (&/run-state (|do [_ (&type/check (&/$Host "java.util.List" (&/|list (&/$Host "java.lang.Boolean" &/$Nil))) + (&/$Host "java.util.List" (&/|list (&/$Host "java.lang.Boolean" &/$Nil)))) - _ (&type/check (&/$HostT "java.util.List" (&/|list (&/$HostT "java.lang.Object" &/$Nil))) - (&/$HostT "java.util.List" (&/|list (&/$HostT "java.lang.Boolean" &/$Nil)))) + _ (&type/check (&/$Host "java.util.List" (&/|list (&/$Host "java.lang.Object" &/$Nil))) + (&/$Host "java.util.List" (&/|list (&/$Host "java.lang.Boolean" &/$Nil)))) - _ (&type/check (&/$HostT "java.util.List" (&/|list (&/$HostT "java.lang.Boolean" &/$Nil))) - (&/$HostT "java.util.ArrayList" (&/|list (&/$HostT "java.lang.Boolean" &/$Nil))))] + _ (&type/check (&/$Host "java.util.List" (&/|list (&/$Host "java.lang.Boolean" &/$Nil))) + (&/$Host "java.util.ArrayList" (&/|list (&/$Host "java.lang.Boolean" &/$Nil))))] (return nil)) (&/init-state nil)) (&/$Right state nil) @@ -53,14 +53,14 @@ )) (deftest check-named-types - (|case (&/run-state (|do [_ (&type/check (&/$NamedT (&/T ["lux" "Bool"]) (&/$HostT "java.lang.Boolean" &/$Nil)) - (&/$HostT "java.lang.Boolean" &/$Nil)) + (|case (&/run-state (|do [_ (&type/check (&/$Named (&/T ["lux" "Bool"]) (&/$Host "java.lang.Boolean" &/$Nil)) + (&/$Host "java.lang.Boolean" &/$Nil)) - _ (&type/check (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$NamedT (&/T ["lux" "Bool"]) (&/$HostT "java.lang.Boolean" &/$Nil))) + _ (&type/check (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Named (&/T ["lux" "Bool"]) (&/$Host "java.lang.Boolean" &/$Nil))) - _ (&type/check (&/$NamedT (&/T ["lux" "Bool"]) (&/$HostT "java.lang.Boolean" &/$Nil)) - (&/$NamedT (&/T ["lux" "Bool"]) (&/$HostT "java.lang.Boolean" &/$Nil)))] + _ (&type/check (&/$Named (&/T ["lux" "Bool"]) (&/$Host "java.lang.Boolean" &/$Nil)) + (&/$Named (&/T ["lux" "Bool"]) (&/$Host "java.lang.Boolean" &/$Nil)))] (return nil)) (&/init-state nil)) (&/$Right state nil) @@ -71,41 +71,41 @@ )) (deftest check-sum-types - (|case (&/run-state (|do [_ (&type/check (&/$SumT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil)) - (&/$SumT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil))) - - _ (&type/check (&/$SumT (&/$HostT "java.lang.Object" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil)) - (&/$SumT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil))) - - _ (&type/check (&/$SumT (&/$HostT "java.lang.Object" &/$Nil) - (&/$HostT "java.lang.Object" &/$Nil)) - (&/$SumT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil))) - - _ (&type/check (&/$SumT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$SumT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil))) - (&/$SumT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$SumT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil)))) - - _ (&type/check (&/$SumT (&/$HostT "java.lang.Object" &/$Nil) - (&/$SumT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil))) - (&/$SumT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$SumT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil)))) - - _ (&type/check (&/$SumT (&/$HostT "java.lang.Object" &/$Nil) - (&/$SumT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Object" &/$Nil))) - (&/$SumT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$SumT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil))))] + (|case (&/run-state (|do [_ (&type/check (&/$Sum (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil)) + (&/$Sum (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil))) + + _ (&type/check (&/$Sum (&/$Host "java.lang.Object" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil)) + (&/$Sum (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil))) + + _ (&type/check (&/$Sum (&/$Host "java.lang.Object" &/$Nil) + (&/$Host "java.lang.Object" &/$Nil)) + (&/$Sum (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil))) + + _ (&type/check (&/$Sum (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Sum (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil))) + (&/$Sum (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Sum (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil)))) + + _ (&type/check (&/$Sum (&/$Host "java.lang.Object" &/$Nil) + (&/$Sum (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil))) + (&/$Sum (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Sum (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil)))) + + _ (&type/check (&/$Sum (&/$Host "java.lang.Object" &/$Nil) + (&/$Sum (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Object" &/$Nil))) + (&/$Sum (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Sum (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil))))] (return nil)) (&/init-state nil)) (&/$Right state nil) @@ -116,41 +116,41 @@ )) (deftest check-prod-types - (|case (&/run-state (|do [_ (&type/check (&/$ProdT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil)) - (&/$ProdT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil))) - - _ (&type/check (&/$ProdT (&/$HostT "java.lang.Object" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil)) - (&/$ProdT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil))) - - _ (&type/check (&/$ProdT (&/$HostT "java.lang.Object" &/$Nil) - (&/$HostT "java.lang.Object" &/$Nil)) - (&/$ProdT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil))) - - _ (&type/check (&/$ProdT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$ProdT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil))) - (&/$ProdT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$ProdT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil)))) - - _ (&type/check (&/$ProdT (&/$HostT "java.lang.Object" &/$Nil) - (&/$ProdT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil))) - (&/$ProdT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$ProdT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil)))) - - _ (&type/check (&/$ProdT (&/$HostT "java.lang.Object" &/$Nil) - (&/$ProdT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Object" &/$Nil))) - (&/$ProdT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$ProdT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil))))] + (|case (&/run-state (|do [_ (&type/check (&/$Product (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil)) + (&/$Product (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil))) + + _ (&type/check (&/$Product (&/$Host "java.lang.Object" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil)) + (&/$Product (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil))) + + _ (&type/check (&/$Product (&/$Host "java.lang.Object" &/$Nil) + (&/$Host "java.lang.Object" &/$Nil)) + (&/$Product (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil))) + + _ (&type/check (&/$Product (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Product (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil))) + (&/$Product (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Product (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil)))) + + _ (&type/check (&/$Product (&/$Host "java.lang.Object" &/$Nil) + (&/$Product (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil))) + (&/$Product (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Product (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil)))) + + _ (&type/check (&/$Product (&/$Host "java.lang.Object" &/$Nil) + (&/$Product (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Object" &/$Nil))) + (&/$Product (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Product (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil))))] (return nil)) (&/init-state nil)) (&/$Right state nil) @@ -161,41 +161,41 @@ )) (deftest check-lambda-types - (|case (&/run-state (|do [_ (&type/check (&/$LambdaT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil)) - (&/$LambdaT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil))) - - _ (&type/check (&/$LambdaT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil)) - (&/$LambdaT (&/$HostT "java.lang.Object" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil))) - - _ (&type/check (&/$LambdaT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Object" &/$Nil)) - (&/$LambdaT (&/$HostT "java.lang.Object" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil))) + (|case (&/run-state (|do [_ (&type/check (&/$Lambda (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil)) + (&/$Lambda (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil))) + + _ (&type/check (&/$Lambda (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil)) + (&/$Lambda (&/$Host "java.lang.Object" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil))) + + _ (&type/check (&/$Lambda (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Object" &/$Nil)) + (&/$Lambda (&/$Host "java.lang.Object" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil))) - _ (&type/check (&/$LambdaT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$LambdaT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil))) - (&/$LambdaT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$LambdaT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil)))) - - _ (&type/check (&/$LambdaT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$LambdaT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil))) - (&/$LambdaT (&/$HostT "java.lang.Object" &/$Nil) - (&/$LambdaT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil)))) - - _ (&type/check (&/$LambdaT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$LambdaT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Object" &/$Nil))) - (&/$LambdaT (&/$HostT "java.lang.Object" &/$Nil) - (&/$LambdaT (&/$HostT "java.lang.Boolean" &/$Nil) - (&/$HostT "java.lang.Boolean" &/$Nil)))) + _ (&type/check (&/$Lambda (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Lambda (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil))) + (&/$Lambda (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Lambda (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil)))) + + _ (&type/check (&/$Lambda (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Lambda (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil))) + (&/$Lambda (&/$Host "java.lang.Object" &/$Nil) + (&/$Lambda (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil)))) + + _ (&type/check (&/$Lambda (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Lambda (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Object" &/$Nil))) + (&/$Lambda (&/$Host "java.lang.Object" &/$Nil) + (&/$Lambda (&/$Host "java.lang.Boolean" &/$Nil) + (&/$Host "java.lang.Boolean" &/$Nil)))) ] (return nil)) (&/init-state nil)) @@ -207,7 +207,7 @@ )) (deftest check-ex-types - (|case (&/run-state (|do [_ (&type/check (&/$ExT 0) (&/$ExT 0))] + (|case (&/run-state (|do [_ (&type/check (&/$Ex 0) (&/$Ex 0))] (return nil)) (&/init-state nil)) (&/$Right state nil) @@ -219,39 +219,39 @@ (deftest check-univ-quantification (|case (&/run-state (|do [_ (&type/check (&/$UnivQ (&/|list) - (&/$LambdaT &/$VoidT (&/$BoundT 1))) + (&/$Lambda &/$Void (&/$Bound 1))) (&/$UnivQ (&/|list) - (&/$LambdaT &/$VoidT (&/$BoundT 1)))) + (&/$Lambda &/$Void (&/$Bound 1)))) _ (&type/check (&/$UnivQ (&/|list) - (&/$SumT + (&/$Sum ;; lux;None - &/$UnitT + &/$Unit ;; lux;Some - (&/$BoundT 1))) + (&/$Bound 1))) (&/$UnivQ (&/|list) - (&/$SumT + (&/$Sum ;; lux;None - &/$UnitT + &/$Unit ;; lux;Some - (&/$BoundT 1)))) + (&/$Bound 1)))) _ (&type/check (&/$UnivQ (&/|list) - (&/$SumT + (&/$Sum ;; lux;Nil - &/$UnitT + &/$Unit ;; lux;Cons - (&/$ProdT (&/$BoundT 1) - (&/$AppT (&/$BoundT 0) - (&/$BoundT 1))))) + (&/$Product (&/$Bound 1) + (&/$App (&/$Bound 0) + (&/$Bound 1))))) (&/$UnivQ (&/|list) - (&/$SumT + (&/$Sum ;; lux;Nil - &/$UnitT + &/$Unit ;; lux;Cons - (&/$ProdT (&/$BoundT 1) - (&/$AppT (&/$BoundT 0) - (&/$BoundT 1))))))] + (&/$Product (&/$Bound 1) + (&/$App (&/$Bound 0) + (&/$Bound 1))))))] (return nil)) (&/init-state nil)) (&/$Right state nil) @@ -263,39 +263,39 @@ (deftest check-ex-quantification (|case (&/run-state (|do [_ (&type/check (&/$ExQ (&/|list) - (&/$LambdaT &/$VoidT (&/$BoundT 1))) + (&/$Lambda &/$Void (&/$Bound 1))) (&/$ExQ (&/|list) - (&/$LambdaT &/$VoidT (&/$BoundT 1)))) + (&/$Lambda &/$Void (&/$Bound 1)))) _ (&type/check (&/$ExQ (&/|list) - (&/$SumT + (&/$Sum ;; lux;None - &/$UnitT + &/$Unit ;; lux;Some - (&/$BoundT 1))) + (&/$Bound 1))) (&/$ExQ (&/|list) - (&/$SumT + (&/$Sum ;; lux;None - &/$UnitT + &/$Unit ;; lux;Some - (&/$BoundT 1)))) + (&/$Bound 1)))) _ (&type/check (&/$ExQ (&/|list) - (&/$SumT + (&/$Sum ;; lux;Nil - &/$UnitT + &/$Unit ;; lux;Cons - (&/$ProdT (&/$BoundT 1) - (&/$AppT (&/$BoundT 0) - (&/$BoundT 1))))) + (&/$Product (&/$Bound 1) + (&/$App (&/$Bound 0) + (&/$Bound 1))))) (&/$ExQ (&/|list) - (&/$SumT + (&/$Sum ;; lux;Nil - &/$UnitT + &/$Unit ;; lux;Cons - (&/$ProdT (&/$BoundT 1) - (&/$AppT (&/$BoundT 0) - (&/$BoundT 1))))))] + (&/$Product (&/$Bound 1) + (&/$App (&/$Bound 0) + (&/$Bound 1))))))] (return nil)) (&/init-state nil)) (&/$Right state nil) @@ -306,49 +306,49 @@ )) (deftest check-app-type - (|case (&/run-state (|do [_ (&type/check (&/$AppT (&/$UnivQ (&/|list) - (&/$LambdaT &/$VoidT (&/$BoundT 1))) - (&/$HostT "java.lang.Boolean" &/$Nil)) - (&/$AppT (&/$UnivQ (&/|list) - (&/$LambdaT &/$VoidT (&/$BoundT 1))) - (&/$HostT "java.lang.Boolean" &/$Nil))) - - _ (&type/check (&/$AppT (&/$UnivQ (&/|list) - (&/$SumT - ;; lux;None - &/$UnitT - ;; lux;Some - (&/$BoundT 1))) - (&/$HostT "java.lang.Object" &/$Nil)) - (&/$AppT (&/$UnivQ (&/|list) - (&/$SumT - ;; lux;None - &/$UnitT - ;; lux;Some - (&/$BoundT 1))) - (&/$HostT "java.lang.Boolean" &/$Nil))) - - _ (&type/check (&/$AppT (&/$ExQ (&/|list) - (&/$LambdaT &/$VoidT (&/$BoundT 1))) - (&/$HostT "java.lang.Boolean" &/$Nil)) - (&/$AppT (&/$ExQ (&/|list) - (&/$LambdaT &/$VoidT (&/$BoundT 1))) - (&/$HostT "java.lang.Boolean" &/$Nil))) - - _ (&type/check (&/$AppT (&/$ExQ (&/|list) - (&/$SumT - ;; lux;None - &/$UnitT - ;; lux;Some - (&/$BoundT 1))) - (&/$HostT "java.lang.Object" &/$Nil)) - (&/$AppT (&/$ExQ (&/|list) - (&/$SumT - ;; lux;None - &/$UnitT - ;; lux;Some - (&/$BoundT 1))) - (&/$HostT "java.lang.Boolean" &/$Nil)))] + (|case (&/run-state (|do [_ (&type/check (&/$App (&/$UnivQ (&/|list) + (&/$Lambda &/$Void (&/$Bound 1))) + (&/$Host "java.lang.Boolean" &/$Nil)) + (&/$App (&/$UnivQ (&/|list) + (&/$Lambda &/$Void (&/$Bound 1))) + (&/$Host "java.lang.Boolean" &/$Nil))) + + _ (&type/check (&/$App (&/$UnivQ (&/|list) + (&/$Sum + ;; lux;None + &/$Unit + ;; lux;Some + (&/$Bound 1))) + (&/$Host "java.lang.Object" &/$Nil)) + (&/$App (&/$UnivQ (&/|list) + (&/$Sum + ;; lux;None + &/$Unit + ;; lux;Some + (&/$Bound 1))) + (&/$Host "java.lang.Boolean" &/$Nil))) + + _ (&type/check (&/$App (&/$ExQ (&/|list) + (&/$Lambda &/$Void (&/$Bound 1))) + (&/$Host "java.lang.Boolean" &/$Nil)) + (&/$App (&/$ExQ (&/|list) + (&/$Lambda &/$Void (&/$Bound 1))) + (&/$Host "java.lang.Boolean" &/$Nil))) + + _ (&type/check (&/$App (&/$ExQ (&/|list) + (&/$Sum + ;; lux;None + &/$Unit + ;; lux;Some + (&/$Bound 1))) + (&/$Host "java.lang.Object" &/$Nil)) + (&/$App (&/$ExQ (&/|list) + (&/$Sum + ;; lux;None + &/$Unit + ;; lux;Some + (&/$Bound 1))) + (&/$Host "java.lang.Boolean" &/$Nil)))] (return nil)) (&/init-state nil)) (&/$Right state nil) @@ -361,36 +361,36 @@ (deftest check-var-type (|case (&/run-state (|do [_ (&type/with-var (fn [$var] - (|do [_ (&type/check $var (&/$HostT "java.lang.Boolean" &/$Nil)) - (&/$HostT "java.lang.Boolean" (&/$Nil)) (&type/deref+ $var)] + (|do [_ (&type/check $var (&/$Host "java.lang.Boolean" &/$Nil)) + (&/$Host "java.lang.Boolean" (&/$Nil)) (&type/deref+ $var)] (return nil)))) _ (&type/with-var (fn [$var] - (|do [_ (&type/check (&/$AppT (&/$UnivQ (&/|list) - (&/$LambdaT &/$VoidT (&/$BoundT 1))) - $var) - (&/$AppT (&/$UnivQ (&/|list) - (&/$LambdaT &/$VoidT (&/$BoundT 1))) - (&/$HostT "java.lang.Boolean" &/$Nil))) - (&/$HostT "java.lang.Boolean" (&/$Nil)) (&type/deref+ $var)] + (|do [_ (&type/check (&/$App (&/$UnivQ (&/|list) + (&/$Lambda &/$Void (&/$Bound 1))) + $var) + (&/$App (&/$UnivQ (&/|list) + (&/$Lambda &/$Void (&/$Bound 1))) + (&/$Host "java.lang.Boolean" &/$Nil))) + (&/$Host "java.lang.Boolean" (&/$Nil)) (&type/deref+ $var)] (return nil)))) _ (&type/with-var (fn [$var] - (|do [_ (&type/check (&/$HostT "java.lang.Boolean" &/$Nil) $var) - (&/$HostT "java.lang.Boolean" (&/$Nil)) (&type/deref+ $var)] + (|do [_ (&type/check (&/$Host "java.lang.Boolean" &/$Nil) $var) + (&/$Host "java.lang.Boolean" (&/$Nil)) (&type/deref+ $var)] (return nil)))) _ (&type/with-var (fn [$var] - (|do [_ (&type/check (&/$AppT (&/$UnivQ (&/|list) - (&/$LambdaT &/$VoidT (&/$BoundT 1))) - (&/$HostT "java.lang.Boolean" &/$Nil)) - (&/$AppT (&/$UnivQ (&/|list) - (&/$LambdaT &/$VoidT (&/$BoundT 1))) - $var)) - (&/$HostT "java.lang.Boolean" (&/$Nil)) (&type/deref+ $var)] + (|do [_ (&type/check (&/$App (&/$UnivQ (&/|list) + (&/$Lambda &/$Void (&/$Bound 1))) + (&/$Host "java.lang.Boolean" &/$Nil)) + (&/$App (&/$UnivQ (&/|list) + (&/$Lambda &/$Void (&/$Bound 1))) + $var)) + (&/$Host "java.lang.Boolean" (&/$Nil)) (&type/deref+ $var)] (return nil)))) _ (&type/with-var @@ -412,11 +412,11 @@ (&type/with-var (fn [$var2] (|do [_ (&type/check $var1 $var2) - _ (&type/check $var1 (&/$HostT "java.lang.Boolean" (&/|list))) + _ (&type/check $var1 (&/$Host "java.lang.Boolean" (&/|list))) =var1 (&type/deref+ $var1) _ (&/assert! (&type/type= =var1 $var2) "") =var2 (&type/deref+ $var2) - _ (&/assert! (&type/type= =var2 (&/$HostT "java.lang.Boolean" (&/|list))) "")] + _ (&/assert! (&type/type= =var2 (&/$Host "java.lang.Boolean" (&/|list))) "")] (return nil)))))) _ (&type/with-var @@ -424,11 +424,11 @@ (&type/with-var (fn [$var2] (|do [_ (&type/check $var2 $var1) - _ (&type/check $var1 (&/$HostT "java.lang.Boolean" (&/|list))) + _ (&type/check $var1 (&/$Host "java.lang.Boolean" (&/|list))) =var2 (&type/deref+ $var2) _ (&/assert! (&type/type= =var2 $var1) "") =var1 (&type/deref+ $var1) - _ (&/assert! (&type/type= =var1 (&/$HostT "java.lang.Boolean" (&/|list))) "")] + _ (&/assert! (&type/type= =var1 (&/$Host "java.lang.Boolean" (&/|list))) "")] (return nil)))))) _ (&type/with-var @@ -436,11 +436,11 @@ (&type/with-var (fn [$var2] (|do [_ (&type/check $var1 $var2) - _ (&type/check $var2 (&/$HostT "java.lang.Boolean" (&/|list))) + _ (&type/check $var2 (&/$Host "java.lang.Boolean" (&/|list))) =var1 (&type/deref+ $var1) _ (&/assert! (&type/type= =var1 $var2) "") =var2 (&type/deref+ $var2) - _ (&/assert! (&type/type= =var2 (&/$HostT "java.lang.Boolean" (&/|list))) "")] + _ (&/assert! (&type/type= =var2 (&/$Host "java.lang.Boolean" (&/|list))) "")] (return nil)))))) _ (&type/with-var @@ -448,11 +448,11 @@ (&type/with-var (fn [$var2] (|do [_ (&type/check $var2 $var1) - _ (&type/check $var2 (&/$HostT "java.lang.Boolean" (&/|list))) + _ (&type/check $var2 (&/$Host "java.lang.Boolean" (&/|list))) =var2 (&type/deref+ $var2) _ (&/assert! (&type/type= =var2 $var1) "") =var1 (&type/deref+ $var1) - _ (&/assert! (&type/type= =var1 (&/$HostT "java.lang.Boolean" (&/|list))) "")] + _ (&/assert! (&type/type= =var1 (&/$Host "java.lang.Boolean" (&/|list))) "")] (return nil))))))] (return nil)) (&/init-state nil)) diff --git a/new-luxc/source/luxc/analyser/common.lux b/new-luxc/source/luxc/analyser/common.lux index 0deceaa39..e77819779 100644 --- a/new-luxc/source/luxc/analyser/common.lux +++ b/new-luxc/source/luxc/analyser/common.lux @@ -27,13 +27,13 @@ (def: #export (clean type analysis) (-> Type Analysis (Lux Analysis)) (case type - (#;VarT id) + (#;Var id) (do Monad<Lux> [=type (&;within-type-env (TC;clean id type))] (wrap (replace-type =type analysis))) - (#;ExT id) + (#;Ex id) (undefined) _ @@ -55,7 +55,7 @@ (def: #export (realize expected) (-> Type (TC;Check [(List Type) Type])) (case expected - (#;NamedT [module name] _expected) + (#;Named [module name] _expected) (realize _expected) (#;UnivQ env body) diff --git a/new-luxc/source/luxc/analyser/lux.lux b/new-luxc/source/luxc/analyser/lux.lux index 24ac1e093..86f9839dc 100644 --- a/new-luxc/source/luxc/analyser/lux.lux +++ b/new-luxc/source/luxc/analyser/lux.lux @@ -180,10 +180,10 @@ (do Monad<Lux> [expected macro;expected-type] (case expected - (#;ProdT _) + (#;Product _) (analyse-typed-tuple analyse cursor members) - (#;VarT id) + (#;Var id) (do @ [bound? (&;within-type-env (TC;bound? id))] @@ -224,7 +224,7 @@ (do Monad<Lux> [expected macro;expected-type] (case expected - (#;SumT _) + (#;Sum _) (let [flat (type;flatten-variant expected) type-size (list;size flat)] (if (n.< type-size tag) diff --git a/new-luxc/source/luxc/module/descriptor/type.lux b/new-luxc/source/luxc/module/descriptor/type.lux index c4078ec0e..d9079e893 100644 --- a/new-luxc/source/luxc/module/descriptor/type.lux +++ b/new-luxc/source/luxc/module/descriptor/type.lux @@ -37,22 +37,22 @@ (Type/= Type type)) type-signal (case type - (#;HostT name params) + (#;Host name params) (format host-signal name &;stop-signal (&;encode-list encode-type params)) - #;VoidT + #;Void void-signal - #;UnitT + #;Unit unit-signal (^template [<tag> <prefix>] (<tag> left right) (format <prefix> (encode-type left) (encode-type right))) - ([#;ProdT product-signal] - [#;SumT sum-signal] - [#;FunctionT function-signal] - [#;AppT application-signal]) + ([#;Product product-signal] + [#;Sum sum-signal] + [#;Function function-signal] + [#;App application-signal]) (^template [<tag> <prefix>] @@ -64,11 +64,11 @@ (^template [<tag> <prefix>] (<tag> idx) (format <prefix> (%i (nat-to-int idx)) &;stop-signal)) - ([#;BoundT bound-signal] - [#;ExT ex-signal] - [#;VarT var-signal]) + ([#;Bound bound-signal] + [#;Ex ex-signal] + [#;Var var-signal]) - (#;NamedT [module name] type*) + (#;Named [module name] type*) (format named-signal module &;ident-separator name &;stop-signal (encode-type type*)) ))) @@ -80,8 +80,8 @@ [(|> (l/wrap <type>) (l;after (l;text <signal>)))] [Type type-signal] - [#;VoidT void-signal] - [#;UnitT unit-signal]) + [#;Void void-signal] + [#;Unit unit-signal]) <combinators> (do-template [<tag> <prefix>] [(do l;Monad<Lexer> [_ (l;text <prefix>) @@ -89,10 +89,10 @@ right type-decoder] (wrap (<tag> left right)))] - [#;ProdT product-signal] - [#;SumT sum-signal] - [#;FunctionT function-signal] - [#;AppT application-signal]) + [#;Product product-signal] + [#;Sum sum-signal] + [#;Function function-signal] + [#;App application-signal]) <abstractions> (do-template [<tag> <prefix>] [(do l;Monad<Lexer> [_ (l;text <prefix>) @@ -110,16 +110,16 @@ _ (l;text &;stop-signal)] (wrap (<tag> (int-to-nat id))))] - [#;BoundT bound-signal] - [#;ExT ex-signal] - [#;VarT var-signal])] + [#;Bound bound-signal] + [#;Ex ex-signal] + [#;Var var-signal])] ($_ l;either (do l;Monad<Lexer> [_ (l;text host-signal) name (l;many' (l;none-of &;stop-signal)) _ (l;text &;stop-signal) params (&;decode-list type-decoder)] - (wrap (#;HostT name params))) + (wrap (#;Host name params))) <simple> <combinators> <abstractions> @@ -131,7 +131,7 @@ name (l;many' (l;none-of &;stop-signal)) _ (l;text &;stop-signal) unnamed type-decoder] - (wrap (#;NamedT [module name] unnamed))) + (wrap (#;Named [module name] unnamed))) ))))) (def: (decode-type input) diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 344925b1f..f530f9ca5 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -121,19 +121,19 @@ #Nil)))))) ## (type: #rec Type -## (#HostT Text (List Type)) -## #VoidT -## #UnitT -## (#SumT Type Type) -## (#ProdT Type Type) -## (#FunctionT Type Type) -## (#BoundT Nat) -## (#VarT Nat) -## (#ExT Nat) +## (#Host Text (List Type)) +## #Void +## #Unit +## (#Sum Type Type) +## (#Product Type Type) +## (#Function Type Type) +## (#Bound Nat) +## (#Var Nat) +## (#Ex Nat) ## (#UnivQ (List Type) Type) ## (#ExQ (List Type) Type) -## (#AppT Type Type) -## (#NamedT Ident Type) +## (#App Type Type) +## (#Named Ident Type) ## ) (_lux_def Type (+12 ["lux" "Type"] @@ -144,48 +144,48 @@ (_lux_case (+4 Type Type) TypePair (+11 (+9 #Nil - (+3 ## "lux;HostT" + (+3 ## "lux;Host" (+4 Text TypeList) - (+3 ## "lux;VoidT" + (+3 ## "lux;Void" (+2) - (+3 ## "lux;UnitT" + (+3 ## "lux;Unit" (+2) - (+3 ## "lux;SumT" + (+3 ## "lux;Sum" TypePair - (+3 ## "lux;ProdT" + (+3 ## "lux;Product" TypePair - (+3 ## "lux;FunctionT" + (+3 ## "lux;Function" TypePair - (+3 ## "lux;BoundT" + (+3 ## "lux;Bound" Nat - (+3 ## "lux;VarT" + (+3 ## "lux;Var" Nat - (+3 ## "lux;ExT" + (+3 ## "lux;Ex" Nat (+3 ## "lux;UnivQ" (+4 TypeList Type) (+3 ## "lux;ExQ" (+4 TypeList Type) - (+3 ## "lux;AppT" + (+3 ## "lux;App" TypePair - ## "lux;NamedT" + ## "lux;Named" (+4 Ident Type)))))))))))))) Void))))) (#Cons [["lux" "type?"] (+0 true)] (#Cons [["lux" "export?"] (+0 true)] - (#Cons [["lux" "tags"] (+8 (#Cons (+6 "HostT") - (#Cons (+6 "VoidT") - (#Cons (+6 "UnitT") - (#Cons (+6 "SumT") - (#Cons (+6 "ProdT") - (#Cons (+6 "FunctionT") - (#Cons (+6 "BoundT") - (#Cons (+6 "VarT") - (#Cons (+6 "ExT") + (#Cons [["lux" "tags"] (+8 (#Cons (+6 "Host") + (#Cons (+6 "Void") + (#Cons (+6 "Unit") + (#Cons (+6 "Sum") + (#Cons (+6 "Product") + (#Cons (+6 "Function") + (#Cons (+6 "Bound") + (#Cons (+6 "Var") + (#Cons (+6 "Ex") (#Cons (+6 "UnivQ") (#Cons (+6 "ExQ") - (#Cons (+6 "AppT") - (#Cons (+6 "NamedT") + (#Cons (+6 "App") + (#Cons (+6 "Named") #Nil))))))))))))))] (#Cons [["lux" "doc"] (+6 "This type represents the data-structures that are used to specify types themselves.")] (#Cons [["lux" "type-rec?"] (+0 true)] @@ -194,8 +194,8 @@ ## (type: Top ## (Ex [a] a)) (_lux_def Top - (#NamedT ["lux" "Top"] - (#ExQ #Nil (#BoundT +1))) + (#Named ["lux" "Top"] + (#ExQ #Nil (#Bound +1))) (#Cons [["lux" "type?"] (+0 true)] (#Cons [["lux" "export?"] (+0 true)] (#Cons [["lux" "doc"] (+6 "The type of things whose type does not matter. @@ -206,8 +206,8 @@ ## (type: Bottom ## (All [a] a)) (_lux_def Bottom - (#NamedT ["lux" "Bottom"] - (#UnivQ #Nil (#BoundT +1))) + (#Named ["lux" "Bottom"] + (#UnivQ #Nil (#Bound +1))) (#Cons [["lux" "type?"] (+0 true)] (#Cons [["lux" "export?"] (+0 true)] (#Cons [["lux" "doc"] (+6 "The type of things whose type is unknown or undefined. @@ -227,33 +227,33 @@ ## (#ListA (List Ann-Value)) ## (#DictA (List [Text Ann-Value]))) (_lux_def Ann-Value - (#NamedT ["lux" "Ann-Value"] - (_lux_case (#AppT (#BoundT +0) (#BoundT +1)) - Ann-Value - (#AppT (#UnivQ #Nil - (#SumT ## #BoolA - Bool - (#SumT ## #NatA - Nat - (#SumT ## #IntA - Int - (#SumT ## #DegA - Deg - (#SumT ## #RealA - Real - (#SumT ## #CharA - Char - (#SumT ## #TextA - Text - (#SumT ## #IdentA - Ident - (#SumT ## #ListA - (#AppT List Ann-Value) - ## #DictA - (#AppT List (#ProdT Text Ann-Value))))))))))) - ) - Void) - )) + (#Named ["lux" "Ann-Value"] + (_lux_case (#App (#Bound +0) (#Bound +1)) + Ann-Value + (#App (#UnivQ #Nil + (#Sum ## #BoolA + Bool + (#Sum ## #NatA + Nat + (#Sum ## #IntA + Int + (#Sum ## #DegA + Deg + (#Sum ## #RealA + Real + (#Sum ## #CharA + Char + (#Sum ## #TextA + Text + (#Sum ## #IdentA + Ident + (#Sum ## #ListA + (#App List Ann-Value) + ## #DictA + (#App List (#Product Text Ann-Value))))))))))) + ) + Void) + )) (#Cons [["lux" "type?"] (+0 true)] (#Cons [["lux" "export?"] (+0 true)] (#Cons [["lux" "tags"] (+8 (#Cons (+6 "BoolA") @@ -274,8 +274,8 @@ ## (type: Anns ## (List [Ident Ann-Value])) (_lux_def Anns - (#NamedT ["lux" "Anns"] - (#AppT List (#ProdT Ident Ann-Value))) + (#Named ["lux" "Anns"] + (#App List (#Product Ident Ann-Value))) (#Cons [["lux" "type?"] (#BoolA true)] (#Cons [["lux" "export?"] (#BoolA true)] (#Cons [["lux" "doc"] (#TextA "A set of annotations associated with a definition.")] @@ -297,8 +297,8 @@ ## (type: Def ## [Type Anns Void]) (_lux_def Def - (#NamedT ["lux" "Def"] - (#ProdT Type (#ProdT Anns Void))) + (#Named ["lux" "Def"] + (#Product Type (#Product Anns Void))) (#Cons [["lux" "doc"] (#TextA "Represents all the data associated with a definition: its type, its annotations, and its value.")] default-def-meta-exported)) @@ -306,15 +306,15 @@ ## {#counter Nat ## #mappings (List [k v])}) (_lux_def Bindings - (#NamedT ["lux" "Bindings"] - (#UnivQ #Nil - (#UnivQ #Nil - (#ProdT ## "lux;counter" - Nat - ## "lux;mappings" - (#AppT List - (#ProdT (#BoundT +3) - (#BoundT +1))))))) + (#Named ["lux" "Bindings"] + (#UnivQ #Nil + (#UnivQ #Nil + (#Product ## "lux;counter" + Nat + ## "lux;mappings" + (#App List + (#Product (#Bound +3) + (#Bound +1))))))) (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "counter") (#Cons (#TextA "mappings") #Nil)))] @@ -326,8 +326,8 @@ ## #line Nat ## #column Nat}) (_lux_def Cursor - (#NamedT ["lux" "Cursor"] - (#ProdT Text (#ProdT Nat Nat))) + (#Named ["lux" "Cursor"] + (#Product Text (#Product Nat Nat))) (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "module") (#Cons (#TextA "line") (#Cons (#TextA "column") @@ -339,11 +339,11 @@ ## {#meta m ## #datum v}) (_lux_def Meta - (#NamedT ["lux" "Meta"] - (#UnivQ #Nil - (#UnivQ #Nil - (#ProdT (#BoundT +3) - (#BoundT +1))))) + (#Named ["lux" "Meta"] + (#UnivQ #Nil + (#UnivQ #Nil + (#Product (#Bound +3) + (#Bound +1))))) (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "meta") (#Cons (#TextA "datum") #Nil)))] @@ -355,11 +355,11 @@ ## (#Local Nat) ## (#Captured Nat)) (_lux_def Ref - (#NamedT ["lux" "Ref"] - (#SumT ## Local - Nat - ## Captured - Nat)) + (#Named ["lux" "Ref"] + (#Sum ## Local + Nat + ## Captured + Nat)) (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "Local") (#Cons (#TextA "Captured") #Nil)))] @@ -371,15 +371,15 @@ ## #locals (Bindings Text [Type Nat]) ## #captured (Bindings Text [Type Ref])}) (_lux_def Scope - (#NamedT ["lux" "Scope"] - (#ProdT ## name - (#AppT List Text) - (#ProdT ## inner - Nat - (#ProdT ## locals - (#AppT (#AppT Bindings Text) (#ProdT Type Nat)) - ## captured - (#AppT (#AppT Bindings Text) (#ProdT Type Ref)))))) + (#Named ["lux" "Scope"] + (#Product ## name + (#App List Text) + (#Product ## inner + Nat + (#Product ## locals + (#App (#App Bindings Text) (#Product Type Nat)) + ## captured + (#App (#App Bindings Text) (#Product Type Ref)))))) (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "name") (#Cons (#TextA "inner") (#Cons (#TextA "locals") @@ -401,40 +401,40 @@ ## (#Tuple (List (w (AST' w)))) ## (#Record (List [(w (AST' w)) (w (AST' w))]))) (_lux_def AST' - (#NamedT ["lux" "AST'"] - (_lux_case (#AppT (#BoundT +1) - (#AppT (#BoundT +0) - (#BoundT +1))) - AST - (_lux_case (#AppT [List AST]) - AST-List - (#UnivQ #Nil - (#SumT ## "lux;Bool" - Bool - (#SumT ## "lux;Nat" - Nat - (#SumT ## "lux;Int" - Int - (#SumT ## "lux;Deg" - Deg - (#SumT ## "lux;Real" - Real - (#SumT ## "lux;Char" - Char - (#SumT ## "lux;Text" - Text - (#SumT ## "lux;Symbol" + (#Named ["lux" "AST'"] + (_lux_case (#App (#Bound +1) + (#App (#Bound +0) + (#Bound +1))) + AST + (_lux_case (#App [List AST]) + AST-List + (#UnivQ #Nil + (#Sum ## "lux;Bool" + Bool + (#Sum ## "lux;Nat" + Nat + (#Sum ## "lux;Int" + Int + (#Sum ## "lux;Deg" + Deg + (#Sum ## "lux;Real" + Real + (#Sum ## "lux;Char" + Char + (#Sum ## "lux;Text" + Text + (#Sum ## "lux;Symbol" + Ident + (#Sum ## "lux;Tag" Ident - (#SumT ## "lux;Tag" - Ident - (#SumT ## "lux;Form" + (#Sum ## "lux;Form" + AST-List + (#Sum ## "lux;Tuple" AST-List - (#SumT ## "lux;Tuple" - AST-List - ## "lux;Record" - (#AppT List (#ProdT AST AST)) - ))))))))))) - )))) + ## "lux;Record" + (#App List (#Product AST AST)) + ))))))))))) + )))) (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "Bool") (#Cons (#TextA "Nat") (#Cons (#TextA "Int") @@ -454,28 +454,28 @@ ## (type: AST ## (Meta Cursor (AST' (Meta Cursor)))) (_lux_def AST - (#NamedT ["lux" "AST"] - (_lux_case (#AppT Meta Cursor) - w - (#AppT w (#AppT AST' w)))) + (#Named ["lux" "AST"] + (_lux_case (#App Meta Cursor) + w + (#App w (#App AST' w)))) (#Cons [["lux" "doc"] (#TextA "The type of AST nodes for Lux syntax.")] default-def-meta-exported)) (_lux_def AST-List - (#AppT List AST) + (#App List AST) default-def-meta-unexported) ## (type: (Either l r) ## (#Left l) ## (#Right r)) (_lux_def Either - (#NamedT ["lux" "Either"] - (#UnivQ #Nil - (#UnivQ #Nil - (#SumT ## "lux;Left" - (#BoundT +3) - ## "lux;Right" - (#BoundT +1))))) + (#Named ["lux" "Either"] + (#UnivQ #Nil + (#UnivQ #Nil + (#Sum ## "lux;Left" + (#Bound +3) + ## "lux;Right" + (#Bound +1))))) (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "Left") (#Cons (#TextA "Right") #Nil)))] @@ -486,8 +486,8 @@ ## (type: Source ## [Cursor Text]) (_lux_def Source - (#NamedT ["lux" "Source"] - (#ProdT Cursor Text)) + (#Named ["lux" "Source"] + (#Product Cursor Text)) default-def-meta-exported) ## (type: Module-State @@ -495,15 +495,15 @@ ## #Compiled ## #Cached) (_lux_def Module-State - (#NamedT ["lux" "Module-State"] - (#SumT - ## #Active + (#Named ["lux" "Module-State"] + (#Sum + ## #Active + Unit + (#Sum + ## #Compiled Unit - (#SumT - ## #Compiled - Unit - ## #Cached - Unit))) + ## #Cached + Unit))) (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "Active") (#Cons (#TextA "Compiled") (#Cons (#TextA "Cached") @@ -520,33 +520,33 @@ ## #module-anns Anns ## #module-state Module-State}) (_lux_def Module - (#NamedT ["lux" "Module"] - (#ProdT ## "lux;module-hash" - Nat - (#ProdT ## "lux;module-aliases" - (#AppT List (#ProdT Text Text)) - (#ProdT ## "lux;defs" - (#AppT List (#ProdT Text + (#Named ["lux" "Module"] + (#Product ## "lux;module-hash" + Nat + (#Product ## "lux;module-aliases" + (#App List (#Product Text Text)) + (#Product ## "lux;defs" + (#App List (#Product Text Def)) - (#ProdT ## "lux;imports" - (#AppT List Text) - (#ProdT ## "lux;tags" - (#AppT List - (#ProdT Text - (#ProdT Nat - (#ProdT (#AppT List Ident) - (#ProdT Bool - Type))))) - (#ProdT ## "lux;types" - (#AppT List - (#ProdT Text - (#ProdT (#AppT List Ident) - (#ProdT Bool - Type)))) - (#ProdT ## "lux;module-anns" - Anns - Module-State)) - )))))) + (#Product ## "lux;imports" + (#App List Text) + (#Product ## "lux;tags" + (#App List + (#Product Text + (#Product Nat + (#Product (#App List Ident) + (#Product Bool + Type))))) + (#Product ## "lux;types" + (#App List + (#Product Text + (#Product (#App List Ident) + (#Product Bool + Type)))) + (#Product ## "lux;module-anns" + Anns + Module-State)) + )))))) (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "module-hash") (#Cons (#TextA "module-aliases") (#Cons (#TextA "defs") @@ -564,15 +564,15 @@ ## #var-counter Nat ## #var-bindings (List [Nat (Maybe Type)])}) (_lux_def Type-Context - (#NamedT ["lux" "Type-Context"] - (#ProdT ## ex-counter + (#Named ["lux" "Type-Context"] + (#Product ## ex-counter + Nat + (#Product ## var-counter Nat - (#ProdT ## var-counter - Nat - ## var-bindings - (#AppT List - (#ProdT Nat - (#AppT Maybe Type)))))) + ## var-bindings + (#App List + (#Product Nat + (#App Maybe Type)))))) (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "ex-counter") (#Cons (#TextA "var-counter") (#Cons (#TextA "var-bindings") @@ -584,13 +584,13 @@ ## #Eval ## #REPL) (_lux_def Compiler-Mode - (#NamedT ["lux" "Compiler-Mode"] - (#SumT ## Build - #UnitT - (#SumT ## Eval - #UnitT - ## REPL - #UnitT))) + (#Named ["lux" "Compiler-Mode"] + (#Sum ## Build + #Unit + (#Sum ## Eval + #Unit + ## REPL + #Unit))) (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "Build") (#Cons (#TextA "Eval") (#Cons (#TextA "REPL") @@ -602,11 +602,11 @@ ## {#compiler-version Text ## #compiler-mode Compiler-Mode}) (_lux_def Compiler-Info - (#NamedT ["lux" "Compiler-Info"] - (#ProdT ## "lux;compiler-version" - Text - ## "lux;compiler-mode" - Compiler-Mode)) + (#Named ["lux" "Compiler-Info"] + (#Product ## "lux;compiler-version" + Text + ## "lux;compiler-mode" + Compiler-Mode)) (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "compiler-version") (#Cons (#TextA "compiler-mode") #Nil)))] @@ -625,28 +625,28 @@ ## #scope-type-vars (List Nat) ## #host Void}) (_lux_def Compiler - (#NamedT ["lux" "Compiler"] - (#ProdT ## "lux;info" - Compiler-Info - (#ProdT ## "lux;source" - Source - (#ProdT ## "lux;cursor" - Cursor - (#ProdT ## "lux;modules" - (#AppT List (#ProdT Text + (#Named ["lux" "Compiler"] + (#Product ## "lux;info" + Compiler-Info + (#Product ## "lux;source" + Source + (#Product ## "lux;cursor" + Cursor + (#Product ## "lux;modules" + (#App List (#Product Text Module)) - (#ProdT ## "lux;scopes" - (#AppT List Scope) - (#ProdT ## "lux;type-context" - Type-Context - (#ProdT ## "lux;expected" - (#AppT Maybe Type) - (#ProdT ## "lux;seed" - Nat - (#ProdT ## scope-type-vars - (#AppT List Nat) - ## "lux;host" - Void)))))))))) + (#Product ## "lux;scopes" + (#App List Scope) + (#Product ## "lux;type-context" + Type-Context + (#Product ## "lux;expected" + (#App Maybe Type) + (#Product ## "lux;seed" + Nat + (#Product ## scope-type-vars + (#App List Nat) + ## "lux;host" + Void)))))))))) (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "info") (#Cons (#TextA "source") (#Cons (#TextA "cursor") @@ -668,11 +668,11 @@ ## (type: (Lux a) ## (-> Compiler (Either Text [Compiler a]))) (_lux_def Lux - (#NamedT ["lux" "Lux"] - (#UnivQ #Nil - (#FunctionT Compiler - (#AppT (#AppT Either Text) - (#ProdT Compiler (#BoundT +1)))))) + (#Named ["lux" "Lux"] + (#UnivQ #Nil + (#Function Compiler + (#App (#App Either Text) + (#Product Compiler (#Bound +1)))))) (#Cons [["lux" "doc"] (#TextA "Computations that can have access to the state of the compiler. These computations may fail, or modify the state of the compiler.")] @@ -682,8 +682,8 @@ ## (type: Macro ## (-> (List AST) (Lux (List AST)))) (_lux_def Macro - (#NamedT ["lux" "Macro"] - (#FunctionT AST-List (#AppT Lux AST-List))) + (#Named ["lux" "Macro"] + (#Function AST-List (#App Lux AST-List))) (#Cons [["lux" "doc"] (#TextA "Functions that run at compile-time and allow you to transform and extend the language in powerful ways.")] default-def-meta-exported)) @@ -693,20 +693,20 @@ #Nil) (_lux_def _meta - (_lux_: (#FunctionT (#AppT AST' - (#AppT Meta Cursor)) - AST) + (_lux_: (#Function (#App AST' + (#App Meta Cursor)) + AST) (_lux_function _ data [_cursor data])) #Nil) (_lux_def return (_lux_: (#UnivQ #Nil - (#FunctionT (#BoundT +1) - (#FunctionT Compiler - (#AppT (#AppT Either Text) - (#ProdT Compiler - (#BoundT +1)))))) + (#Function (#Bound +1) + (#Function Compiler + (#App (#App Either Text) + (#Product Compiler + (#Bound +1)))))) (_lux_function _ val (_lux_function _ state (#Right state val)))) @@ -714,73 +714,73 @@ (_lux_def fail (_lux_: (#UnivQ #Nil - (#FunctionT Text - (#FunctionT Compiler - (#AppT (#AppT Either Text) - (#ProdT Compiler - (#BoundT +1)))))) + (#Function Text + (#Function Compiler + (#App (#App Either Text) + (#Product Compiler + (#Bound +1)))))) (_lux_function _ msg (_lux_function _ state (#Left msg)))) #Nil) (_lux_def bool$ - (_lux_: (#FunctionT Bool AST) + (_lux_: (#Function Bool AST) (_lux_function _ value (_meta (#Bool value)))) #Nil) (_lux_def nat$ - (_lux_: (#FunctionT Nat AST) + (_lux_: (#Function Nat AST) (_lux_function _ value (_meta (#Nat value)))) #Nil) (_lux_def int$ - (_lux_: (#FunctionT Int AST) + (_lux_: (#Function Int AST) (_lux_function _ value (_meta (#Int value)))) #Nil) (_lux_def deg$ - (_lux_: (#FunctionT Deg AST) + (_lux_: (#Function Deg AST) (_lux_function _ value (_meta (#Deg value)))) #Nil) (_lux_def real$ - (_lux_: (#FunctionT Real AST) + (_lux_: (#Function Real AST) (_lux_function _ value (_meta (#Real value)))) #Nil) (_lux_def char$ - (_lux_: (#FunctionT Char AST) + (_lux_: (#Function Char AST) (_lux_function _ value (_meta (#Char value)))) #Nil) (_lux_def text$ - (_lux_: (#FunctionT Text AST) + (_lux_: (#Function Text AST) (_lux_function _ text (_meta (#Text text)))) #Nil) (_lux_def symbol$ - (_lux_: (#FunctionT Ident AST) + (_lux_: (#Function Ident AST) (_lux_function _ ident (_meta (#Symbol ident)))) #Nil) (_lux_def tag$ - (_lux_: (#FunctionT Ident AST) + (_lux_: (#Function Ident AST) (_lux_function _ ident (_meta (#Tag ident)))) #Nil) (_lux_def form$ - (_lux_: (#FunctionT (#AppT List AST) AST) + (_lux_: (#Function (#App List AST) AST) (_lux_function _ tokens (_meta (#Form tokens)))) #Nil) (_lux_def tuple$ - (_lux_: (#FunctionT (#AppT List AST) AST) + (_lux_: (#Function (#App List AST) AST) (_lux_function _ tokens (_meta (#Tuple tokens)))) #Nil) (_lux_def record$ - (_lux_: (#FunctionT (#AppT List (#ProdT AST AST)) AST) + (_lux_: (#Function (#App List (#Product AST AST)) AST) (_lux_function _ tokens (_meta (#Record tokens)))) #Nil) @@ -869,7 +869,7 @@ #Nil) (_lux_def with-export-meta - (_lux_: (#FunctionT AST AST) + (_lux_: (#Function AST AST) (function'' [tail] (form$ (#Cons (tag$ ["lux" "Cons"]) (#Cons export?-meta @@ -877,7 +877,7 @@ #Nil) (_lux_def with-hidden-meta - (_lux_: (#FunctionT AST AST) + (_lux_: (#Function AST AST) (function'' [tail] (form$ (#Cons (tag$ ["lux" "Cons"]) (#Cons hidden?-meta @@ -885,7 +885,7 @@ #Nil) (_lux_def with-macro-meta - (_lux_: (#FunctionT AST AST) + (_lux_: (#Function AST AST) (function'' [tail] (form$ (#Cons (tag$ ["lux" "Cons"]) (#Cons macro?-meta @@ -1003,7 +1003,7 @@ (#Cons x (#Cons y xs)) (return (#Cons (form$ (#Cons (symbol$ ["lux" "$'"]) - (#Cons (form$ (#Cons (tag$ ["lux" "AppT"]) + (#Cons (form$ (#Cons (tag$ ["lux" "App"]) (#Cons x (#Cons y #Nil)))) xs))) #Nil)) @@ -1015,9 +1015,9 @@ #Nil (#UnivQ #Nil (#UnivQ #Nil - (#FunctionT (#FunctionT (#BoundT +3) (#BoundT +1)) - (#FunctionT ($' List (#BoundT +3)) - ($' List (#BoundT +1)))))) + (#Function (#Function (#Bound +3) (#Bound +1)) + (#Function ($' List (#Bound +3)) + ($' List (#Bound +1)))))) (_lux_case xs #Nil #Nil @@ -1028,11 +1028,11 @@ (def:'' RepEnv #Nil Type - ($' List (#ProdT Text AST))) + ($' List (#Product Text AST))) (def:'' (make-env xs ys) #Nil - (#FunctionT ($' List Text) (#FunctionT ($' List AST) RepEnv)) + (#Function ($' List Text) (#Function ($' List AST) RepEnv)) (_lux_case [xs ys] [(#Cons x xs') (#Cons y ys')] (#Cons [x y] (make-env xs' ys')) @@ -1042,12 +1042,12 @@ (def:'' (Text/= x y) #Nil - (#FunctionT Text (#FunctionT Text Bool)) + (#Function Text (#Function Text Bool)) (_lux_proc ["text" "="] [x y])) (def:'' (get-rep key env) #Nil - (#FunctionT Text (#FunctionT RepEnv ($' Maybe AST))) + (#Function Text (#Function RepEnv ($' Maybe AST))) (_lux_case env #Nil #None @@ -1062,7 +1062,7 @@ (def:'' (replace-syntax reps syntax) #Nil - (#FunctionT RepEnv (#FunctionT AST AST)) + (#Function RepEnv (#Function AST AST)) (_lux_case syntax [_ (#Symbol "" name)] (_lux_case (get-rep name reps) @@ -1079,7 +1079,7 @@ [meta (#Tuple (map (replace-syntax reps) members))] [meta (#Record slots)] - [meta (#Record (map (_lux_: (#FunctionT (#ProdT AST AST) (#ProdT AST AST)) + [meta (#Record (map (_lux_: (#Function (#Product AST AST) (#Product AST AST)) (function'' [slot] (_lux_case slot [k v] @@ -1092,20 +1092,20 @@ (def:'' (update-bounds ast) #Nil - (#FunctionT AST AST) + (#Function AST AST) (_lux_case ast [_ (#Tuple members)] (tuple$ (map update-bounds members)) [_ (#Record pairs)] - (record$ (map (_lux_: (#FunctionT (#ProdT AST AST) (#ProdT AST AST)) + (record$ (map (_lux_: (#Function (#Product AST AST) (#Product AST AST)) (function'' [pair] (let'' [name val] pair [name (update-bounds val)]))) pairs)) - [_ (#Form (#Cons [_ (#Tag "lux" "BoundT")] (#Cons [_ (#Nat idx)] #Nil)))] - (form$ (#Cons (tag$ ["lux" "BoundT"]) (#Cons (nat$ (_lux_proc ["nat" "+"] [+2 idx])) #Nil))) + [_ (#Form (#Cons [_ (#Tag "lux" "Bound")] (#Cons [_ (#Nat idx)] #Nil)))] + (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ (_lux_proc ["nat" "+"] [+2 idx])) #Nil))) [_ (#Form members)] (form$ (map update-bounds members)) @@ -1116,10 +1116,10 @@ (def:'' (parse-quantified-args args next) #Nil ## (-> (List AST) (-> (List Text) (Lux (List AST))) (Lux (List AST))) - (#FunctionT ($' List AST) - (#FunctionT (#FunctionT ($' List Text) (#AppT Lux ($' List AST))) - (#AppT Lux ($' List AST)) - )) + (#Function ($' List AST) + (#Function (#Function ($' List Text) (#App Lux ($' List AST))) + (#App Lux ($' List AST)) + )) (_lux_case args #Nil (next #Nil) @@ -1133,18 +1133,18 @@ (def:'' (make-bound idx) #Nil - (#FunctionT Nat AST) - (form$ (#Cons (tag$ ["lux" "BoundT"]) (#Cons (nat$ idx) #Nil)))) + (#Function Nat AST) + (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ idx) #Nil)))) (def:'' (fold f init xs) #Nil ## (All [a b] (-> (-> b a a) a (List b) a)) - (#UnivQ #Nil (#UnivQ #Nil (#FunctionT (#FunctionT (#BoundT +1) - (#FunctionT (#BoundT +3) - (#BoundT +3))) - (#FunctionT (#BoundT +3) - (#FunctionT ($' List (#BoundT +1)) - (#BoundT +3)))))) + (#UnivQ #Nil (#UnivQ #Nil (#Function (#Function (#Bound +1) + (#Function (#Bound +3) + (#Bound +3))) + (#Function (#Bound +3) + (#Function ($' List (#Bound +1)) + (#Bound +3)))))) (_lux_case xs #Nil init @@ -1155,7 +1155,7 @@ (def:'' (length list) #Nil (#UnivQ #Nil - (#FunctionT ($' List (#BoundT +1)) Int)) + (#Function ($' List (#Bound +1)) Int)) (fold (function'' [_ acc] (_lux_proc ["int" "+"] [1 acc])) 0 list)) (macro:' #export (All tokens) @@ -1178,7 +1178,7 @@ (#Cons [_ (#Tuple args)] (#Cons body #Nil)) (parse-quantified-args args (function'' [names] - (let'' body' (fold (_lux_: (#FunctionT Text (#FunctionT AST AST)) + (let'' body' (fold (_lux_: (#Function Text (#Function AST AST)) (function'' [name' body'] (form$ (#Cons (tag$ ["lux" "UnivQ"]) (#Cons (tag$ ["lux" "Nil"]) @@ -1229,7 +1229,7 @@ (#Cons [_ (#Tuple args)] (#Cons body #Nil)) (parse-quantified-args args (function'' [names] - (let'' body' (fold (_lux_: (#FunctionT Text (#FunctionT AST AST)) + (let'' body' (fold (_lux_: (#Function Text (#Function AST AST)) (function'' [name' body'] (form$ (#Cons (tag$ ["lux" "ExQ"]) (#Cons (tag$ ["lux" "Nil"]) @@ -1260,7 +1260,7 @@ (def:'' (reverse list) #Nil - (All [a] (#FunctionT ($' List a) ($' List a))) + (All [a] (#Function ($' List a) ($' List a))) (fold (function'' [head tail] (#Cons head tail)) #Nil list)) @@ -1273,8 +1273,8 @@ #;Nil) (_lux_case (reverse tokens) (#Cons output inputs) - (return (#Cons (fold (_lux_: (#FunctionT AST (#FunctionT AST AST)) - (function'' [i o] (form$ (#Cons (tag$ ["lux" "FunctionT"]) (#Cons i (#Cons o #Nil)))))) + (return (#Cons (fold (_lux_: (#Function AST (#Function AST AST)) + (function'' [i o] (form$ (#Cons (tag$ ["lux" "Function"]) (#Cons i (#Cons o #Nil)))))) output inputs) #Nil)) @@ -1319,10 +1319,10 @@ #;Nil) (_lux_case (reverse tokens) #Nil - (return (list (tag$ ["lux" "UnitT"]))) + (return (list (tag$ ["lux" "Unit"]))) (#Cons last prevs) - (return (list (fold (function'' [left right] (form$ (list (tag$ ["lux" "ProdT"]) left right))) + (return (list (fold (function'' [left right] (form$ (list (tag$ ["lux" "Product"]) left right))) last prevs))) )) @@ -1336,10 +1336,10 @@ #;Nil) (_lux_case (reverse tokens) #Nil - (return (list (tag$ ["lux" "VoidT"]))) + (return (list (tag$ ["lux" "Void"]))) (#Cons last prevs) - (return (list (fold (function'' [left right] (form$ (list (tag$ ["lux" "SumT"]) left right))) + (return (list (fold (function'' [left right] (form$ (list (tag$ ["lux" "Sum"]) left right))) last prevs))) )) @@ -1553,12 +1553,12 @@ (list& [["lux" "tags"] (#ListA (list (#TextA "wrap") (#TextA "bind")))] default-def-meta-unexported) Type - (#NamedT ["lux" "Monad"] - (All [m] - (& (All [a] (-> a ($' m a))) - (All [a b] (-> (-> a ($' m b)) - ($' m a) - ($' m b))))))) + (#Named ["lux" "Monad"] + (All [m] + (& (All [a] (-> a ($' m a))) + (All [a b] (-> (-> a ($' m b)) + ($' m a) + ($' m b))))))) (def:''' Monad<Maybe> #Nil @@ -1762,7 +1762,7 @@ (do Monad<Lux> [=elem (untemplate elem)] (wrap (form$ (list (symbol$ ["" "_lux_:"]) - (form$ (list (tag$ ["lux" "AppT"]) (tuple$ (list (symbol$ ["lux" "List"]) (symbol$ ["lux" "AST"]))))) + (form$ (list (tag$ ["lux" "App"]) (tuple$ (list (symbol$ ["lux" "List"]) (symbol$ ["lux" "AST"]))))) (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list =elem (tag$ ["lux" "Nil"])))))))))))) elems))] (wrap (wrap-meta (form$ (list tag @@ -1868,10 +1868,10 @@ (host java.util.List [java.lang.Long])")]) (_lux_case tokens (#Cons [_ (#Symbol "" class-name)] #Nil) - (return (list (form$ (list (tag$ ["lux" "HostT"]) (text$ class-name) (tag$ ["lux" "Nil"]))))) + (return (list (form$ (list (tag$ ["lux" "Host"]) (text$ class-name) (tag$ ["lux" "Nil"]))))) (#Cons [_ (#Symbol "" class-name)] (#Cons [_ (#Tuple params)] #Nil)) - (return (list (form$ (list (tag$ ["lux" "HostT"]) (text$ class-name) (untemplate-list params))))) + (return (list (form$ (list (tag$ ["lux" "Host"]) (text$ class-name) (untemplate-list params))))) _ (fail "Wrong syntax for host"))) @@ -2494,7 +2494,7 @@ [_ (#Form (#Cons type-fn args))] (fold (_lux_: (-> AST AST AST) - (function' [arg type-fn] (` (#;AppT (~ type-fn) (~ arg))))) + (function' [arg type-fn] (` (#;App (~ type-fn) (~ arg))))) (walk-type type-fn) (map walk-type args)) @@ -2576,7 +2576,7 @@ (#Cons type #Nil) (_lux_case type [_ (#Tag "" member-name)] - (return [(` #;UnitT) (#;Some (list member-name))]) + (return [(` #;Unit) (#;Some (list member-name))]) [_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))] (return [(` (& (~@ member-types))) (#;Some (list member-name))]) @@ -2631,9 +2631,9 @@ [Int (List Self)])")]) (_lux_case tokens (#Cons [_ (#Symbol "" name)] (#Cons body #Nil)) - (let' [body' (replace-syntax (list [name (` (#AppT (~ (make-bound +0)) (~ (make-bound +1))))]) + (let' [body' (replace-syntax (list [name (` (#App (~ (make-bound +0)) (~ (make-bound +1))))]) (update-bounds body))] - (return (list (` (#AppT (#UnivQ #Nil (~ body')) Void))))) + (return (list (` (#App (#UnivQ #Nil (~ body')) Void))))) _ (fail "Wrong syntax for Rec"))) @@ -3375,14 +3375,14 @@ (def: (beta-reduce env type) (-> (List Type) Type Type) (case type - (#SumT left right) - (#SumT (beta-reduce env left) (beta-reduce env right)) + (#Sum left right) + (#Sum (beta-reduce env left) (beta-reduce env right)) - (#ProdT left right) - (#ProdT (beta-reduce env left) (beta-reduce env right)) + (#Product left right) + (#Product (beta-reduce env left) (beta-reduce env right)) - (#AppT ?type-fn ?type-arg) - (#AppT (beta-reduce env ?type-fn) (beta-reduce env ?type-arg)) + (#App ?type-fn ?type-arg) + (#App (beta-reduce env ?type-fn) (beta-reduce env ?type-arg)) (#UnivQ ?local-env ?local-def) (case ?local-env @@ -3400,10 +3400,10 @@ _ type) - (#FunctionT ?input ?output) - (#FunctionT (beta-reduce env ?input) (beta-reduce env ?output)) + (#Function ?input ?output) + (#Function (beta-reduce env ?input) (beta-reduce env ?output)) - (#BoundT idx) + (#Bound idx) (case (nth (_lux_proc ["nat" "to-int"] [idx]) env) (#Some bound) bound @@ -3411,7 +3411,7 @@ _ type) - (#NamedT name type) + (#Named name type) (beta-reduce env type) _ @@ -3427,12 +3427,12 @@ (#ExQ env body) (#Some (beta-reduce (list& type-fn param env) body)) - (#AppT F A) + (#App F A) (do Monad<Maybe> [type-fn* (apply-type F A)] (apply-type type-fn* param)) - (#NamedT name type) + (#Named name type) (apply-type type param) _ @@ -3448,19 +3448,19 @@ _ (list type)))] - [flatten-variant #;SumT] - [flatten-tuple #;ProdT] - [flatten-lambda #;FunctionT] - [flatten-app #;AppT] + [flatten-variant #;Sum] + [flatten-tuple #;Product] + [flatten-lambda #;Function] + [flatten-app #;App] ) (def: (resolve-struct-type type) (-> Type (Maybe (List Type))) (case type - (#ProdT _) + (#Product _) (#Some (flatten-tuple type)) - (#AppT fun arg) + (#App fun arg) (do Monad<Maybe> [output (apply-type fun arg)] (resolve-struct-type output)) @@ -3471,10 +3471,10 @@ (#ExQ _ body) (resolve-struct-type body) - (#NamedT name type) + (#Named name type) (resolve-struct-type type) - (#SumT _) + (#Sum _) #None _ @@ -3515,7 +3515,7 @@ (def: (resolve-type-tags type) (-> Type (Lux (Maybe [(List Ident) (List Type)]))) (case type - (#AppT fun arg) + (#App fun arg) (resolve-type-tags fun) (#UnivQ env body) @@ -3524,12 +3524,12 @@ (#ExQ env body) (resolve-type-tags body) - (#NamedT [module name] _) + (#Named [module name] _) (do Monad<Lux> [=module (find-module module) #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-anns _ #module-state _} =module]] (case (get name types) - (#Some [tags exported? (#NamedT _ _type)]) + (#Some [tags exported? (#Named _ _type)]) (case (resolve-struct-type _type) (#Some members) (return (#Some [tags members])) @@ -3771,9 +3771,9 @@ type-meta meta)) Type - (#;NamedT [(~ (text$ module-name)) - (~ (text$ name))] - (type (~ type''))))))) + (#;Named [(~ (text$ module-name)) + (~ (text$ name))] + (type (~ type''))))))) #None (fail "Wrong syntax for type:")))) @@ -4226,7 +4226,7 @@ (def: (Type/show type) (-> Type Text) (case type - (#HostT name params) + (#Host name params) (case params #;Nil name @@ -4234,28 +4234,28 @@ _ ($_ Text/append "(" name " " (|> params (map Type/show) (interpose " ") reverse (fold Text/append "")) ")")) - #VoidT + #Void "Void" - #UnitT + #Unit "Unit" - (#SumT _) + (#Sum _) ($_ Text/append "(| " (|> (flatten-variant type) (map Type/show) (interpose " ") reverse (fold Text/append "")) ")") - (#ProdT _) + (#Product _) ($_ Text/append "[" (|> (flatten-tuple type) (map Type/show) (interpose " ") reverse (fold Text/append "")) "]") - (#FunctionT _) + (#Function _) ($_ Text/append "(-> " (|> (flatten-lambda type) (map Type/show) (interpose " ") reverse (fold Text/append "")) ")") - (#BoundT id) + (#Bound id) (Nat/encode id) - (#VarT id) + (#Var id) ($_ Text/append "⌈v:" (Nat/encode id) "⌋") - (#ExT id) + (#Ex id) ($_ Text/append "⟨e:" (Nat/encode id) "⟩") (#UnivQ env body) @@ -4264,10 +4264,10 @@ (#ExQ env body) ($_ Text/append "(Ex " (Type/show body) ")") - (#AppT _) + (#App _) ($_ Text/append "(" (|> (flatten-app type) (map Type/show) (interpose " ") reverse (fold Text/append "")) ")") - (#NamedT [prefix name] _) + (#Named [prefix name] _) ($_ Text/append prefix ";" name) )) @@ -4845,19 +4845,19 @@ (def: (beta-reduce env type) (-> (List Type) Type Type) (case type - (#;HostT name params) - (#;HostT name (List/map (beta-reduce env) params)) + (#;Host name params) + (#;Host name (List/map (beta-reduce env) params)) (^template [<tag>] (<tag> left right) (<tag> (beta-reduce env left) (beta-reduce env right))) - ([#;SumT] [#;ProdT]) + ([#;Sum] [#;Product]) (^template [<tag>] (<tag> left right) (<tag> (beta-reduce env left) (beta-reduce env right))) - ([#;FunctionT] - [#;AppT]) + ([#;Function] + [#;App]) (^template [<tag>] (<tag> old-env def) @@ -4870,7 +4870,7 @@ ([#;UnivQ] [#;ExQ]) - (#;BoundT idx) + (#;Bound idx) (default type (list;nth idx env)) _ @@ -5116,31 +5116,31 @@ (def: (type-to-ast type) (-> Type AST) (case type - (#HostT name params) - (` (#HostT (~ (text$ name)) (~ (untemplate-list (map type-to-ast params))))) + (#Host name params) + (` (#Host (~ (text$ name)) (~ (untemplate-list (map type-to-ast params))))) - #VoidT - (` #VoidT) + #Void + (` #Void) - #UnitT - (` #UnitT) + #Unit + (` #Unit) (^template [<tag>] (<tag> left right) (` (<tag> (~ (type-to-ast left)) (~ (type-to-ast right))))) - ([#SumT] [#ProdT]) + ([#Sum] [#Product]) - (#FunctionT in out) - (` (#FunctionT (~ (type-to-ast in)) (~ (type-to-ast out)))) + (#Function in out) + (` (#Function (~ (type-to-ast in)) (~ (type-to-ast out)))) - (#BoundT idx) - (` (#BoundT (~ (nat$ idx)))) + (#Bound idx) + (` (#Bound (~ (nat$ idx)))) - (#VarT id) - (` (#VarT (~ (nat$ id)))) + (#Var id) + (` (#Var (~ (nat$ id)))) - (#ExT id) - (` (#ExT (~ (nat$ id)))) + (#Ex id) + (` (#Ex (~ (nat$ id)))) (#UnivQ env type) (let [env' (untemplate-list (map type-to-ast env))] @@ -5150,11 +5150,11 @@ (let [env' (untemplate-list (map type-to-ast env))] (` (#ExQ (~ env') (~ (type-to-ast type))))) - (#AppT fun arg) - (` (#AppT (~ (type-to-ast fun)) (~ (type-to-ast arg)))) + (#App fun arg) + (` (#App (~ (type-to-ast fun)) (~ (type-to-ast arg)))) - (#NamedT [module name] type) - (` (#NamedT [(~ (text$ module)) (~ (text$ name))] (~ (type-to-ast type)))) + (#Named [module name] type) + (` (#Named [(~ (text$ module)) (~ (text$ name))] (~ (type-to-ast type)))) )) (macro: #export (loop tokens) @@ -5324,7 +5324,7 @@ (-> Type Type) (case type (^template [<name>] - (#NamedT ["lux" <name>] _) + (#Named ["lux" <name>] _) type) (["Bool"] ["Nat"] @@ -5334,7 +5334,7 @@ ["Char"] ["Text"]) - (#NamedT _ type') + (#Named _ type') type' _ @@ -5347,7 +5347,7 @@ #let [[type value] type+value]] (case (flatten-alias type) (^template [<name> <type> <wrapper>] - (#NamedT ["lux" <name>] _) + (#Named ["lux" <name>] _) (wrap (<wrapper> (:! <type> value)))) (["Bool" Bool bool$] ["Nat" Nat nat$] @@ -5419,7 +5419,7 @@ _ (fail "Wrong syntax for ^~"))) -(type: MultiLevelCase +(type: Multi-Level-Case [AST (List [AST AST])]) (def: (case-level^ level) @@ -5433,7 +5433,7 @@ )) (def: (multi-level-case^ levels) - (-> (List AST) (Lux MultiLevelCase)) + (-> (List AST) (Lux Multi-Level-Case)) (case levels #;Nil (fail "Multi-level patterns cannot be empty.") @@ -5444,7 +5444,7 @@ (wrap [init extras'])))) (def: (multi-level-case$ g!_ [[init-pattern levels] body]) - (-> AST [MultiLevelCase AST] (List AST)) + (-> AST [Multi-Level-Case AST] (List AST)) (let [inner-pattern-body (fold (function [[calculation pattern] success] (` (case (~ calculation) (~ pattern) @@ -5482,7 +5482,7 @@ expected get-expected-type g!temp (gensym "temp")] (let [output (list g!temp - (` (;_lux_case (;_lux_: (#;AppT Maybe (~ (type-to-ast expected))) + (` (;_lux_case (;_lux_: (#;App Maybe (~ (type-to-ast expected))) (case (~ g!temp) (~@ (multi-level-case$ g!temp [mlc body])) @@ -5561,7 +5561,7 @@ [stvs get-scope-type-vars] (case (list-at idx (reverse stvs)) (#;Some var-id) - (wrap (list (` (#ExT (~ (nat$ var-id)))))) + (wrap (list (` (#Ex (~ (nat$ var-id)))))) #;None (fail (Text/append "Indexed-type does not exist: " (Nat/encode idx))))) diff --git a/stdlib/source/lux/concurrency/atom.lux b/stdlib/source/lux/concurrency/atom.lux index 209dec8db..27bbe25fd 100644 --- a/stdlib/source/lux/concurrency/atom.lux +++ b/stdlib/source/lux/concurrency/atom.lux @@ -4,7 +4,7 @@ (type: #export (Atom a) {#;doc "Atomic references that are safe to mutate concurrently."} - (#;HostT "#Atom" (#;Cons a #;Nil))) + (#;Host "#Atom" (#;Cons a #;Nil))) (def: #export (atom value) (All [a] (-> a (Atom a))) diff --git a/stdlib/source/lux/control/effect.lux b/stdlib/source/lux/control/effect.lux index fd0973470..668b3a30e 100644 --- a/stdlib/source/lux/control/effect.lux +++ b/stdlib/source/lux/control/effect.lux @@ -227,7 +227,7 @@ (def: (un-apply type-app) (-> Type Type) (case type-app - (#;AppT effect value) + (#;App effect value) effect _ @@ -263,21 +263,21 @@ (def: (flatten-effect-stack stack) (-> Type (List Type)) (case stack - (#;SumT left right) + (#;Sum left right) (List/append (flatten-effect-stack left) (flatten-effect-stack right)) - (^ (#;AppT branches (#;VarT _))) + (^ (#;App branches (#;Var _))) (flatten-effect-stack branches) - (^ (#;AppT (#;AppT (#;NamedT (ident-for ;;|@) _) - left) - right)) + (^ (#;App (#;App (#;Named (ident-for ;;|@) _) + left) + right)) (#;Cons left (flatten-effect-stack right)) - (^ (#;AppT (#;AppT (#;NamedT (ident-for M;Free) _) - effect) - param)) + (^ (#;App (#;App (#;Named (ident-for M;Free) _) + effect) + param)) (list effect) _ @@ -286,7 +286,7 @@ (def: (same-effect? expected actual) (case [expected actual] - [(#;NamedT e-name _) (#;NamedT a-name _)] + [(#;Named e-name _) (#;Named a-name _)] (Ident/= e-name a-name) _ @@ -319,10 +319,10 @@ [input (macro;find-type var) output macro;expected-type] (case [input output] - (^=> [(#;AppT eff0 _) (#;AppT stackT0 recT0)] + (^=> [(#;App eff0 _) (#;App stackT0 recT0)] [(type;apply-type stackT0 recT0) (#;Some unfoldT0)] - [stackT0 (^ (#;AppT (#;NamedT (ident-for M;Free) _) - stackT1))] + [stackT0 (^ (#;App (#;Named (ident-for M;Free) _) + stackT1))] [(type;apply-type stackT1 recT0) (#;Some unfoldT1)] [(flatten-effect-stack unfoldT1) stack] [(|> stack list;enumerate diff --git a/stdlib/source/lux/data/coll/array.lux b/stdlib/source/lux/data/coll/array.lux index 304bd6ec7..8631f154d 100644 --- a/stdlib/source/lux/data/coll/array.lux +++ b/stdlib/source/lux/data/coll/array.lux @@ -14,7 +14,7 @@ ## [Types] (type: #export (Array a) {#;doc "Mutable arrays."} - (#;HostT "#Array" (#;Cons a #;Nil))) + (#;Host "#Array" (#;Cons a #;Nil))) ## [Functions] (def: #export (new size) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index ee343e6ee..9f2c01d0e 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -626,7 +626,7 @@ (-> Nat Nat Nat) (bit-or (bit-shift-left idx +1) input)) -(type: Digits (#;HostT "#Array" (#;Cons Nat #;Nil))) +(type: Digits (#;Host "#Array" (#;Cons Nat #;Nil))) (def: (make-digits _) (-> Top Digits) diff --git a/stdlib/source/lux/host.js.lux b/stdlib/source/lux/host.js.lux index c1bb5f1f8..39e15f780 100644 --- a/stdlib/source/lux/host.js.lux +++ b/stdlib/source/lux/host.js.lux @@ -8,7 +8,7 @@ )) (do-template [<name> <type>] - [(type: #export <name> (#;HostT <type> #;Nil))] + [(type: #export <name> (#;Host <type> #;Nil))] [Object "object"] [Function "function"] diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 5efeb05c5..2aa352cf7 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -66,7 +66,7 @@ ## Types (do-template [<class> <name>] [(type: #export <name> - (#;HostT <class> #;Nil))] + (#;Host <class> #;Nil))] ["[Z" Boolean-Array] ["[B" Byte-Array] @@ -2001,10 +2001,10 @@ (def: (type->class-name type) (-> Type (Lux Text)) (case type - (#;HostT name params) + (#;Host name params) (:: Monad<Lux> wrap name) - (#;AppT F A) + (#;App F A) (case (type;apply-type F A) #;None (macro;fail (format "Cannot apply type: " (type;to-text F) " to " (type;to-text A))) @@ -2012,13 +2012,13 @@ (#;Some type') (type->class-name type')) - (#;NamedT _ type') + (#;Named _ type') (type->class-name type') - #;UnitT + #;Unit (:: Monad<Lux> wrap "java.lang.Object") - (^or #;VoidT (#;VarT _) (#;ExT _) (#;BoundT _) (#;SumT _) (#;ProdT _) (#;FunctionT _) (#;UnivQ _) (#;ExQ _)) + (^or #;Void (#;Var _) (#;Ex _) (#;Bound _) (#;Sum _) (#;Product _) (#;Function _) (#;UnivQ _) (#;ExQ _)) (macro;fail (format "Cannot convert to JvmType: " (type;to-text type))) )) diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 96158a80e..3252cfeeb 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -36,8 +36,8 @@ _ (macro;fail (format "Not " <name> " type: " (%type :type:))))))] - [void "Void" #;VoidT] - [unit "Unit" #;UnitT] + [void "Void" #;Void] + [unit "Unit" #;Unit] ) (do-template [<combinator> <name>] @@ -45,7 +45,7 @@ (Matcher Unit) (;function [:type:] (case (type;un-alias :type:) - (#;NamedT ["lux" <name>] _) + (#;Named ["lux" <name>] _) (:: macro;Monad<Lux> wrap []) _ @@ -102,19 +102,19 @@ (:: macro;Monad<Lux> wrap members) (macro;fail (format "Not a " ($AST$ <tag>) " type: " (%type :type:)))))))] - [sum sum+ type;flatten-variant #;SumT] - [prod prod+ type;flatten-tuple #;ProdT] + [sum sum+ type;flatten-variant #;Sum] + [prod prod+ type;flatten-tuple #;Product] ) (def: #export func (Matcher [Type Type]) (;function [:type:] (case (type;un-name :type:) - (#;FunctionT :left: :right:) + (#;Function :left: :right:) (:: macro;Monad<Lux> wrap [:left: :right:]) _ - (macro;fail (format "Not a FunctionT type: " (%type :type:)))))) + (macro;fail (format "Not a Function type: " (%type :type:)))))) (def: #export func+ (Matcher [(List Type) Type]) @@ -122,13 +122,13 @@ (let [[ins out] (type;flatten-function (type;un-name :type:))] (if (n.> +0 (list;size ins)) (:: macro;Monad<Lux> wrap [ins out]) - (macro;fail (format "Not a FunctionT type: " (%type :type:))))))) + (macro;fail (format "Not a Function type: " (%type :type:))))))) (def: #export tagged (Matcher [(List Ident) Type]) (;function [:type:] (case (type;un-alias :type:) - (#;NamedT type-name :def:) + (#;Named type-name :def:) (do macro;Monad<Lux> [tags (macro;tags-of type-name)] (wrap [tags :def:])) @@ -158,7 +158,7 @@ (do macro;Monad<Lux> [[tags :type:] (tagged :type:) _ (macro;assert "Records and variants must have tags." - (n.> +0 (list;size tags))) + (n.> +0 (list;size tags))) [vars :type:] (polymorphic :type:) members (<sub-comb> :type:) #let [num-tags (list;size tags) @@ -195,7 +195,7 @@ (do macro;Monad<Lux> [#let [[:func: :args:] (loop [:type: (type;un-name :type:)] (case :type: - (#;AppT :func: :arg:) + (#;App :func: :arg:) (let [[:func:' :args:] (recur :func:)] [:func:' (list& :arg: :args:)]) @@ -213,8 +213,8 @@ (Matcher Type) (;function [:type:] (case (type;un-name :type:) - (^=> (#;AppT :quant: :arg:) - [(type;un-alias :quant:) (#;NamedT ["lux" <name>] _)]) + (^=> (#;App :quant: :arg:) + [(type;un-alias :quant:) (#;Named ["lux" <name>] _)]) (:: macro;Monad<Lux> wrap :arg:) _ @@ -235,7 +235,7 @@ (-> Env (Matcher AST)) (;function [:type:] (case :type: - (#;BoundT idx) + (#;Bound idx) (case (dict;get (adjusted-idx env idx) env) (#;Some [poly-type poly-ast]) (:: macro;Monad<Lux> wrap poly-ast) @@ -252,13 +252,13 @@ (do Monad<Lux> [[t-func t-args] (apply :type:)] (case t-func - (^=> (#;BoundT t-func-idx) + (^=> (#;Bound t-func-idx) (n.= +0 (adjusted-idx env t-func-idx)) [(do maybe;Monad<Maybe> [=func (dict;get +0 env) =args (mapM @ (;function [t-arg] (case t-arg - (#;BoundT idx) + (#;Bound idx) (dict;get (adjusted-idx env idx) env) _ @@ -276,7 +276,7 @@ (-> Env Nat (Matcher Unit)) (;function [:type:] (case :type: - (^=> (#;BoundT idx) + (^=> (#;Bound idx) (n.= var-id (adjusted-idx env idx))) (:: macro;Monad<Lux> wrap []) @@ -295,7 +295,7 @@ (|> env (dict;put current-size [funcT funcA]) (dict;put (n.inc current-size) [varT varA]) - (extend-env [(#;AppT funcT varT) (` (#;AppT (~ funcA) (~ varA)))] + (extend-env [(#;App funcT varT) (` (#;App (~ funcA) (~ varA)))] type-vars') )))) @@ -365,21 +365,21 @@ (def: (to-ast env type) (-> Env Type AST) (case type - (#;HostT name params) - (` (#;HostT (~ (ast;text name)) - (list (~@ (List/map (to-ast env) params))))) + (#;Host name params) + (` (#;Host (~ (ast;text name)) + (list (~@ (List/map (to-ast env) params))))) (^template [<tag>] <tag> (` <tag>)) - ([#;VoidT] [#;UnitT]) + ([#;Void] [#;Unit]) (^template [<tag>] (<tag> idx) (` (<tag> (~ (ast;nat idx))))) - ([#;VarT] [#;ExT]) + ([#;Var] [#;Ex]) - (#;BoundT idx) + (#;Bound idx) (let [idx (adjusted-idx env idx)] (if (n.= +0 idx) (|> (dict;get idx env) (default (undefined)) product;left (to-ast env)) @@ -389,15 +389,15 @@ (<tag> left right) (` (<tag> (~ (to-ast env left)) (~ (to-ast env right))))) - ([#;FunctionT] [#;AppT]) + ([#;Function] [#;App]) (^template [<tag> <macro> <flattener>] (<tag> left right) (` (<macro> (~@ (List/map (to-ast env) (<flattener> type)))))) - ([#;SumT | type;flatten-variant] - [#;ProdT & type;flatten-tuple]) + ([#;Sum | type;flatten-variant] + [#;Product & type;flatten-tuple]) - (#;NamedT name sub-type) + (#;Named name sub-type) (ast;symbol name) (^template [<tag>] @@ -421,4 +421,4 @@ (def: #export (type-var-indices num-vars) (-> Nat (List Type)) - (|> num-vars list;indices (List/map (|>. #;BoundT)))) + (|> num-vars list;indices (List/map (|>. #;Bound)))) diff --git a/stdlib/source/lux/math/simple.lux b/stdlib/source/lux/math/simple.lux index 6e6e23592..359a2d23b 100644 --- a/stdlib/source/lux/math/simple.lux +++ b/stdlib/source/lux/math/simple.lux @@ -16,7 +16,7 @@ (get@ #;var-bindings env)) (#;Some [_ (#;Some type)]) (case type - (#;VarT id') + (#;Var id') (find-type-var id' env) _ @@ -35,7 +35,7 @@ [raw-type (macro;find-type var-name) compiler macro;get-compiler] (case raw-type - (#;VarT id) + (#;Var id) (find-type-var id (get@ #;type-context compiler)) _ diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux index d125b8b98..186cfac81 100644 --- a/stdlib/source/lux/type.lux +++ b/stdlib/source/lux/type.lux @@ -14,14 +14,14 @@ (def: (beta-reduce env type) (-> (List Type) Type Type) (case type - (#;HostT name params) - (#;HostT name (List/map (beta-reduce env) params)) + (#;Host name params) + (#;Host name (List/map (beta-reduce env) params)) (^template [<tag>] (<tag> left right) (<tag> (beta-reduce env left) (beta-reduce env right))) - ([#;SumT] [#;ProdT] - [#;FunctionT] [#;AppT]) + ([#;Sum] [#;Product] + [#;Function] [#;App]) (^template [<tag>] (<tag> old-env def) @@ -34,7 +34,7 @@ ([#;UnivQ] [#;ExQ]) - (#;BoundT idx) + (#;Bound idx) (default (error! (Text/append "Unknown type var: " (Nat/encode idx))) (list;nth idx env)) @@ -46,7 +46,7 @@ (struct: #export _ (Eq Type) (def: (= x y) (case [x y] - [(#;HostT xname xparams) (#;HostT yname yparams)] + [(#;Host xname xparams) (#;Host yname yparams)] (and (Text/= xname yname) (n.= (list;size yparams) (list;size xparams)) (List/fold (;function [[x y] prev] (and prev (= x y))) @@ -56,26 +56,26 @@ (^template [<tag>] [<tag> <tag>] true) - ([#;VoidT] [#;UnitT]) + ([#;Void] [#;Unit]) (^template [<tag>] [(<tag> xid) (<tag> yid)] (n.= yid xid)) - ([#;VarT] [#;ExT] [#;BoundT]) + ([#;Var] [#;Ex] [#;Bound]) - (^or [(#;FunctionT xleft xright) (#;FunctionT yleft yright)] - [(#;AppT xleft xright) (#;AppT yleft yright)]) + (^or [(#;Function xleft xright) (#;Function yleft yright)] + [(#;App xleft xright) (#;App yleft yright)]) (and (= xleft yleft) (= xright yright)) - [(#;NamedT xname xtype) (#;NamedT yname ytype)] + [(#;Named xname xtype) (#;Named yname ytype)] (and (Ident/= xname yname) (= xtype ytype)) (^template [<tag>] [(<tag> xL xR) (<tag> yL yR)] (and (= xL yL) (= xR yR))) - ([#;SumT] [#;ProdT]) + ([#;Sum] [#;Product]) (^or [(#;UnivQ xenv xbody) (#;UnivQ yenv ybody)] [(#;ExQ xenv xbody) (#;ExQ yenv ybody)]) @@ -109,7 +109,7 @@ (def: #export (flatten-function type) (-> Type [(List Type) Type]) (case type - (#;FunctionT in out') + (#;Function in out') (let [[ins out] (flatten-function out')] [(list& in ins) out]) @@ -119,7 +119,7 @@ (def: #export (flatten-application type) (-> Type [Type (List Type)]) (case type - (#;AppT left' right) + (#;App left' right) (let [[left rights] (flatten-application left')] [left (List/append rights (list right))]) @@ -136,8 +136,8 @@ _ (list type)))] - [flatten-variant #;SumT] - [flatten-tuple #;ProdT] + [flatten-variant #;Sum] + [flatten-tuple #;Product] ) (def: #export (apply-type type-func param) @@ -148,12 +148,12 @@ (#;Some (beta-reduce (list& type-func param env) body))) ([#;UnivQ] [#;ExQ]) - (#;AppT F A) + (#;App F A) (do Monad<Maybe> [type-fn* (apply-type F A)] (apply-type type-fn* param)) - (#;NamedT name type) + (#;Named name type) (apply-type type param) _ @@ -162,33 +162,33 @@ (def: #export (to-ast type) (-> Type AST) (case type - (#;HostT name params) - (` (#;HostT (~ (ast;text name)) - (list (~@ (List/map to-ast params))))) + (#;Host name params) + (` (#;Host (~ (ast;text name)) + (list (~@ (List/map to-ast params))))) (^template [<tag>] <tag> (` <tag>)) - ([#;VoidT] [#;UnitT]) + ([#;Void] [#;Unit]) (^template [<tag>] (<tag> idx) (` (<tag> (~ (ast;nat idx))))) - ([#;VarT] [#;ExT] [#;BoundT]) + ([#;Var] [#;Ex] [#;Bound]) (^template [<tag>] (<tag> left right) (` (<tag> (~ (to-ast left)) (~ (to-ast right))))) - ([#;FunctionT] [#;AppT]) + ([#;Function] [#;App]) (^template [<tag> <macro> <flattener>] (<tag> left right) (` (<macro> (~@ (List/map to-ast (<flattener> type)))))) - ([#;SumT | flatten-variant] - [#;ProdT & flatten-tuple]) + ([#;Sum | flatten-variant] + [#;Product & flatten-tuple]) - (#;NamedT name sub-type) + (#;Named name sub-type) (ast;symbol name) (^template [<tag>] @@ -201,7 +201,7 @@ (def: #export (to-text type) (-> Type Text) (case type - (#;HostT name params) + (#;Host name params) (case params #;Nil ($_ Text/append "(host " name ")") @@ -209,10 +209,10 @@ _ ($_ Text/append "(host " name " " (|> params (List/map to-text) list;reverse (list;interpose " ") (List/fold Text/append "")) ")")) - #;VoidT + #;Void "Void" - #;UnitT + #;Unit "Unit" (^template [<tag> <open> <close> <flatten>] @@ -224,10 +224,10 @@ (list;interpose " ") (List/fold Text/append "")) <close>)) - ([#;SumT "(| " ")" flatten-variant] - [#;ProdT "[" "]" flatten-tuple]) + ([#;Sum "(| " ")" flatten-variant] + [#;Product "[" "]" flatten-tuple]) - (#;FunctionT input output) + (#;Function input output) (let [[ins out] (flatten-function type)] ($_ Text/append "(-> " (|> ins @@ -237,16 +237,16 @@ (List/fold Text/append "")) " " (to-text out) ")")) - (#;BoundT idx) + (#;Bound idx) (Nat/encode idx) - (#;VarT id) + (#;Var id) ($_ Text/append "⌈v:" (Nat/encode id) "⌋") - (#;ExT id) + (#;Ex id) ($_ Text/append "⟨e:" (Nat/encode id) "⟩") - (#;AppT fun param) + (#;App fun param) (let [[type-func type-args] (flatten-application type)] ($_ Text/append "(" (to-text type-func) " " (|> type-args (List/map to-text) list;reverse (list;interpose " ") (List/fold Text/append "")) ")")) @@ -256,15 +256,15 @@ ([#;UnivQ "All"] [#;ExQ "Ex"]) - (#;NamedT [module name] type) + (#;Named [module name] type) ($_ Text/append module ";" name) )) (def: #export (un-alias type) (-> Type Type) (case type - (#;NamedT _ (#;NamedT ident type')) - (un-alias (#;NamedT ident type')) + (#;Named _ (#;Named ident type')) + (un-alias (#;Named ident type')) _ type)) @@ -272,7 +272,7 @@ (def: #export (un-name type) (-> Type Type) (case type - (#;NamedT ident type') + (#;Named ident type') (un-name type') _ @@ -291,8 +291,8 @@ (#;Cons type types') (<ctor> type (<name> types'))))] - [variant Void #;SumT] - [tuple Unit #;ProdT] + [variant Void #;Sum] + [tuple Unit #;Product] ) (def: #export (function inputs output) @@ -302,7 +302,7 @@ output (#;Cons input inputs') - (#;FunctionT input (function inputs' output)))) + (#;Function input (function inputs' output)))) (def: #export (application quant params) (-> Type (List Type) Type) @@ -311,7 +311,7 @@ quant (#;Cons param params') - (application (#;AppT quant param) params'))) + (application (#;App quant param) params'))) (do-template [<name> <tag>] [(def: #export (<name> size body) @@ -327,10 +327,10 @@ (def: #export (quantified? type) (-> Type Bool) (case type - (#;NamedT [module name] _type) + (#;Named [module name] _type) (quantified? _type) - (#;AppT F A) + (#;App F A) (default false (do Monad<Maybe> [applied (apply-type F A)] diff --git a/stdlib/source/lux/type/auto.lux b/stdlib/source/lux/type/auto.lux index 6a2991fa5..6ba7cdb8b 100644 --- a/stdlib/source/lux/type/auto.lux +++ b/stdlib/source/lux/type/auto.lux @@ -22,7 +22,7 @@ (get@ #;var-bindings env)) (#;Some [_ (#;Some type)]) (case type - (#;VarT id') + (#;Var id') (find-type-var id' env) _ @@ -41,7 +41,7 @@ [raw-type (macro;find-type var-name) compiler macro;get-compiler] (case raw-type - (#;VarT id) + (#;Var id) (find-type-var id (get@ #;type-context compiler)) _ @@ -50,10 +50,10 @@ (def: (find-member-type idx sig-type) (-> Nat Type (Check Type)) (case sig-type - (#;NamedT _ sig-type') + (#;Named _ sig-type') (find-member-type idx sig-type') - (#;AppT func arg) + (#;App func arg) (case (type;apply-type func arg) #;None (tc;fail (format "Cannot apply type " (%type func) " to type " (%type arg))) @@ -61,7 +61,7 @@ (#;Some sig-type') (find-member-type idx sig-type')) - (#;ProdT left right) + (#;Product left right) (if (n.= +0 idx) (:: Monad<Check> wrap left) (find-member-type (n.dec idx) right)) @@ -149,7 +149,7 @@ (def: (apply-function-type func arg) (-> Type Type (Check Type)) (case func - (#;NamedT _ func') + (#;Named _ func') (apply-function-type func' arg) (#;UnivQ _) @@ -159,7 +159,7 @@ (type;apply-type func var)) arg)) - (#;FunctionT input output) + (#;Function input output) (do Monad<Check> [_ (tc;check input arg)] (wrap output)) diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux index 1fec0891a..5db2059fa 100644 --- a/stdlib/source/lux/type/check.lux +++ b/stdlib/source/lux/type/check.lux @@ -145,7 +145,7 @@ (function [context] (let [id (get@ #;ex-counter context)] (#;Right [(update@ #;ex-counter n.inc context) - [id (#;ExT id)]])))) + [id (#;Ex id)]])))) (def: #export (bound? id) (-> Nat (Check Bool)) @@ -212,7 +212,7 @@ (def: #export (clean t-id type) (-> Nat Type (Check Type)) (case type - (#;VarT id) + (#;Var id) (if (n.= t-id id) (do Monad<Check> [? (bound? id)] @@ -226,7 +226,7 @@ [=type (read-var id) ==type (clean t-id =type)] (case ==type - (#;VarT =id) + (#;Var =id) (if (n.= t-id =id) (do Monad<Check> [_ (clear-var id)] @@ -241,10 +241,10 @@ (wrap type)))) (wrap type)))) - (#;HostT name params) + (#;Host name params) (do Monad<Check> [=params (mapM @ (clean t-id) params)] - (wrap (#;HostT name =params))) + (wrap (#;Host name =params))) (^template [<tag>] (<tag> left right) @@ -252,16 +252,16 @@ [=left (clean t-id left) =right (clean t-id right)] (wrap (<tag> =left =right)))) - ([#;FunctionT] - [#;AppT] - [#;ProdT] - [#;SumT]) + ([#;Function] + [#;App] + [#;Product] + [#;Sum]) (^template [<tag>] (<tag> env body) (do Monad<Check> [=env (mapM @ (clean t-id) env) - =body (clean t-id body)] ## TODO: DON'T CLEAN THE BODY + =body (clean t-id body)] ## TODO: DO NOT CLEAN THE BODY (wrap (<tag> =env =body)))) ([#;UnivQ] [#;ExQ]) @@ -277,7 +277,7 @@ (#;Right [(|> context (update@ #;var-counter n.inc) (update@ #;var-bindings (var::put id #;None))) - [id (#;VarT id)]])))) + [id (#;Var id)]])))) (def: get-bindings (Check (List [Nat (Maybe Type)])) @@ -311,7 +311,7 @@ (#;Some b-type') (case b-type' - (#;VarT t-id) + (#;Var t-id) (if (n.= id t-id) (wrap [b-id #;None]) (wrap binding)) @@ -387,7 +387,7 @@ (if (is expected actual) (Check/wrap fixed) (case [expected actual] - [(#;VarT e-id) (#;VarT a-id)] + [(#;Var e-id) (#;Var a-id)] (if (n.= e-id a-id) (Check/wrap fixed) (do Monad<Check> @@ -408,7 +408,7 @@ [(#;Some etype) (#;Some atype)] (check' etype atype fixed)))) - [(#;VarT id) _] + [(#;Var id) _] (either (do Monad<Check> [_ (write-var id actual)] (wrap fixed)) @@ -416,7 +416,7 @@ [bound (read-var id)] (check' bound actual fixed))) - [_ (#;VarT id)] + [_ (#;Var id)] (either (do Monad<Check> [_ (write-var id expected)] (wrap fixed)) @@ -424,32 +424,32 @@ [bound (read-var id)] (check' expected bound fixed))) - [(#;AppT (#;ExT eid) eA) (#;AppT (#;ExT aid) aA)] + [(#;App (#;Ex eid) eA) (#;App (#;Ex aid) aA)] (if (n.= eid aid) (check' eA aA fixed) (fail-check expected actual)) - [(#;AppT (#;VarT id) A1) (#;AppT F2 A2)] + [(#;App (#;Var id) A1) (#;App F2 A2)] (either (do Monad<Check> [F1 (read-var id)] - (check' (#;AppT F1 A1) actual fixed)) + (check' (#;App F1 A1) actual fixed)) (do Monad<Check> - [fixed (check' (#;VarT id) F2 fixed) + [fixed (check' (#;Var id) F2 fixed) e' (apply-type! F2 A1) a' (apply-type! F2 A2)] (check' e' a' fixed))) - [(#;AppT F1 A1) (#;AppT (#;VarT id) A2)] + [(#;App F1 A1) (#;App (#;Var id) A2)] (either (do Monad<Check> [F2 (read-var id)] - (check' expected (#;AppT F2 A2) fixed)) + (check' expected (#;App F2 A2) fixed)) (do Monad<Check> - [fixed (check' F1 (#;VarT id) fixed) + [fixed (check' F1 (#;Var id) fixed) e' (apply-type! F1 A1) a' (apply-type! F1 A2)] (check' e' a' fixed))) - [(#;AppT F A) _] + [(#;App F A) _] (let [fx-pair [expected actual]] (case (fx-get fx-pair fixed) (#;Some ?) @@ -462,7 +462,7 @@ [expected' (apply-type! F A)] (check' expected' actual (fx-put fx-pair true fixed))))) - [_ (#;AppT F A)] + [_ (#;App F A)] (do Monad<Check> [actual' (apply-type! F A)] (check' expected actual' fixed)) @@ -497,7 +497,7 @@ actual' (apply-type! actual ex)] (check' expected actual' fixed)) - [(#;HostT e-name e-params) (#;HostT a-name a-params)] + [(#;Host e-name e-params) (#;Host a-name a-params)] (if (and (Text/= e-name a-name) (n.= (list;size e-params) (list;size a-params))) @@ -517,23 +517,23 @@ (do Monad<Check> [fixed (check' eL aL fixed)] (check' eR aR fixed))) - ([#;VoidT #;SumT] - [#;UnitT #;ProdT]) + ([#;Void #;Sum] + [#;Unit #;Product]) - [(#;FunctionT eI eO) (#;FunctionT aI aO)] + [(#;Function eI eO) (#;Function aI aO)] (do Monad<Check> [fixed (check' aI eI fixed)] (check' eO aO fixed)) - [(#;ExT e!id) (#;ExT a!id)] + [(#;Ex e!id) (#;Ex a!id)] (if (n.= e!id a!id) (Check/wrap fixed) (fail-check expected actual)) - [(#;NamedT _ ?etype) _] + [(#;Named _ ?etype) _] (check' ?etype actual fixed) - [_ (#;NamedT _ ?atype)] + [_ (#;Named _ ?atype)] (check' expected ?atype fixed) _ diff --git a/stdlib/test/test/lux/type.lux b/stdlib/test/test/lux/type.lux index 705306150..77858e7fa 100644 --- a/stdlib/test/test/lux/type.lux +++ b/stdlib/test/test/lux/type.lux @@ -55,15 +55,15 @@ (do Monad<Maybe> [partial (&;apply-type Meta Bool) full (&;apply-type partial Int)] - (wrap (:: &;Eq<Type> = full (#;ProdT Bool Int))))) + (wrap (:: &;Eq<Type> = full (#;Product Bool Int))))) (|> (&;apply-type Text Bool) (case> #;None true _ false))))) (test: "Naming" - (let [base (#;NamedT ["" "a"] (#;ProdT Bool Int)) - aliased (#;NamedT ["" "c"] - (#;NamedT ["" "b"] - base))] + (let [base (#;Named ["" "a"] (#;Product Bool Int)) + aliased (#;Named ["" "c"] + (#;Named ["" "b"] + base))] ($_ seq (assert "Can remove aliases from an already-named type." (:: &;Eq<Type> = @@ -83,7 +83,7 @@ members (|> gen-type (R;filter (function [type] (case type - (^or (#;SumT _) (#;ProdT _)) + (^or (#;Sum _) (#;Product _)) false _ @@ -112,7 +112,7 @@ extra (|> gen-type (R;filter (function [type] (case type - (^or (#;FunctionT _) (#;AppT _)) + (^or (#;Function _) (#;App _)) false _ diff --git a/stdlib/test/test/lux/type/check.lux b/stdlib/test/test/lux/type/check.lux index b57bec8e8..8cc8c88d7 100644 --- a/stdlib/test/test/lux/type/check.lux +++ b/stdlib/test/test/lux/type/check.lux @@ -46,18 +46,18 @@ (def: (valid-type? type) (-> Type Bool) (case type - (#;HostT name params) + (#;Host name params) (list;every? valid-type? params) - (^or #;VoidT #;UnitT (#;ExT id)) + (^or #;Void #;Unit (#;Ex id)) true (^template [<tag>] (<tag> left right) (and (valid-type? left) (valid-type? right))) - ([#;SumT] [#;ProdT] [#;FunctionT]) + ([#;Sum] [#;Product] [#;Function]) - (#;NamedT name type') + (#;Named name type') (valid-type? type') _ @@ -101,32 +101,32 @@ (assert "Names don't affect type-checking." (and (type-checks? (do &;Monad<Check> [[id ex] &;existential] - (&;check (#;NamedT ["module" "name"] ex) + (&;check (#;Named ["module" "name"] ex) ex))) (type-checks? (do &;Monad<Check> [[id ex] &;existential] (&;check ex - (#;NamedT ["module" "name"] ex)))) + (#;Named ["module" "name"] ex)))) (type-checks? (do &;Monad<Check> [[id ex] &;existential] - (&;check (#;NamedT ["module" "name"] ex) - (#;NamedT ["module" "name"] ex)))))) + (&;check (#;Named ["module" "name"] ex) + (#;Named ["module" "name"] ex)))))) (assert "Can type-check functions." - (and (&;checks? (#;FunctionT Bottom Top) - (#;FunctionT Top Bottom)) - (not (&;checks? (#;FunctionT Top Bottom) - (#;FunctionT Bottom Top))))) + (and (&;checks? (#;Function Bottom Top) + (#;Function Top Bottom)) + (not (&;checks? (#;Function Top Bottom) + (#;Function Bottom Top))))) )) (test: "Type application" [meta gen-type data gen-type] (assert "Can type-check type application." - (and (&;checks? (#;AppT (#;AppT Meta meta) data) + (and (&;checks? (#;App (#;App Meta meta) data) (type;tuple (list meta data))) (&;checks? (type;tuple (list meta data)) - (#;AppT (#;AppT Meta meta) data))))) + (#;App (#;App Meta meta) data))))) (test: "Host types" [nameL gen-name @@ -135,16 +135,16 @@ paramR (|> gen-type (R;filter (|>. (&;checks? paramL) not)))] ($_ seq (assert "Host types match when they have the same name and the same parameters." - (&;checks? (#;HostT nameL (list paramL)) - (#;HostT nameL (list paramL)))) + (&;checks? (#;Host nameL (list paramL)) + (#;Host nameL (list paramL)))) (assert "Names matter to host types." - (not (&;checks? (#;HostT nameL (list paramL)) - (#;HostT nameR (list paramL))))) + (not (&;checks? (#;Host nameL (list paramL)) + (#;Host nameR (list paramL))))) (assert "Parameters matter to host types." - (not (&;checks? (#;HostT nameL (list paramL)) - (#;HostT nameL (list paramR))))) + (not (&;checks? (#;Host nameL (list paramL)) + (#;Host nameL (list paramR))))) )) (test: "Type-vars" @@ -153,24 +153,24 @@ (type-checks? (&;with-var (function [[id var]] (&;check var var))))) (assert "Can bind unbound type-vars by type-checking against them." - (and (type-checks? (&;with-var (function [[id var]] (&;check var #;UnitT)))) - (type-checks? (&;with-var (function [[id var]] (&;check #;UnitT var)))))) + (and (type-checks? (&;with-var (function [[id var]] (&;check var #;Unit)))) + (type-checks? (&;with-var (function [[id var]] (&;check #;Unit var)))))) (assert "Can't rebind already bound type-vars." (not (type-checks? (&;with-var (function [[id var]] (do &;Monad<Check> - [_ (&;check var #;UnitT)] - (&;check var #;VoidT))))))) + [_ (&;check var #;Unit)] + (&;check var #;Void))))))) (assert "If the type bound to a var is a super-type to another, then the var is also a super-type." (type-checks? (&;with-var (function [[id var]] (do &;Monad<Check> [_ (&;check var Top)] - (&;check var #;UnitT)))))) + (&;check var #;Unit)))))) (assert "If the type bound to a var is a sub-type of another, then the var is also a sub-type." (type-checks? (&;with-var (function [[id var]] (do &;Monad<Check> [_ (&;check var Bottom)] - (&;check #;UnitT var)))))) + (&;check #;Unit var)))))) )) |