diff options
Diffstat (limited to 'stdlib/source/lux/type.lux')
| -rw-r--r-- | stdlib/source/lux/type.lux | 78 |
1 files changed, 40 insertions, 38 deletions
diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux index 031e5025d..31de534eb 100644 --- a/stdlib/source/lux/type.lux +++ b/stdlib/source/lux/type.lux @@ -4,16 +4,17 @@ [equivalence (#+ Equivalence)] [monad (#+ Monad do)]] [control - ["p" parser]] + ["p" parser] + ["." function]] [data - ["." text ("#;." monoid equivalence)] - ["." name ("#;." equivalence codec)] + ["." text ("#@." monoid equivalence)] + ["." name ("#@." equivalence codec)] [number - ["." nat ("#;." decimal)]] + ["." nat ("#@." decimal)]] ["." maybe] [collection ["." array] - ["." list ("#;." functor monoid fold)]]] + ["." list ("#@." functor monoid fold)]]] ["." macro ["." code] ["s" syntax (#+ Syntax syntax:)]]]) @@ -22,7 +23,7 @@ (-> (List Type) Type Type) (case type (#.Primitive name params) - (#.Primitive name (list;map (beta-reduce env) params)) + (#.Primitive name (list@map (beta-reduce env) params)) (^template [<tag>] (<tag> left right) @@ -37,12 +38,12 @@ (<tag> env def) _ - (<tag> (list;map (beta-reduce env) old-env) def))) + (<tag> (list@map (beta-reduce env) old-env) def))) ([#.UnivQ] [#.ExQ]) (#.Parameter idx) - (maybe.default (error! (text;compose "Unknown type var: " (nat;encode idx))) + (maybe.default (error! (text@compose "Unknown type var: " (nat@encode idx))) (list.nth idx env)) _ @@ -53,9 +54,9 @@ (def: (= x y) (case [x y] [(#.Primitive xname xparams) (#.Primitive yname yparams)] - (and (text;= xname yname) + (and (text@= xname yname) (n/= (list.size yparams) (list.size xparams)) - (list;fold (.function (_ [x y] prev) (and prev (= x y))) + (list@fold (.function (_ [x y] prev) (and prev (= x y))) #1 (list.zip2 xparams yparams))) @@ -70,7 +71,7 @@ (= xright yright)) [(#.Named xname xtype) (#.Named yname ytype)] - (and (name;= xname yname) + (and (name@= xname yname) (= xtype ytype)) (^template [<tag>] @@ -82,7 +83,7 @@ [(#.ExQ xenv xbody) (#.ExQ yenv ybody)]) (and (n/= (list.size yenv) (list.size xenv)) (= xbody ybody) - (list;fold (.function (_ [x y] prev) (and prev (= x y))) + (list@fold (.function (_ [x y] prev) (and prev (= x y))) #1 (list.zip2 xenv yenv))) @@ -121,7 +122,7 @@ (case type (#.Apply arg func') (let [[func args] (flatten-application func')] - [func (list;compose args (list arg))]) + [func (list@compose args (list arg))]) _ [type (list)])) @@ -169,7 +170,7 @@ (case type (#.Primitive name params) (` (#.Primitive (~ (code.text name)) - (.list (~+ (list;map to-code params))))) + (.list (~+ (list@map to-code params))))) (^template [<tag>] (<tag> idx) @@ -187,7 +188,7 @@ (^template [<tag>] (<tag> env body) - (` (<tag> (.list (~+ (list;map to-code env))) + (` (<tag> (.list (~+ (list@map to-code env))) (~ (to-code body))))) ([#.UnivQ] [#.ExQ]) )) @@ -196,56 +197,57 @@ (-> Type Text) (case type (#.Primitive name params) - (case params - #.Nil - ($_ text;compose "(primitive " name ")") - - _ - ($_ text;compose "(primitive " name " " (|> params (list;map to-text) list.reverse (list.interpose " ") (list;fold text;compose "")) ")")) + ($_ text@compose + "(primitive " + (text.enclose' text.double-quote name) + (|> params + (list@map (|>> to-text (text@compose " "))) + (list@fold (function.flip text@compose) "")) + ")") (^template [<tag> <open> <close> <flatten>] (<tag> _) - ($_ text;compose <open> + ($_ text@compose <open> (|> (<flatten> type) - (list;map to-text) + (list@map to-text) list.reverse (list.interpose " ") - (list;fold text;compose "")) + (list@fold text@compose "")) <close>)) ([#.Sum "(| " ")" flatten-variant] [#.Product "[" "]" flatten-tuple]) (#.Function input output) (let [[ins out] (flatten-function type)] - ($_ text;compose "(-> " + ($_ text@compose "(-> " (|> ins - (list;map to-text) + (list@map to-text) list.reverse (list.interpose " ") - (list;fold text;compose "")) + (list@fold text@compose "")) " " (to-text out) ")")) (#.Parameter idx) - (nat;encode idx) + (nat@encode idx) (#.Var id) - ($_ text;compose "⌈v:" (nat;encode id) "⌋") + ($_ text@compose "⌈v:" (nat@encode id) "⌋") (#.Ex id) - ($_ text;compose "⟨e:" (nat;encode id) "⟩") + ($_ text@compose "⟨e:" (nat@encode id) "⟩") (#.Apply param fun) (let [[type-func type-args] (flatten-application type)] - ($_ text;compose "(" (to-text type-func) " " (|> type-args (list;map to-text) list.reverse (list.interpose " ") (list;fold text;compose "")) ")")) + ($_ text@compose "(" (to-text type-func) " " (|> type-args (list@map to-text) list.reverse (list.interpose " ") (list@fold text@compose "")) ")")) (^template [<tag> <desc>] (<tag> env body) - ($_ text;compose "(" <desc> " {" (|> env (list;map to-text) (text.join-with " ")) "} " (to-text body) ")")) + ($_ text@compose "(" <desc> " {" (|> env (list@map to-text) (text.join-with " ")) "} " (to-text body) ")")) ([#.UnivQ "All"] [#.ExQ "Ex"]) (#.Named [module name] type) - ($_ text;compose module "." name) + ($_ text@compose module "." name) )) (def: #export (un-alias type) @@ -343,9 +345,9 @@ (do @ [cursor macro.cursor valueT (macro.find-type valueN) - #let [_ (log! ($_ text;compose + #let [_ (log! ($_ text@compose ":log!" " @ " (.cursor-description cursor) text.new-line - (name;encode valueN) " : " (..to-text valueT) text.new-line))]] + (name@encode valueN) " : " (..to-text valueT) text.new-line))]] (wrap (list (code.identifier valueN)))) (#.Right valueC) @@ -361,7 +363,7 @@ input output {value (p.maybe s.any)}) - (let [casterC (` (: (All [(~+ (list;map code.local-identifier type-vars))] + (let [casterC (` (: (All [(~+ (list@map code.local-identifier type-vars))] (-> (~ input) (~ output))) (|>> :assume)))] (case value @@ -384,7 +386,7 @@ {exemplar typed} {computation typed}) (macro.with-gensyms [g!_] - (let [shareC (` (: (All [(~+ (list;map code.local-identifier type-vars))] + (let [shareC (` (: (All [(~+ (list@map code.local-identifier type-vars))] (-> (~ (get@ #type exemplar)) (~ (get@ #type computation)))) (.function ((~ g!_) (~ g!_)) @@ -395,7 +397,7 @@ (syntax: #export (:by-example {type-vars type-parameters} {exemplar typed} {extraction s.any}) - (wrap (list (` (:of (:share [(~+ (list;map code.local-identifier type-vars))] + (wrap (list (` (:of (:share [(~+ (list@map code.local-identifier type-vars))] {(~ (get@ #type exemplar)) (~ (get@ #expression exemplar))} {(~ extraction) |