diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/macro/poly.lux | 51 |
1 files changed, 25 insertions, 26 deletions
diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index be33751cc..02ffb21fb 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -1,7 +1,7 @@ (.module: [lux (#- function) [control - ["." monad (#+ do Monad)] + ["." monad (#+ Monad do)] [equivalence] ["p" parser] ["ex" exception (#+ exception:)]] @@ -10,23 +10,24 @@ ["." product] ["." bit] ["." maybe] - [name ("name/." Codec<Text,Name>)] + [name ("name/." codec)] ["." error (#+ Error)] - ["." number (#+ hex) ("nat/." Codec<Text,Nat>)] - ["." text ("text/." Monoid<Text>) + ["." number (#+ hex) + ["." nat ("nat/." decimal)]] + ["." text ("text/." monoid) format] [collection - ["." list ("list/." Fold<List> Monad<List> Monoid<List>)] + ["." list ("list/." fold monad monoid)] ["dict" dictionary (#+ Dictionary)]]] ["." macro (#+ with-gensyms) ["." code] - ["s" syntax (#+ syntax: Syntax)] + ["s" syntax (#+ Syntax syntax:)] [syntax ["cs" common] [common ["csr" reader] ["csw" writer]]]] - ["." type ("type/." Equivalence<Type>) + ["." type ("type/." equivalence) ["." check]]]) (do-template [<name>] @@ -64,7 +65,7 @@ (type: #export (Poly a) (p.Parser [Env (List Type)] a)) -(def: #export fresh Env (dict.new number.Hash<Nat>)) +(def: #export fresh Env (dict.new nat.hash)) (def: (run' env types poly) (All [a] (-> Env (List Type) (Poly a) (Error a))) @@ -150,7 +151,7 @@ (do-template [<name> <flattener> <tag> <exception>] [(def: #export (<name> poly) (All [a] (-> (Poly a) (Poly a))) - (do p.Monad<Parser> + (do p.monad [headT any] (let [members (<flattener> (type.un-name headT))] (if (n/> 1 (list.size members)) @@ -163,7 +164,7 @@ (def: polymorphic' (Poly [Nat Type]) - (do p.Monad<Parser> + (do p.monad [headT any #let [[num-arg bodyT] (type.flatten-univ-q (type.un-name headT))]] (if (n/= 0 num-arg) @@ -172,7 +173,7 @@ (def: #export (polymorphic poly) (All [a] (-> (Poly a) (Poly [Code (List Code) a]))) - (do p.Monad<Parser> + (do p.monad [headT any funcI (:: @ map dict.size ..env) [num-args non-poly] (local (list headT) polymorphic') @@ -209,7 +210,7 @@ (def: #export (function in-poly out-poly) (All [i o] (-> (Poly i) (Poly o) (Poly [i o]))) - (do p.Monad<Parser> + (do p.monad [headT any #let [[inputsT outputT] (type.flatten-function (type.un-name headT))]] (if (n/> 0 (list.size inputsT)) @@ -219,7 +220,7 @@ (def: #export (apply poly) (All [a] (-> (Poly a) (Poly a))) - (do p.Monad<Parser> + (do p.monad [headT any #let [[funcT paramsT] (type.flatten-application (type.un-name headT))]] (if (n/= 0 (list.size paramsT)) @@ -229,7 +230,7 @@ (do-template [<name> <test>] [(def: #export (<name> expected) (-> Type (Poly Any)) - (do p.Monad<Parser> + (do p.monad [actual any] (if (<test> expected actual) (wrap []) @@ -249,7 +250,7 @@ (def: #export parameter (Poly Code) - (do p.Monad<Parser> + (do p.monad [env ..env headT any] (case headT @@ -266,7 +267,7 @@ (def: #export (parameter! id) (-> Nat (Poly Any)) - (do p.Monad<Parser> + (do p.monad [env ..env headT any] (case headT @@ -280,7 +281,7 @@ (def: #export existential (Poly Nat) - (do p.Monad<Parser> + (do p.monad [headT any] (case headT (#.Ex ex-id) @@ -291,7 +292,7 @@ (def: #export named (Poly [Name Type]) - (do p.Monad<Parser> + (do p.monad [inputT any] (case inputT (#.Named name anonymousT) @@ -302,7 +303,7 @@ (def: #export (recursive poly) (All [a] (-> (Poly a) (Poly [Code a]))) - (do p.Monad<Parser> + (do p.monad [headT any] (case (type.un-name headT) (#.Apply (#.Named ["lux" "Nothing"] _) (#.UnivQ _ headT')) @@ -318,7 +319,7 @@ (def: #export recursive-self (Poly Code) - (do p.Monad<Parser> + (do p.monad [env ..env headT any] (case (type.un-name headT) @@ -332,7 +333,7 @@ (def: #export recursive-call (Poly Code) - (do p.Monad<Parser> + (do p.monad [env ..env [funcT argsT] (apply (p.and any (p.many any))) _ (local (list funcT) (..parameter! 0)) @@ -344,26 +345,25 @@ (def: #export log (All [a] (Poly a)) - (do p.Monad<Parser> + (do p.monad [current any #let [_ (log! ($_ text/compose "{" (name/encode (name-of ..log)) "} " (%type current)))]] (p.fail "LOGGING"))) -## [Syntax] (syntax: #export (poly: {export csr.export} {name s.local-identifier} body) (with-gensyms [g!_ g!type g!output] (let [g!name (code.identifier ["" name])] (wrap (.list (` (syntax: (~+ (csw.export export)) ((~ g!name) {(~ g!type) s.identifier}) - (do macro.Monad<Meta> + (do macro.monad [(~ g!type) (macro.find-type-def (~ g!type))] (case (|> (~ body) (.function ((~ g!_) (~ g!name))) p.rec - (do p.Monad<Parser> []) + (do p.monad []) (..run (~ g!type)) (: (.Either .Text .Code))) (#.Left (~ g!output)) @@ -410,7 +410,6 @@ {#.struct? #1} (~ impl))))))) -## [Derivers] (def: #export (to-code env type) (-> Env Type Code) (case type |