diff options
| author | Eduardo Julian | 2017-11-29 04:51:04 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2017-11-29 04:51:04 -0400 |
| commit | 8c5cca122817bc63f4f84cc8351ced3cb67e5eea (patch) | |
| tree | 8803dd3ed59ddcc6b964354fd312ab9e62e12cd8 /stdlib/source/lux/macro | |
| parent | 1ef969c8ce0f1a83ffa8d26d779806190ac3eced (diff) | |
- Changed the identifier separator, from the semi-colon (;) to the period/dot (.).
Diffstat (limited to 'stdlib/source/lux/macro')
| -rw-r--r-- | stdlib/source/lux/macro/code.lux | 110 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/poly.lux | 366 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/poly/eq.lux | 112 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/poly/functor.lux | 76 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/poly/json.lux | 250 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/syntax.lux | 214 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/syntax/common.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/syntax/common/reader.lux | 144 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/syntax/common/writer.lux | 10 |
9 files changed, 642 insertions, 642 deletions
diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux index d41dbe240..73b6bbf5a 100644 --- a/stdlib/source/lux/macro/code.lux +++ b/stdlib/source/lux/macro/code.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [eq #+ Eq]) (data bool @@ -10,16 +10,16 @@ ## [Types] ## (type: (Code' w) -## (#;Bool Bool) -## (#;Nat Nat) -## (#;Int Int) -## (#;Frac Frac) -## (#;Text Text) -## (#;Symbol Text Text) -## (#;Tag Text Text) -## (#;Form (List (w (Code' w)))) -## (#;Tuple (List (w (Code' w)))) -## (#;Record (List [(w (Code' w)) (w (Code' w))]))) +## (#.Bool Bool) +## (#.Nat Nat) +## (#.Int Int) +## (#.Frac Frac) +## (#.Text Text) +## (#.Symbol Text Text) +## (#.Tag Text Text) +## (#.Form (List (w (Code' w)))) +## (#.Tuple (List (w (Code' w)))) +## (#.Record (List [(w (Code' w)) (w (Code' w))]))) ## (type: Code ## (Ann Cursor (Code' (Ann Cursor)))) @@ -33,27 +33,27 @@ (-> <type> Code) [_cursor (<tag> x)])] - [bool Bool #;Bool] - [nat Nat #;Nat] - [int Int #;Int] - [deg Deg #;Deg] - [frac Frac #;Frac] - [text Text #;Text] - [symbol Ident #;Symbol] - [tag Ident #;Tag] - [form (List Code) #;Form] - [tuple (List Code) #;Tuple] - [record (List [Code Code]) #;Record] + [bool Bool #.Bool] + [nat Nat #.Nat] + [int Int #.Int] + [deg Deg #.Deg] + [frac Frac #.Frac] + [text Text #.Text] + [symbol Ident #.Symbol] + [tag Ident #.Tag] + [form (List Code) #.Form] + [tuple (List Code) #.Tuple] + [record (List [Code Code]) #.Record] ) (do-template [<name> <tag> <doc>] [(def: #export (<name> name) - {#;doc <doc>} + {#.doc <doc>} (-> Text Code) [_cursor (<tag> ["" name])])] - [local-symbol #;Symbol "Produces a local symbol (a symbol with no module prefix)."] - [local-tag #;Tag "Produces a local tag (a tag with no module prefix)."]) + [local-symbol #.Symbol "Produces a local symbol (a symbol with no module prefix)."] + [local-tag #.Tag "Produces a local tag (a tag with no module prefix)."]) ## [Structures] (struct: #export _ (Eq Code) @@ -62,14 +62,14 @@ (^template [<tag> <eq>] [[_ (<tag> x')] [_ (<tag> y')]] (:: <eq> = x' y')) - ([#;Bool Eq<Bool>] - [#;Nat Eq<Nat>] - [#;Int Eq<Int>] - [#;Deg Eq<Deg>] - [#;Frac Eq<Frac>] - [#;Text Eq<Text>] - [#;Symbol Eq<Ident>] - [#;Tag Eq<Ident>]) + ([#.Bool Eq<Bool>] + [#.Nat Eq<Nat>] + [#.Int Eq<Int>] + [#.Deg Eq<Deg>] + [#.Frac Eq<Frac>] + [#.Text Eq<Text>] + [#.Symbol Eq<Ident>] + [#.Tag Eq<Ident>]) (^template [<tag>] [[_ (<tag> xs')] [_ (<tag> ys')]] @@ -78,10 +78,10 @@ (and old (= x' y'))) true (zip2 xs' ys')))) - ([#;Form] - [#;Tuple]) + ([#.Form] + [#.Tuple]) - [[_ (#;Record xs')] [_ (#;Record ys')]] + [[_ (#.Record xs')] [_ (#.Record ys')]] (and (:: Eq<Nat> = (size xs') (size ys')) (fold (function [[[xl' xr'] [yl' yr']] old] (and old (= xl' yl') (= xr' yr'))) @@ -98,31 +98,31 @@ (^template [<tag> <struct>] [_ (<tag> value)] (:: <struct> encode value)) - ([#;Bool Codec<Text,Bool>] - [#;Nat Codec<Text,Nat>] - [#;Int Codec<Text,Int>] - [#;Deg Codec<Text,Deg>] - [#;Frac Codec<Text,Frac>] - [#;Symbol Codec<Text,Ident>]) + ([#.Bool Codec<Text,Bool>] + [#.Nat Codec<Text,Nat>] + [#.Int Codec<Text,Int>] + [#.Deg Codec<Text,Deg>] + [#.Frac Codec<Text,Frac>] + [#.Symbol Codec<Text,Ident>]) - [_ (#;Text value)] - (text;encode value) + [_ (#.Text value)] + (text.encode value) - [_ (#;Tag ident)] + [_ (#.Tag ident)] (Text/compose "#" (:: Codec<Text,Ident> encode ident)) (^template [<tag> <open> <close>] [_ (<tag> members)] - ($_ Text/compose <open> (|> members (map to-text) (interpose " ") (text;join-with "")) <close>)) - ([#;Form "(" ")"] - [#;Tuple "[" "]"]) + ($_ Text/compose <open> (|> members (map to-text) (interpose " ") (text.join-with "")) <close>)) + ([#.Form "(" ")"] + [#.Tuple "[" "]"]) - [_ (#;Record pairs)] - ($_ Text/compose "{" (|> pairs (map (function [[left right]] ($_ Text/compose (to-text left) " " (to-text right)))) (interpose " ") (text;join-with "")) "}") + [_ (#.Record pairs)] + ($_ Text/compose "{" (|> pairs (map (function [[left right]] ($_ Text/compose (to-text left) " " (to-text right)))) (interpose " ") (text.join-with "")) "}") )) (def: #export (replace original substitute ast) - {#;doc "Replaces all code that looks like the 'original' with the 'substitute'."} + {#.doc "Replaces all code that looks like the 'original' with the 'substitute'."} (-> Code Code Code Code) (if (:: Eq<Code> = original ast) substitute @@ -130,11 +130,11 @@ (^template [<tag>] [cursor (<tag> parts)] [cursor (<tag> (map (replace original substitute) parts))]) - ([#;Form] - [#;Tuple]) + ([#.Form] + [#.Tuple]) - [cursor (#;Record parts)] - [cursor (#;Record (map (function [[left right]] + [cursor (#.Record parts)] + [cursor (#.Record (map (function [[left right]] [(replace original substitute left) (replace original substitute right)]) parts))] diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 994c719de..05a609e1b 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -1,4 +1,4 @@ -(;module: +(.module: [lux #- function] (lux (control [monad #+ do Monad] [eq] @@ -26,121 +26,121 @@ (type: #export Env (Dict Nat [Type Code])) (type: #export (Poly a) - (p;Parser [Env (List Type)] a)) + (p.Parser [Env (List Type)] a)) -(def: #export fresh Env (dict;new number;Hash<Nat>)) +(def: #export fresh Env (dict.new number.Hash<Nat>)) (def: (run' env types poly) - (All [a] (-> Env (List Type) (Poly a) (e;Error a))) - (case (p;run [env types] poly) - (#e;Error error) - (#e;Error error) + (All [a] (-> Env (List Type) (Poly a) (e.Error a))) + (case (p.run [env types] poly) + (#e.Error error) + (#e.Error error) - (#e;Success [[env' remaining] output]) + (#e.Success [[env' remaining] output]) (case remaining - #;Nil - (#e;Success output) + #.Nil + (#e.Success output) _ - (#e;Error (|> remaining - (list/map type;to-text) - (text;join-with ", ") + (#e.Error (|> remaining + (list/map type.to-text) + (text.join-with ", ") (text/compose "Unconsumed types: ")))))) (def: #export (run type poly) - (All [a] (-> Type (Poly a) (e;Error a))) + (All [a] (-> Type (Poly a) (e.Error a))) (run' fresh (list type) poly)) (def: #export env (Poly Env) - (;function [[env inputs]] - (#e;Success [[env inputs] env]))) + (.function [[env inputs]] + (#e.Success [[env inputs] env]))) (def: (with-env temp poly) (All [a] (-> Env (Poly a) (Poly a))) - (;function [[env inputs]] - (case (p;run [temp inputs] poly) - (#e;Error error) - (#e;Error error) + (.function [[env inputs]] + (case (p.run [temp inputs] poly) + (#e.Error error) + (#e.Error error) - (#e;Success [[_ remaining] output]) - (#e;Success [[env remaining] output])))) + (#e.Success [[_ remaining] output]) + (#e.Success [[env remaining] output])))) (def: #export peek (Poly Type) - (;function [[env inputs]] + (.function [[env inputs]] (case inputs - #;Nil - (#e;Error "Empty stream of types.") + #.Nil + (#e.Error "Empty stream of types.") - (#;Cons headT tail) - (#e;Success [[env inputs] headT])))) + (#.Cons headT tail) + (#e.Success [[env inputs] headT])))) (def: #export any (Poly Type) - (;function [[env inputs]] + (.function [[env inputs]] (case inputs - #;Nil - (#e;Error "Empty stream of types.") + #.Nil + (#e.Error "Empty stream of types.") - (#;Cons headT tail) - (#e;Success [[env tail] headT])))) + (#.Cons headT tail) + (#e.Success [[env tail] headT])))) (def: #export (local types poly) (All [a] (-> (List Type) (Poly a) (Poly a))) - (;function [[env pass-through]] + (.function [[env pass-through]] (case (run' env types poly) - (#e;Error error) - (#e;Error error) + (#e.Error error) + (#e.Error error) - (#e;Success output) - (#e;Success [[env pass-through] output])))) + (#e.Success output) + (#e.Success [[env pass-through] output])))) (def: (label idx) (-> Nat Code) - (code;local-symbol (text/compose "label\u0000" (nat/encode idx)))) + (code.local-symbol (text/compose "label\u0000" (nat/encode idx)))) (def: #export (with-extension type poly) (All [a] (-> Type (Poly a) (Poly [Code a]))) - (;function [[env inputs]] - (let [current-id (dict;size env) + (.function [[env inputs]] + (let [current-id (dict.size env) g!var (label current-id)] - (case (p;run [(dict;put current-id [type g!var] env) + (case (p.run [(dict.put current-id [type g!var] env) inputs] poly) - (#e;Error error) - (#e;Error error) + (#e.Error error) + (#e.Error error) - (#e;Success [[_ inputs'] output]) - (#e;Success [[env inputs'] [g!var output]]))))) + (#e.Success [[_ inputs'] output]) + (#e.Success [[env inputs'] [g!var output]]))))) (do-template [<combinator> <name> <type>] [(def: #export <combinator> (Poly Unit) - (do p;Monad<Parser> + (do p.Monad<Parser> [headT any] - (case (type;un-name headT) + (case (type.un-name headT) <type> (wrap []) _ - (p;fail ($_ text/compose "Not " <name> " type: " (type;to-text headT))))))] - - [void "Void" #;Void] - [unit "Unit" #;Unit] - [bool "Bool" (#;Primitive "#Bool" #;Nil)] - [nat "Nat" (#;Primitive "#Nat" #;Nil)] - [int "Int" (#;Primitive "#Int" #;Nil)] - [deg "Deg" (#;Primitive "#Deg" #;Nil)] - [frac "Frac" (#;Primitive "#Frac" #;Nil)] - [text "Text" (#;Primitive "#Text" #;Nil)] + (p.fail ($_ text/compose "Not " <name> " type: " (type.to-text headT))))))] + + [void "Void" #.Void] + [unit "Unit" #.Unit] + [bool "Bool" (#.Primitive "#Bool" #.Nil)] + [nat "Nat" (#.Primitive "#Nat" #.Nil)] + [int "Int" (#.Primitive "#Int" #.Nil)] + [deg "Deg" (#.Primitive "#Deg" #.Nil)] + [frac "Frac" (#.Primitive "#Frac" #.Nil)] + [text "Text" (#.Primitive "#Text" #.Nil)] ) (def: #export basic (Poly Type) - (do p;Monad<Parser> + (do p.Monad<Parser> [headT any] - (case (run headT ($_ p;either + (case (run headT ($_ p.either void unit bool @@ -149,42 +149,42 @@ deg frac text)) - (#e;Error error) - (p;fail error) + (#e.Error error) + (p.fail error) - (#e;Success _) + (#e.Success _) (wrap headT)))) (do-template [<name> <flattener> <tag>] [(def: #export (<name> poly) (All [a] (-> (Poly a) (Poly a))) - (do p;Monad<Parser> + (do p.Monad<Parser> [headT any] - (let [members (<flattener> (type;un-name headT))] - (if (n/> +1 (list;size members)) + (let [members (<flattener> (type.un-name headT))] + (if (n/> +1 (list.size members)) (local members poly) - (p;fail ($_ text/compose "Not a " (ident/encode (ident-for <tag>)) " type: " (type;to-text headT)))))))] + (p.fail ($_ text/compose "Not a " (ident/encode (ident-for <tag>)) " type: " (type.to-text headT)))))))] - [variant type;flatten-variant #;Sum] - [tuple type;flatten-tuple #;Product] + [variant type.flatten-variant #.Sum] + [tuple type.flatten-tuple #.Product] ) (def: polymorphic' (Poly [Nat Type]) - (do p;Monad<Parser> + (do p.Monad<Parser> [headT any - #let [[num-arg bodyT] (type;flatten-univ-q (type;un-name headT))]] + #let [[num-arg bodyT] (type.flatten-univ-q (type.un-name headT))]] (if (n/= +0 num-arg) - (p;fail ($_ text/compose "Non-polymorphic type: " (type;to-text headT))) + (p.fail ($_ text/compose "Non-polymorphic type: " (type.to-text headT))) (wrap [num-arg bodyT])))) (def: #export (polymorphic poly) (All [a] (-> (Poly a) (Poly [Code (List Code) a]))) - (do p;Monad<Parser> + (do p.Monad<Parser> [headT any - funcI (:: @ map dict;size ;;env) + funcI (:: @ map dict.size ..env) [num-args non-poly] (local (list headT) polymorphic') - env ;;env + env ..env #let [funcL (label funcI) [all-varsL env'] (loop [current-arg +0 env' env @@ -194,20 +194,20 @@ (let [varL (label (n/inc funcI))] (recur (n/inc current-arg) (|> env' - (dict;put funcI [headT funcL]) - (dict;put (n/inc funcI) [(#;Bound (n/inc funcI)) varL])) - (#;Cons varL all-varsL))) + (dict.put funcI [headT funcL]) + (dict.put (n/inc funcI) [(#.Bound (n/inc funcI)) varL])) + (#.Cons varL all-varsL))) (let [partialI (|> current-arg (n/* +2) (n/+ funcI)) partial-varI (n/inc partialI) partial-varL (label partial-varI) - partialC (` ((~ funcL) (~@ (|> (list;n/range +0 (n/dec num-args)) + partialC (` ((~ funcL) (~@ (|> (list.n/range +0 (n/dec num-args)) (list/map (|>> (n/* +2) n/inc (n/+ funcI) label)) - list;reverse))))] + list.reverse))))] (recur (n/inc current-arg) (|> env' - (dict;put partialI [;Void partialC]) - (dict;put partial-varI [(#;Bound partial-varI) partial-varL])) - (#;Cons partial-varL all-varsL)))) + (dict.put partialI [.Void partialC]) + (dict.put partial-varI [(#.Bound partial-varI) partial-varL])) + (#.Cons partial-varL all-varsL)))) [all-varsL env']))]] (|> (do @ [output poly] @@ -217,243 +217,243 @@ (def: #export (function in-poly out-poly) (All [i o] (-> (Poly i) (Poly o) (Poly [i o]))) - (do p;Monad<Parser> + (do p.Monad<Parser> [headT any - #let [[inputsT outputT] (type;flatten-function (type;un-name headT))]] - (if (n/> +0 (list;size inputsT)) - (p;seq (local inputsT in-poly) + #let [[inputsT outputT] (type.flatten-function (type.un-name headT))]] + (if (n/> +0 (list.size inputsT)) + (p.seq (local inputsT in-poly) (local (list outputT) out-poly)) - (p;fail ($_ text/compose "Non-function type: " (type;to-text headT)))))) + (p.fail ($_ text/compose "Non-function type: " (type.to-text headT)))))) (def: #export (apply poly) (All [a] (-> (Poly a) (Poly a))) - (do p;Monad<Parser> + (do p.Monad<Parser> [headT any - #let [[funcT paramsT] (type;flatten-application (type;un-name headT))]] - (if (n/= +0 (list;size paramsT)) - (p;fail ($_ text/compose "Non-application type: " (type;to-text headT))) - (local (#;Cons funcT paramsT) poly)))) + #let [[funcT paramsT] (type.flatten-application (type.un-name headT))]] + (if (n/= +0 (list.size paramsT)) + (p.fail ($_ text/compose "Non-application type: " (type.to-text headT))) + (local (#.Cons funcT paramsT) poly)))) (def: #export (this expected) (-> Type (Poly Unit)) - (do p;Monad<Parser> + (do p.Monad<Parser> [actual any] - (if (check;checks? expected actual) + (if (check.checks? expected actual) (wrap []) - (p;fail ($_ text/compose + (p.fail ($_ text/compose "Types do not match." "\n" - "Expected: " (type;to-text expected) "\n" - " Actual: " (type;to-text actual)))))) + "Expected: " (type.to-text expected) "\n" + " Actual: " (type.to-text actual)))))) (def: (adjusted-idx env idx) (-> Env Nat Nat) - (let [env-level (n// +2 (dict;size env)) + (let [env-level (n// +2 (dict.size env)) bound-level (n// +2 idx) bound-idx (n/% +2 idx)] (|> env-level n/dec (n/- bound-level) (n/* +2) (n/+ bound-idx)))) (def: #export bound (Poly Code) - (do p;Monad<Parser> - [env ;;env + (do p.Monad<Parser> + [env ..env headT any] (case headT - (#;Bound idx) - (case (dict;get (adjusted-idx env idx) env) - (#;Some [poly-type poly-ast]) + (#.Bound idx) + (case (dict.get (adjusted-idx env idx) env) + (#.Some [poly-type poly-ast]) (wrap poly-ast) - #;None - (p;fail ($_ text/compose "Unknown bound type: " (type;to-text headT)))) + #.None + (p.fail ($_ text/compose "Unknown bound type: " (type.to-text headT)))) _ - (p;fail ($_ text/compose "Not a bound type: " (type;to-text headT)))))) + (p.fail ($_ text/compose "Not a bound type: " (type.to-text headT)))))) (def: #export (var id) (-> Nat (Poly Unit)) - (do p;Monad<Parser> - [env ;;env + (do p.Monad<Parser> + [env ..env headT any] (case headT - (#;Bound idx) + (#.Bound idx) (if (n/= id (adjusted-idx env idx)) (wrap []) - (p;fail ($_ text/compose "Wrong bound type.\n" + (p.fail ($_ text/compose "Wrong bound type.\n" "Expected: " (nat/encode id) "\n" " Actual: " (nat/encode idx)))) _ - (p;fail ($_ text/compose "Not a bound type: " (type;to-text headT)))))) + (p.fail ($_ text/compose "Not a bound type: " (type.to-text headT)))))) (def: #export named (Poly [Ident Type]) - (do p;Monad<Parser> + (do p.Monad<Parser> [inputT any] (case inputT - (#;Named name anonymousT) + (#.Named name anonymousT) (wrap [name anonymousT]) _ - (p;fail ($_ text/compose "Not a named type: " (type;to-text inputT)))))) + (p.fail ($_ text/compose "Not a named type: " (type.to-text inputT)))))) (def: #export (recursive poly) (All [a] (-> (Poly a) (Poly [Code a]))) - (do p;Monad<Parser> + (do p.Monad<Parser> [headT any] - (case (type;un-name headT) - (#;Apply #;Void (#;UnivQ _ headT')) + (case (type.un-name headT) + (#.Apply #.Void (#.UnivQ _ headT')) (do @ [[recT _ output] (|> poly - (with-extension #;Void) + (with-extension #.Void) (with-extension headT) (local (list headT')))] (wrap [recT output])) _ - (p;fail ($_ text/compose "Not a recursive type: " (type;to-text headT)))))) + (p.fail ($_ text/compose "Not a recursive type: " (type.to-text headT)))))) (def: #export recursive-self (Poly Code) - (do p;Monad<Parser> - [env ;;env + (do p.Monad<Parser> + [env ..env headT any] - (case (type;un-name headT) - (^multi (#;Apply #;Void (#;Bound funcT-idx)) + (case (type.un-name headT) + (^multi (#.Apply #.Void (#.Bound funcT-idx)) (n/= +0 (adjusted-idx env funcT-idx)) - [(dict;get +0 env) (#;Some [self-type self-call])]) + [(dict.get +0 env) (#.Some [self-type self-call])]) (wrap self-call) _ - (p;fail ($_ text/compose "Not a recursive type: " (type;to-text headT)))))) + (p.fail ($_ text/compose "Not a recursive type: " (type.to-text headT)))))) (def: #export recursive-call (Poly Code) - (do p;Monad<Parser> - [env ;;env - [funcT argsT] (apply (p;seq any (p;many any))) + (do p.Monad<Parser> + [env ..env + [funcT argsT] (apply (p.seq any (p.many any))) _ (local (list funcT) (var +0)) allC (let [allT (list& funcT argsT)] (|> allT - (monad;map @ (function;const bound)) + (monad.map @ (function.const bound)) (local allT)))] (wrap (` ((~@ allC)))))) (def: #export log (All [a] (Poly a)) - (do p;Monad<Parser> + (do p.Monad<Parser> [current any #let [_ (log! ($_ text/compose - "{" (ident/encode (ident-for ;;log)) "} " - (type;to-text current)))]] - (p;fail "LOGGING"))) + "{" (ident/encode (ident-for ..log)) "} " + (type.to-text current)))]] + (p.fail "LOGGING"))) ## [Syntax] -(syntax: #export (poly: [export csr;export] - [name s;local-symbol] +(syntax: #export (poly: [export csr.export] + [name s.local-symbol] body) (with-gensyms [g!type g!output] - (let [g!name (code;symbol ["" name])] - (wrap (;list (` (syntax: (~@ (csw;export export)) ((~ g!name) [(~ g!type) s;symbol]) - (do macro;Monad<Meta> - [(~ g!type) (macro;find-type-def (~ g!type))] + (let [g!name (code.symbol ["" name])] + (wrap (.list (` (syntax: (~@ (csw.export export)) ((~ g!name) [(~ g!type) s.symbol]) + (do macro.Monad<Meta> + [(~ g!type) (macro.find-type-def (~ g!type))] (case (|> (~ body) - (;function [(~ g!name)]) - p;rec - (do p;Monad<Parser> []) - (;;run (~ g!type)) - (: (;Either ;Text ;Code))) - (#;Left (~ g!output)) - (macro;fail (~ g!output)) + (.function [(~ g!name)]) + p.rec + (do p.Monad<Parser> []) + (..run (~ g!type)) + (: (.Either .Text .Code))) + (#.Left (~ g!output)) + (macro.fail (~ g!output)) - (#;Right (~ g!output)) - ((~' wrap) (;list (~ g!output)))))))))))) + (#.Right (~ g!output)) + ((~' wrap) (.list (~ g!output)))))))))))) (def: (common-poly-name? poly-func) (-> Text Bool) - (text;contains? "?" poly-func)) + (text.contains? "?" poly-func)) (def: (derivation-name poly args) (-> Text (List Text) (Maybe Text)) (if (common-poly-name? poly) - (#;Some (list/fold (text;replace-once "?") poly args)) - #;None)) + (#.Some (list/fold (text.replace-once "?") poly args)) + #.None)) -(syntax: #export (derived: [export csr;export] - [?name (p;maybe s;local-symbol)] - [[poly-func poly-args] (s;form (p;seq s;symbol (p;many s;symbol)))] - [?custom-impl (p;maybe s;any)]) +(syntax: #export (derived: [export csr.export] + [?name (p.maybe s.local-symbol)] + [[poly-func poly-args] (s.form (p.seq s.symbol (p.many s.symbol)))] + [?custom-impl (p.maybe s.any)]) (do @ - [poly-args (monad;map @ macro;normalize poly-args) + [poly-args (monad.map @ macro.normalize poly-args) name (case ?name - (#;Some name) + (#.Some name) (wrap name) - (^multi #;None - [(derivation-name (product;right poly-func) (list/map product;right poly-args)) - (#;Some derived-name)]) + (^multi #.None + [(derivation-name (product.right poly-func) (list/map product.right poly-args)) + (#.Some derived-name)]) (wrap derived-name) _ - (p;fail "derived: was given no explicit name, and cannot generate one from given information.")) + (p.fail "derived: was given no explicit name, and cannot generate one from given information.")) #let [impl (case ?custom-impl - (#;Some custom-impl) + (#.Some custom-impl) custom-impl - #;None - (` ((~ (code;symbol poly-func)) (~@ (list/map code;symbol poly-args)))))]] - (wrap (;list (` (def: (~@ (csw;export export)) - (~ (code;symbol ["" name])) - {#;struct? true} + #.None + (` ((~ (code.symbol poly-func)) (~@ (list/map code.symbol poly-args)))))]] + (wrap (.list (` (def: (~@ (csw.export export)) + (~ (code.symbol ["" name])) + {#.struct? true} (~ impl))))))) ## [Derivers] (def: #export (to-ast env type) (-> Env Type Code) (case type - (#;Primitive name params) - (` (#;Primitive (~ (code;text name)) + (#.Primitive name params) + (` (#.Primitive (~ (code.text name)) (list (~@ (list/map (to-ast env) params))))) (^template [<tag>] <tag> (` <tag>)) - ([#;Void] [#;Unit]) + ([#.Void] [#.Unit]) (^template [<tag>] (<tag> idx) - (` (<tag> (~ (code;nat idx))))) - ([#;Var] [#;Ex]) + (` (<tag> (~ (code.nat idx))))) + ([#.Var] [#.Ex]) - (#;Bound idx) + (#.Bound idx) (let [idx (adjusted-idx env idx)] (if (n/= +0 idx) - (|> (dict;get idx env) maybe;assume product;left (to-ast env)) - (` (;$ (~ (code;nat (n/dec idx))))))) + (|> (dict.get idx env) maybe.assume product.left (to-ast env)) + (` (.$ (~ (code.nat (n/dec idx))))))) - (#;Apply #;Void (#;Bound idx)) + (#.Apply #.Void (#.Bound idx)) (let [idx (adjusted-idx env idx)] (if (n/= +0 idx) - (|> (dict;get idx env) maybe;assume product;left (to-ast env)) + (|> (dict.get idx env) maybe.assume product.left (to-ast env)) (undefined))) (^template [<tag>] (<tag> left right) (` (<tag> (~ (to-ast env left)) (~ (to-ast env right))))) - ([#;Function] [#;Apply]) + ([#.Function] [#.Apply]) (^template [<tag> <macro> <flattener>] (<tag> left right) (` (<macro> (~@ (list/map (to-ast env) (<flattener> type)))))) - ([#;Sum | type;flatten-variant] - [#;Product & type;flatten-tuple]) + ([#.Sum | type.flatten-variant] + [#.Product & type.flatten-tuple]) - (#;Named name sub-type) - (code;symbol name) + (#.Named name sub-type) + (code.symbol name) (^template [<tag>] (<tag> scope body) (` (<tag> (list (~@ (list/map (to-ast env) scope))) (~ (to-ast env body))))) - ([#;UnivQ] [#;ExQ]) + ([#.UnivQ] [#.ExQ]) )) diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux index 55927e614..46feab967 100644 --- a/stdlib/source/lux/macro/poly/eq.lux +++ b/stdlib/source/lux/macro/poly/eq.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do Monad] [eq] @@ -31,13 +31,13 @@ ## [Derivers] (poly: #export Eq<?> (`` (do @ - [#let [g!_ (code;local-symbol "\u0000_")] - *env* poly;env - inputT poly;peek + [#let [g!_ (code.local-symbol "\u0000_")] + *env* poly.env + inputT poly.peek #let [@Eq (: (-> Type Code) (function [type] - (` (eq;Eq (~ (poly;to-ast *env* type))))))]] - ($_ p;either + (` (eq.Eq (~ (poly.to-ast *env* type))))))]] + ($_ p.either ## Basic types (~~ (do-template [<matcher> <eq>] [(do @ @@ -45,103 +45,103 @@ (wrap (` (: (~ (@Eq inputT)) <eq>))))] - [poly;unit (function [(~ g!_) (~ g!_)] true)] - [poly;bool bool;Eq<Bool>] - [poly;nat number;Eq<Nat>] - [poly;int number;Eq<Int>] - [poly;deg number;Eq<Deg>] - [poly;frac number;Eq<Frac>] - [poly;text text;Eq<Text>])) + [poly.unit (function [(~ g!_) (~ g!_)] true)] + [poly.bool bool.Eq<Bool>] + [poly.nat number.Eq<Nat>] + [poly.int number.Eq<Int>] + [poly.deg number.Eq<Deg>] + [poly.frac number.Eq<Frac>] + [poly.text text.Eq<Text>])) ## Composite types (~~ (do-template [<name> <eq>] [(do @ - [[_ argC] (poly;apply (p;seq (poly;this <name>) + [[_ argC] (poly.apply (p.seq (poly.this <name>) Eq<?>))] (wrap (` (: (~ (@Eq inputT)) (<eq> (~ argC))))))] - [;Maybe maybe;Eq<Maybe>] - [;List list;Eq<List>] - [sequence;Sequence sequence;Eq<Sequence>] - [;Array array;Eq<Array>] - [queue;Queue queue;Eq<Queue>] - [set;Set set;Eq<Set>] - [rose;Tree rose;Eq<Tree>] + [.Maybe maybe.Eq<Maybe>] + [.List list.Eq<List>] + [sequence.Sequence sequence.Eq<Sequence>] + [.Array array.Eq<Array>] + [queue.Queue queue.Eq<Queue>] + [set.Set set.Eq<Set>] + [rose.Tree rose.Eq<Tree>] )) (do @ - [[_ _ valC] (poly;apply ($_ p;seq - (poly;this dict;Dict) - poly;any + [[_ _ valC] (poly.apply ($_ p.seq + (poly.this dict.Dict) + poly.any Eq<?>))] (wrap (` (: (~ (@Eq inputT)) - (dict;Eq<Dict> (~ valC)))))) + (dict.Eq<Dict> (~ valC)))))) ## Models (~~ (do-template [<type> <eq>] [(do @ - [_ (poly;this <type>)] + [_ (poly.this <type>)] (wrap (` (: (~ (@Eq inputT)) <eq>))))] - [du;Duration du;Eq<Duration>] - [i;Instant i;Eq<Instant>] - [da;Date da;Eq<Date>] - [da;Day da;Eq<Day>] - [da;Month da;Eq<Month>])) + [du.Duration du.Eq<Duration>] + [i.Instant i.Eq<Instant>] + [da.Date da.Eq<Date>] + [da.Day da.Eq<Day>] + [da.Month da.Eq<Month>])) (do @ - [_ (poly;apply (p;seq (poly;this unit;Qty) - poly;any))] + [_ (poly.apply (p.seq (poly.this unit.Qty) + poly.any))] (wrap (` (: (~ (@Eq inputT)) - unit;Eq<Qty>)))) + unit.Eq<Qty>)))) ## Variants (do @ - [members (poly;variant (p;many Eq<?>)) - #let [g!left (code;local-symbol "\u0000left") - g!right (code;local-symbol "\u0000right")]] + [members (poly.variant (p.many Eq<?>)) + #let [g!left (code.local-symbol "\u0000left") + g!right (code.local-symbol "\u0000right")]] (wrap (` (: (~ (@Eq inputT)) (function [(~ g!left) (~ g!right)] (case [(~ g!left) (~ g!right)] (~@ (list/join (list/map (function [[tag g!eq]] - (list (` [((~ (code;nat tag)) (~ g!left)) - ((~ (code;nat tag)) (~ g!right))]) + (list (` [((~ (code.nat tag)) (~ g!left)) + ((~ (code.nat tag)) (~ g!right))]) (` ((~ g!eq) (~ g!left) (~ g!right))))) - (list;enumerate members)))) + (list.enumerate members)))) (~ g!_) false)))))) ## Tuples (do @ - [g!eqs (poly;tuple (p;many Eq<?>)) - #let [indices (|> (list;size g!eqs) n/dec (list;n/range +0)) - g!lefts (list/map (|>> nat/encode (text/compose "left") code;local-symbol) indices) - g!rights (list/map (|>> nat/encode (text/compose "right") code;local-symbol) indices)]] + [g!eqs (poly.tuple (p.many Eq<?>)) + #let [indices (|> (list.size g!eqs) n/dec (list.n/range +0)) + g!lefts (list/map (|>> nat/encode (text/compose "left") code.local-symbol) indices) + g!rights (list/map (|>> nat/encode (text/compose "right") code.local-symbol) indices)]] (wrap (` (: (~ (@Eq inputT)) (function [[(~@ g!lefts)] [(~@ g!rights)]] - (and (~@ (|> (list;zip3 g!eqs g!lefts g!rights) + (and (~@ (|> (list.zip3 g!eqs g!lefts g!rights) (list/map (function [[g!eq g!left g!right]] (` ((~ g!eq) (~ g!left) (~ g!right))))))))))))) ## Type recursion (do @ - [[g!self bodyC] (poly;recursive Eq<?>)] + [[g!self bodyC] (poly.recursive Eq<?>)] (wrap (` (: (~ (@Eq inputT)) - (eq;rec (;function [(~ g!self)] + (eq.rec (.function [(~ g!self)] (~ bodyC))))))) - poly;recursive-self + poly.recursive-self ## Type applications (do @ - [[funcC argsC] (poly;apply (p;seq Eq<?> (p;many Eq<?>)))] + [[funcC argsC] (poly.apply (p.seq Eq<?> (p.many Eq<?>)))] (wrap (` ((~ funcC) (~@ argsC))))) ## Bound type-vars - poly;bound + poly.bound ## Polymorphism (do @ - [[funcC varsC bodyC] (poly;polymorphic Eq<?>)] + [[funcC varsC bodyC] (poly.polymorphic Eq<?>)] (wrap (` (: (All [(~@ varsC)] - (-> (~@ (list/map (|>> (~) eq;Eq (`)) varsC)) - (eq;Eq ((~ (poly;to-ast *env* inputT)) (~@ varsC))))) + (-> (~@ (list/map (|>> (~) eq.Eq (`)) varsC)) + (eq.Eq ((~ (poly.to-ast *env* inputT)) (~@ varsC))))) (function (~ funcC) [(~@ varsC)] (~ bodyC)))))) - poly;recursive-call + poly.recursive-call ## If all else fails... - (|> poly;any - (:: @ map (|>> %type (format "Cannot create Eq for: ") p;fail)) + (|> poly.any + (:: @ map (|>> %type (format "Cannot create Eq for: ") p.fail)) (:: @ join)) )))) diff --git a/stdlib/source/lux/macro/poly/functor.lux b/stdlib/source/lux/macro/poly/functor.lux index edd3efcc2..fbd8dcd03 100644 --- a/stdlib/source/lux/macro/poly/functor.lux +++ b/stdlib/source/lux/macro/poly/functor.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do Monad] [functor] @@ -17,45 +17,45 @@ (poly: #export Functor<?> (do @ - [#let [type-funcC (code;local-symbol "\u0000type-funcC") - funcC (code;local-symbol "\u0000funcC") - inputC (code;local-symbol "\u0000inputC")] - *env* poly;env - inputT poly;peek - [polyC varsC non-functorT] (poly;local (list inputT) - (poly;polymorphic poly;any)) - #let [num-vars (list;size varsC)] + [#let [type-funcC (code.local-symbol "\u0000type-funcC") + funcC (code.local-symbol "\u0000funcC") + inputC (code.local-symbol "\u0000inputC")] + *env* poly.env + inputT poly.peek + [polyC varsC non-functorT] (poly.local (list inputT) + (poly.polymorphic poly.any)) + #let [num-vars (list.size varsC)] #let [@Functor (: (-> Type Code) (function [unwrappedT] (if (n/= +1 num-vars) - (` (functor;Functor (~ (poly;to-ast *env* unwrappedT)))) - (let [paramsC (|> num-vars n/dec list;indices (L/map (|>> %n code;local-symbol)))] + (` (functor.Functor (~ (poly.to-ast *env* unwrappedT)))) + (let [paramsC (|> num-vars n/dec list.indices (L/map (|>> %n code.local-symbol)))] (` (All [(~@ paramsC)] - (functor;Functor ((~ (poly;to-ast *env* unwrappedT)) (~@ paramsC))))))))) - Arg<?> (: (-> Code (poly;Poly Code)) + (functor.Functor ((~ (poly.to-ast *env* unwrappedT)) (~@ paramsC))))))))) + Arg<?> (: (-> Code (poly.Poly Code)) (function Arg<?> [valueC] - ($_ p;either + ($_ p.either ## Type-var - (do p;Monad<Parser> + (do p.Monad<Parser> [#let [varI (|> num-vars (n/* +2) n/dec)] - _ (poly;var varI)] + _ (poly.var varI)] (wrap (` ((~ funcC) (~ valueC))))) ## Variants (do @ [_ (wrap []) - membersC (poly;variant (p;many (Arg<?> valueC)))] + membersC (poly.variant (p.many (Arg<?> valueC)))] (wrap (` (case (~ valueC) (~@ (L/join (L/map (function [[tag memberC]] - (list (` ((~ (code;nat tag)) (~ valueC))) - (` ((~ (code;nat tag)) (~ memberC))))) - (list;enumerate membersC)))))))) + (list (` ((~ (code.nat tag)) (~ valueC))) + (` ((~ (code.nat tag)) (~ memberC))))) + (list.enumerate membersC)))))))) ## Tuples - (do p;Monad<Parser> - [pairsCC (: (poly;Poly (List [Code Code])) - (poly;tuple (loop [idx +0 + (do p.Monad<Parser> + [pairsCC (: (poly.Poly (List [Code Code])) + (poly.tuple (loop [idx +0 pairsCC (: (List [Code Code]) (list))] - (p;either (let [slotC (|> idx %n (format "\u0000slot") code;local-symbol)] + (p.either (let [slotC (|> idx %n (format "\u0000slot") code.local-symbol)] (do @ [_ (wrap []) memberC (Arg<?> slotC)] @@ -63,33 +63,33 @@ (L/compose pairsCC (list [slotC memberC]))))) (wrap pairsCC)))))] (wrap (` (case (~ valueC) - [(~@ (L/map product;left pairsCC))] - [(~@ (L/map product;right pairsCC))])))) + [(~@ (L/map product.left pairsCC))] + [(~@ (L/map product.right pairsCC))])))) ## Functions (do @ [_ (wrap []) - #let [outL (code;local-symbol "\u0000outL")] - [inT+ outC] (poly;function (p;many poly;any) + #let [outL (code.local-symbol "\u0000outL")] + [inT+ outC] (poly.function (p.many poly.any) (Arg<?> outL)) - #let [inC+ (|> (list;size inT+) n/dec - (list;n/range +0) - (L/map (|>> %n (format "\u0000inC") code;local-symbol)))]] + #let [inC+ (|> (list.size inT+) n/dec + (list.n/range +0) + (L/map (|>> %n (format "\u0000inC") code.local-symbol)))]] (wrap (` (function [(~@ inC+)] (let [(~ outL) ((~ valueC) (~@ inC+))] (~ outC)))))) ## Recursion - (do p;Monad<Parser> - [_ poly;recursive-call] + (do p.Monad<Parser> + [_ poly.recursive-call] (wrap (` ((~' map) (~ funcC) (~ valueC))))) ## Bound type-variables - (do p;Monad<Parser> - [_ poly;any] + (do p.Monad<Parser> + [_ poly.any] (wrap valueC)) )))] - [_ _ outputC] (: (poly;Poly [Code (List Code) Code]) - (p;either (poly;polymorphic + [_ _ outputC] (: (poly.Poly [Code (List Code) Code]) + (p.either (poly.polymorphic (Arg<?> inputC)) - (p;fail (format "Cannot create Functor for: " (%type inputT)))))] + (p.fail (format "Cannot create Functor for: " (%type inputT)))))] (wrap (` (: (~ (@Functor inputT)) (struct (def: ((~' map) (~ funcC) (~ inputC)) (~ outputC)))))))) diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux index d001d4839..3a5148377 100644 --- a/stdlib/source/lux/macro/poly/json.lux +++ b/stdlib/source/lux/macro/poly/json.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Codecs for values in the JSON format."} +(.module: {#.doc "Codecs for values in the JSON format."} lux (lux (control [monad #+ do Monad] [eq #+ Eq] @@ -43,42 +43,42 @@ (function [input] (non-rec (rec-encode non-rec) input))) -(def: low-mask Nat (|> +1 (bit;shift-left +32) n/dec)) -(def: high-mask Nat (|> low-mask (bit;shift-left +32))) +(def: low-mask Nat (|> +1 (bit.shift-left +32) n/dec)) +(def: high-mask Nat (|> low-mask (bit.shift-left +32))) (struct: #hidden _ (Codec JSON Nat) (def: (encode input) - (let [high (|> input (bit;and high-mask) (bit;shift-right +32)) - low (bit;and low-mask input)] - (#//;Array (sequence (|> high nat-to-int int-to-frac #//;Number) - (|> low nat-to-int int-to-frac #//;Number))))) + (let [high (|> input (bit.and high-mask) (bit.shift-right +32)) + low (bit.and low-mask input)] + (#//.Array (sequence (|> high nat-to-int int-to-frac #//.Number) + (|> low nat-to-int int-to-frac #//.Number))))) (def: (decode input) - (<| (//;run input) - (do p;Monad<Parser> - [high //;number - low //;number]) - (wrap (n/+ (|> high frac-to-int int-to-nat (bit;shift-left +32)) + (<| (//.run input) + (do p.Monad<Parser> + [high //.number + low //.number]) + (wrap (n/+ (|> high frac-to-int int-to-nat (bit.shift-left +32)) (|> low frac-to-int int-to-nat)))))) (struct: #hidden _ (Codec JSON Int) (def: encode (|>> int-to-nat (:: Codec<JSON,Nat> encode))) (def: decode - (|>> (:: Codec<JSON,Nat> decode) (:: e;Functor<Error> map nat-to-int)))) + (|>> (:: Codec<JSON,Nat> decode) (:: e.Functor<Error> map nat-to-int)))) (def: #hidden (nullable writer) - {#;doc "Builds a JSON generator for potentially inexistent values."} + {#.doc "Builds a JSON generator for potentially inexistent values."} (All [a] (-> (-> a JSON) (-> (Maybe a) JSON))) (function [elem] (case elem - #;None #//;Null - (#;Some value) (writer value)))) + #.None #//.Null + (#.Some value) (writer value)))) (struct: #hidden (Codec<JSON,Qty> carrier) - (All [unit] (-> unit (Codec JSON (unit;Qty unit)))) + (All [unit] (-> unit (Codec JSON (unit.Qty unit)))) (def: encode - (|>> unit;out (:: Codec<JSON,Int> encode))) + (|>> unit.out (:: Codec<JSON,Int> encode))) (def: decode - (|>> (:: Codec<JSON,Int> decode) (:: e;Functor<Error> map (unit;in carrier))))) + (|>> (:: Codec<JSON,Int> decode) (:: e.Functor<Error> map (unit.in carrier))))) (poly: #hidden Codec<JSON,?>//encode (with-expansions @@ -88,108 +88,108 @@ (wrap (` (: (~ (@JSON//encode inputT)) <encoder>))))] - [Unit poly;unit (function [(~ (code;symbol ["" "0"]))] #//;Null)] - [Bool poly;bool (|>> #//;Boolean)] - [Nat poly;nat (:: ;;Codec<JSON,Nat> (~' encode))] - [Int poly;int (:: ;;Codec<JSON,Int> (~' encode))] - [Frac poly;frac (|>> #//;Number)] - [Text poly;text (|>> #//;String)]) + [Unit poly.unit (function [(~ (code.symbol ["" "0"]))] #//.Null)] + [Bool poly.bool (|>> #//.Boolean)] + [Nat poly.nat (:: ..Codec<JSON,Nat> (~' encode))] + [Int poly.int (:: ..Codec<JSON,Int> (~' encode))] + [Frac poly.frac (|>> #//.Number)] + [Text poly.text (|>> #//.String)]) <time> (do-template [<type> <codec>] [(do @ - [_ (poly;this <type>)] + [_ (poly.this <type>)] (wrap (` (: (~ (@JSON//encode inputT)) - (|>> (:: <codec> (~' encode)) #//;String)))))] + (|>> (:: <codec> (~' encode)) #//.String)))))] - [du;Duration du;Codec<Text,Duration>] - [i;Instant i;Codec<Text,Instant>] - [da;Date da;Codec<Text,Date>] - [da;Day da;Codec<Text,Day>] - [da;Month da;Codec<Text,Month>])] + [du.Duration du.Codec<Text,Duration>] + [i.Instant i.Codec<Text,Instant>] + [da.Date da.Codec<Text,Date>] + [da.Day da.Codec<Text,Day>] + [da.Month da.Codec<Text,Month>])] (do @ - [*env* poly;env + [*env* poly.env #let [@JSON//encode (: (-> Type Code) (function [type] - (` (-> (~ (poly;to-ast *env* type)) //;JSON))))] - inputT poly;peek] - ($_ p;either + (` (-> (~ (poly.to-ast *env* type)) //.JSON))))] + inputT poly.peek] + ($_ p.either <basic> <time> (do @ - [unitT (poly;apply (p;after (poly;this unit;Qty) - poly;any))] + [unitT (poly.apply (p.after (poly.this unit.Qty) + poly.any))] (wrap (` (: (~ (@JSON//encode inputT)) - (:: (Codec<JSON,Qty> (:! (~ (poly;to-ast *env* unitT)) [])) (~' encode)))))) + (:: (Codec<JSON,Qty> (:! (~ (poly.to-ast *env* unitT)) [])) (~' encode)))))) (do @ - [#let [g!key (code;local-symbol "\u0000key") - g!val (code;local-symbol "\u0000val")] - [_ _ .val.] (poly;apply ($_ p;seq - (poly;this d;Dict) - poly;text + [#let [g!key (code.local-symbol "\u0000key") + g!val (code.local-symbol "\u0000val")] + [_ _ =val=] (poly.apply ($_ p.seq + (poly.this d.Dict) + poly.text Codec<JSON,?>//encode))] (wrap (` (: (~ (@JSON//encode inputT)) - (|>> d;entries - (;;_map_ (function [[(~ g!key) (~ g!val)]] - [(~ g!key) ((~ .val.) (~ g!val))])) - (d;from-list text;Hash<Text>) - #//;Object))))) + (|>> d.entries + (.._map_ (function [[(~ g!key) (~ g!val)]] + [(~ g!key) ((~ =val=) (~ g!val))])) + (d.from-list text.Hash<Text>) + #//.Object))))) (do @ - [[_ .sub.] (poly;apply ($_ p;seq - (poly;this ;Maybe) + [[_ =sub=] (poly.apply ($_ p.seq + (poly.this .Maybe) Codec<JSON,?>//encode))] (wrap (` (: (~ (@JSON//encode inputT)) - (;;nullable (~ .sub.)))))) + (..nullable (~ =sub=)))))) (do @ - [[_ .sub.] (poly;apply ($_ p;seq - (poly;this ;List) + [[_ =sub=] (poly.apply ($_ p.seq + (poly.this .List) Codec<JSON,?>//encode))] (wrap (` (: (~ (@JSON//encode inputT)) - (|>> (;;_map_ (~ .sub.)) sequence;from-list #//;Array))))) + (|>> (.._map_ (~ =sub=)) sequence.from-list #//.Array))))) (do @ - [#let [g!input (code;local-symbol "\u0000input")] - members (poly;variant (p;many Codec<JSON,?>//encode))] + [#let [g!input (code.local-symbol "\u0000input")] + members (poly.variant (p.many Codec<JSON,?>//encode))] (wrap (` (: (~ (@JSON//encode inputT)) (function [(~ g!input)] (case (~ g!input) (~@ (list/join (list/map (function [[tag g!encode]] - (list (` ((~ (code;nat tag)) (~ g!input))) - (` (//;json [(~ (code;frac (;;tag tag))) + (list (` ((~ (code.nat tag)) (~ g!input))) + (` (//.json [(~ (code.frac (..tag tag))) ((~ g!encode) (~ g!input))])))) - (list;enumerate members)))))))))) + (list.enumerate members)))))))))) (do @ - [g!encoders (poly;tuple (p;many Codec<JSON,?>//encode)) - #let [g!members (|> (list;size g!encoders) n/dec - (list;n/range +0) - (list/map (|>> nat/encode code;local-symbol)))]] + [g!encoders (poly.tuple (p.many Codec<JSON,?>//encode)) + #let [g!members (|> (list.size g!encoders) n/dec + (list.n/range +0) + (list/map (|>> nat/encode code.local-symbol)))]] (wrap (` (: (~ (@JSON//encode inputT)) (function [[(~@ g!members)]] - (//;json [(~@ (list/map (function [[g!member g!encode]] + (//.json [(~@ (list/map (function [[g!member g!encode]] (` ((~ g!encode) (~ g!member)))) - (list;zip2 g!members g!encoders)))])))))) + (list.zip2 g!members g!encoders)))])))))) ## Type recursion (do @ - [[selfC non-recC] (poly;recursive Codec<JSON,?>//encode)] + [[selfC non-recC] (poly.recursive Codec<JSON,?>//encode)] (wrap (` (: (~ (@JSON//encode inputT)) - (;;rec-encode (;function [(~ selfC)] + (..rec-encode (.function [(~ selfC)] (~ non-recC))))))) - poly;recursive-self + poly.recursive-self ## Type applications (do @ - [partsC (poly;apply (p;many Codec<JSON,?>//encode))] + [partsC (poly.apply (p.many Codec<JSON,?>//encode))] (wrap (` ((~@ partsC))))) ## Polymorphism (do @ - [[funcC varsC bodyC] (poly;polymorphic Codec<JSON,?>//encode)] + [[funcC varsC bodyC] (poly.polymorphic Codec<JSON,?>//encode)] (wrap (` (: (All [(~@ varsC)] - (-> (~@ (list/map (function [varC] (` (-> (~ varC) //;JSON))) + (-> (~@ (list/map (function [varC] (` (-> (~ varC) //.JSON))) varsC)) - (-> ((~ (poly;to-ast *env* inputT)) (~@ varsC)) - //;JSON))) + (-> ((~ (poly.to-ast *env* inputT)) (~@ varsC)) + //.JSON))) (function (~ funcC) [(~@ varsC)] (~ bodyC)))))) - poly;bound - poly;recursive-call + poly.bound + poly.recursive-call ## If all else fails... - (p;fail (text/compose "Cannot create JSON encoder for: " (type;to-text inputT))) + (p.fail (text/compose "Cannot create JSON encoder for: " (type.to-text inputT))) )))) (poly: #hidden Codec<JSON,?>//decode @@ -200,94 +200,94 @@ (wrap (` (: (~ (@JSON//decode inputT)) <decoder>))))] - [Unit poly;unit //;null] - [Bool poly;bool //;boolean] - [Nat poly;nat (p;codec ;;Codec<JSON,Nat> //;any)] - [Int poly;int (p;codec ;;Codec<JSON,Int> //;any)] - [Frac poly;frac //;number] - [Text poly;text //;string]) + [Unit poly.unit //.null] + [Bool poly.bool //.boolean] + [Nat poly.nat (p.codec ..Codec<JSON,Nat> //.any)] + [Int poly.int (p.codec ..Codec<JSON,Int> //.any)] + [Frac poly.frac //.number] + [Text poly.text //.string]) <time> (do-template [<type> <codec>] [(do @ - [_ (poly;this <type>)] + [_ (poly.this <type>)] (wrap (` (: (~ (@JSON//decode inputT)) - (p;codec <codec> //;string)))))] + (p.codec <codec> //.string)))))] - [du;Duration du;Codec<Text,Duration>] - [i;Instant i;Codec<Text,Instant>] - [da;Date da;Codec<Text,Date>] - [da;Day da;Codec<Text,Day>] - [da;Month da;Codec<Text,Month>])] + [du.Duration du.Codec<Text,Duration>] + [i.Instant i.Codec<Text,Instant>] + [da.Date da.Codec<Text,Date>] + [da.Day da.Codec<Text,Day>] + [da.Month da.Codec<Text,Month>])] (do @ - [*env* poly;env + [*env* poly.env #let [@JSON//decode (: (-> Type Code) (function [type] - (` (//;Reader (~ (poly;to-ast *env* type))))))] - inputT poly;peek] - ($_ p;either + (` (//.Reader (~ (poly.to-ast *env* type))))))] + inputT poly.peek] + ($_ p.either <basic> <time> (do @ - [unitT (poly;apply (p;after (poly;this unit;Qty) - poly;any))] + [unitT (poly.apply (p.after (poly.this unit.Qty) + poly.any))] (wrap (` (: (~ (@JSON//decode inputT)) - (p;codec (Codec<JSON,Qty> (:! (~ (poly;to-ast *env* unitT)) [])) //;any))))) + (p.codec (Codec<JSON,Qty> (:! (~ (poly.to-ast *env* unitT)) [])) //.any))))) (do @ - [[_ _ valC] (poly;apply ($_ p;seq - (poly;this d;Dict) - poly;text + [[_ _ valC] (poly.apply ($_ p.seq + (poly.this d.Dict) + poly.text Codec<JSON,?>//decode))] (wrap (` (: (~ (@JSON//decode inputT)) - (//;object (~ valC)))))) + (//.object (~ valC)))))) (do @ - [[_ subC] (poly;apply (p;seq (poly;this ;Maybe) + [[_ subC] (poly.apply (p.seq (poly.this .Maybe) Codec<JSON,?>//decode))] (wrap (` (: (~ (@JSON//decode inputT)) - (//;nullable (~ subC)))))) + (//.nullable (~ subC)))))) (do @ - [[_ subC] (poly;apply (p;seq (poly;this ;List) + [[_ subC] (poly.apply (p.seq (poly.this .List) Codec<JSON,?>//decode))] (wrap (` (: (~ (@JSON//decode inputT)) - (//;array (p;some (~ subC))))))) + (//.array (p.some (~ subC))))))) (do @ - [members (poly;variant (p;many Codec<JSON,?>//decode))] + [members (poly.variant (p.many Codec<JSON,?>//decode))] (wrap (` (: (~ (@JSON//decode inputT)) - ($_ p;alt + ($_ p.alt (~@ (list/map (function [[tag memberC]] (` (|> (~ memberC) - (p;after (//;number! (~ (code;frac (;;tag tag))))) - //;array))) - (list;enumerate members)))))))) + (p.after (//.number! (~ (code.frac (..tag tag))))) + //.array))) + (list.enumerate members)))))))) (do @ - [g!decoders (poly;tuple (p;many Codec<JSON,?>//decode))] + [g!decoders (poly.tuple (p.many Codec<JSON,?>//decode))] (wrap (` (: (~ (@JSON//decode inputT)) - (//;array ($_ p;seq (~@ g!decoders))))))) + (//.array ($_ p.seq (~@ g!decoders))))))) ## Type recursion (do @ - [[selfC bodyC] (poly;recursive Codec<JSON,?>//decode)] + [[selfC bodyC] (poly.recursive Codec<JSON,?>//decode)] (wrap (` (: (~ (@JSON//decode inputT)) - (p;rec (;function [(~ selfC)] + (p.rec (.function [(~ selfC)] (~ bodyC))))))) - poly;recursive-self + poly.recursive-self ## Type applications (do @ - [[funcC argsC] (poly;apply (p;seq Codec<JSON,?>//decode (p;many Codec<JSON,?>//decode)))] + [[funcC argsC] (poly.apply (p.seq Codec<JSON,?>//decode (p.many Codec<JSON,?>//decode)))] (wrap (` ((~ funcC) (~@ argsC))))) ## Polymorphism (do @ - [[funcC varsC bodyC] (poly;polymorphic Codec<JSON,?>//decode)] + [[funcC varsC bodyC] (poly.polymorphic Codec<JSON,?>//decode)] (wrap (` (: (All [(~@ varsC)] - (-> (~@ (list/map (|>> (~) //;Reader (`)) varsC)) - (//;Reader ((~ (poly;to-ast *env* inputT)) (~@ varsC))))) + (-> (~@ (list/map (|>> (~) //.Reader (`)) varsC)) + (//.Reader ((~ (poly.to-ast *env* inputT)) (~@ varsC))))) (function (~ funcC) [(~@ varsC)] (~ bodyC)))))) - poly;bound - poly;recursive-call + poly.bound + poly.recursive-call ## If all else fails... - (p;fail (text/compose "Cannot create JSON decoder for: " (type;to-text inputT))) + (p.fail (text/compose "Cannot create JSON decoder for: " (type.to-text inputT))) )))) (syntax: #export (Codec<JSON,?> inputT) - {#;doc (doc "A macro for automatically producing JSON codecs." + {#.doc (doc "A macro for automatically producing JSON codecs." (type: Variant (#Case0 Bool) (#Case1 Text) @@ -306,7 +306,7 @@ (derived: (Codec<JSON,?> Record)))} (with-gensyms [g!inputs] - (wrap (list (` (: (Codec //;JSON (~ inputT)) + (wrap (list (` (: (Codec //.JSON (~ inputT)) (struct (def: (~' encode) (Codec<JSON,?>//encode (~ inputT))) - (def: ((~' decode) (~ g!inputs)) (//;run (~ g!inputs) (Codec<JSON,?>//decode (~ inputT)))) + (def: ((~' decode) (~ g!inputs)) (//.run (~ g!inputs) (Codec<JSON,?>//decode (~ inputT)))) ))))))) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index bc3369f86..b18e0763f 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [macro #+ with-gensyms] (control [monad #+ do Monad] @@ -18,189 +18,189 @@ (def: (join-pairs pairs) (All [a] (-> (List [a a]) (List a))) (case pairs - #;Nil #;Nil - (#;Cons [[x y] pairs']) (list& x y (join-pairs pairs')))) + #.Nil #.Nil + (#.Cons [[x y] pairs']) (list& x y (join-pairs pairs')))) ## [Types] (type: #export Syntax - {#;doc "A Lux syntax parser."} - (p;Parser (List Code))) + {#.doc "A Lux syntax parser."} + (p.Parser (List Code))) ## [Utils] (def: (remaining-inputs asts) (-> (List Code) Text) ($_ text/compose "\nRemaining input: " - (|> asts (list/map code;to-text) (list;interpose " ") (text;join-with "")))) + (|> asts (list/map code.to-text) (list.interpose " ") (text.join-with "")))) ## [Syntaxs] (def: #export any - {#;doc "Just returns the next input without applying any logic."} + {#.doc "Just returns the next input without applying any logic."} (Syntax Code) (function [tokens] (case tokens - #;Nil (#E;Error "There are no tokens to parse!") - (#;Cons [t tokens']) (#E;Success [tokens' t])))) + #.Nil (#E.Error "There are no tokens to parse!") + (#.Cons [t tokens']) (#E.Success [tokens' t])))) (do-template [<get-name> <type> <tag> <eq> <desc>] [(def: #export <get-name> - {#;doc (code;text ($_ text/compose "Parses the next " <desc> " input Code."))} + {#.doc (code.text ($_ text/compose "Parses the next " <desc> " input Code."))} (Syntax <type>) (function [tokens] (case tokens - (#;Cons [[_ (<tag> x)] tokens']) - (#E;Success [tokens' x]) + (#.Cons [[_ (<tag> x)] tokens']) + (#E.Success [tokens' x]) _ - (#E;Error ($_ text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))] - - [ bool Bool #;Bool bool;Eq<Bool> "bool"] - [ nat Nat #;Nat number;Eq<Nat> "nat"] - [ int Int #;Int number;Eq<Int> "int"] - [ deg Deg #;Deg number;Eq<Deg> "deg"] - [ frac Frac #;Frac number;Eq<Frac> "frac"] - [ text Text #;Text text;Eq<Text> "text"] - [symbol Ident #;Symbol ident;Eq<Ident> "symbol"] - [ tag Ident #;Tag ident;Eq<Ident> "tag"] + (#E.Error ($_ text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))] + + [ bool Bool #.Bool bool.Eq<Bool> "bool"] + [ nat Nat #.Nat number.Eq<Nat> "nat"] + [ int Int #.Int number.Eq<Int> "int"] + [ deg Deg #.Deg number.Eq<Deg> "deg"] + [ frac Frac #.Frac number.Eq<Frac> "frac"] + [ text Text #.Text text.Eq<Text> "text"] + [symbol Ident #.Symbol ident.Eq<Ident> "symbol"] + [ tag Ident #.Tag ident.Eq<Ident> "tag"] ) (def: #export (this? ast) - {#;doc "Asks if the given Code is the next input."} + {#.doc "Asks if the given Code is the next input."} (-> Code (Syntax Bool)) (function [tokens] (case tokens - (#;Cons [token tokens']) + (#.Cons [token tokens']) (let [is-it? (code/= ast token) remaining (if is-it? tokens' tokens)] - (#E;Success [remaining is-it?])) + (#E.Success [remaining is-it?])) _ - (#E;Success [tokens false])))) + (#E.Success [tokens false])))) (def: #export (this ast) - {#;doc "Ensures the given Code is the next input."} + {#.doc "Ensures the given Code is the next input."} (-> Code (Syntax Unit)) (function [tokens] (case tokens - (#;Cons [token tokens']) + (#.Cons [token tokens']) (if (code/= ast token) - (#E;Success [tokens' []]) - (#E;Error ($_ text/compose "Expected a " (code;to-text ast) " but instead got " (code;to-text token) + (#E.Success [tokens' []]) + (#E.Error ($_ text/compose "Expected a " (code.to-text ast) " but instead got " (code.to-text token) (remaining-inputs tokens)))) _ - (#E;Error "There are no tokens to parse!")))) + (#E.Error "There are no tokens to parse!")))) (do-template [<name> <tag> <desc>] [(def: #export <name> - {#;doc (code;text ($_ text/compose "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))} + {#.doc (code.text ($_ text/compose "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))} (Syntax Text) (function [tokens] (case tokens - (#;Cons [[_ (<tag> ["" x])] tokens']) - (#E;Success [tokens' x]) + (#.Cons [[_ (<tag> ["" x])] tokens']) + (#E.Success [tokens' x]) _ - (#E;Error ($_ text/compose "Cannot parse local " <desc> (remaining-inputs tokens))))))] + (#E.Error ($_ text/compose "Cannot parse local " <desc> (remaining-inputs tokens))))))] - [local-symbol #;Symbol "symbol"] - [ local-tag #;Tag "tag"] + [local-symbol #.Symbol "symbol"] + [ local-tag #.Tag "tag"] ) (do-template [<name> <tag> <desc>] [(def: #export (<name> p) - {#;doc (code;text ($_ text/compose "Parse inside the contents of a " <desc> " as if they were the input Codes."))} + {#.doc (code.text ($_ text/compose "Parse inside the contents of a " <desc> " as if they were the input Codes."))} (All [a] (-> (Syntax a) (Syntax a))) (function [tokens] (case tokens - (#;Cons [[_ (<tag> members)] tokens']) + (#.Cons [[_ (<tag> members)] tokens']) (case (p members) - (#E;Success [#;Nil x]) (#E;Success [tokens' x]) - _ (#E;Error ($_ text/compose "Syntax was expected to fully consume " <desc> (remaining-inputs tokens)))) + (#E.Success [#.Nil x]) (#E.Success [tokens' x]) + _ (#E.Error ($_ text/compose "Syntax was expected to fully consume " <desc> (remaining-inputs tokens)))) _ - (#E;Error ($_ text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))] + (#E.Error ($_ text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))] - [ form #;Form "form"] - [tuple #;Tuple "tuple"] + [ form #.Form "form"] + [tuple #.Tuple "tuple"] ) (def: #export (record p) - {#;doc (code;text ($_ text/compose "Parse inside the contents of a record as if they were the input Codes."))} + {#.doc (code.text ($_ text/compose "Parse inside the contents of a record as if they were the input Codes."))} (All [a] (-> (Syntax a) (Syntax a))) (function [tokens] (case tokens - (#;Cons [[_ (#;Record pairs)] tokens']) + (#.Cons [[_ (#.Record pairs)] tokens']) (case (p (join-pairs pairs)) - (#E;Success [#;Nil x]) (#E;Success [tokens' x]) - _ (#E;Error ($_ text/compose "Syntax was expected to fully consume record" (remaining-inputs tokens)))) + (#E.Success [#.Nil x]) (#E.Success [tokens' x]) + _ (#E.Error ($_ text/compose "Syntax was expected to fully consume record" (remaining-inputs tokens)))) _ - (#E;Error ($_ text/compose "Cannot parse record" (remaining-inputs tokens)))))) + (#E.Error ($_ text/compose "Cannot parse record" (remaining-inputs tokens)))))) (def: #export end! - {#;doc "Ensures there are no more inputs."} + {#.doc "Ensures there are no more inputs."} (Syntax Unit) (function [tokens] (case tokens - #;Nil (#E;Success [tokens []]) - _ (#E;Error ($_ text/compose "Expected list of tokens to be empty!" (remaining-inputs tokens)))))) + #.Nil (#E.Success [tokens []]) + _ (#E.Error ($_ text/compose "Expected list of tokens to be empty!" (remaining-inputs tokens)))))) (def: #export end? - {#;doc "Checks whether there are no more inputs."} + {#.doc "Checks whether there are no more inputs."} (Syntax Bool) (function [tokens] (case tokens - #;Nil (#E;Success [tokens true]) - _ (#E;Success [tokens false])))) + #.Nil (#E.Success [tokens true]) + _ (#E.Success [tokens false])))) (def: #export (on compiler action) - {#;doc "Run a Lux operation as if it was a Syntax parser."} + {#.doc "Run a Lux operation as if it was a Syntax parser."} (All [a] (-> Compiler (Meta a) (Syntax a))) (function [input] - (case (macro;run compiler action) - (#E;Error error) - (#E;Error error) + (case (macro.run compiler action) + (#E.Error error) + (#E.Error error) - (#E;Success value) - (#E;Success [input value]) + (#E.Success value) + (#E.Success [input value]) ))) (def: #export (run inputs syntax) - (All [a] (-> (List Code) (Syntax a) (E;Error a))) + (All [a] (-> (List Code) (Syntax a) (E.Error a))) (case (syntax inputs) - (#E;Error error) - (#E;Error error) + (#E.Error error) + (#E.Error error) - (#E;Success [unconsumed value]) + (#E.Success [unconsumed value]) (case unconsumed - #;Nil - (#E;Success value) + #.Nil + (#E.Success value) _ - (#E;Error (text/compose "Unconsumed inputs: " - (|> (list/map code;to-text unconsumed) - (text;join-with ", "))))))) + (#E.Error (text/compose "Unconsumed inputs: " + (|> (list/map code.to-text unconsumed) + (text.join-with ", "))))))) (def: #export (local inputs syntax) - {#;doc "Run a syntax parser with the given list of inputs, instead of the real ones."} + {#.doc "Run a syntax parser with the given list of inputs, instead of the real ones."} (All [a] (-> (List Code) (Syntax a) (Syntax a))) (function [real] - (do E;Monad<Error> + (do E.Monad<Error> [value (run inputs syntax)] (wrap [real value])))) ## [Syntax] -(def: #hidden text.join-with text;join-with) +(def: #hidden text/join-with text.join-with) -(def: #hidden _run_ p;run) -(def: #hidden _Monad<Parser>_ p;Monad<Parser>) +(def: #hidden _run_ p.run) +(def: #hidden _Monad<Parser>_ p.Monad<Parser>) (macro: #export (syntax: tokens) - {#;doc (doc "A more advanced way to define macros than macro:." + {#.doc (doc "A more advanced way to define macros than macro:." "The inputs to the macro can be parsed in complex ways through the use of syntax parsers." "The macro body is also (implicitly) run in the Monad<Meta>, to save some typing." "Also, the compiler state can be accessed through the *compiler* binding." @@ -211,76 +211,76 @@ [constructor-args (constructor-args^ imports class-vars)] [methods (some (overriden-method-def^ imports))]) (let [def-code ($_ text/compose "anon-class:" - (spaced (list (super-class-decl$ (maybe;default object-super-class super)) + (spaced (list (super-class-decl$ (maybe.default object-super-class super)) (with-brackets (spaced (list/map super-class-decl$ interfaces))) (with-brackets (spaced (list/map constructor-arg$ constructor-args))) (with-brackets (spaced (list/map (method-def$ id) methods))))))] - (wrap (list (` ((~ (code;text def-code)))))))))} + (wrap (list (` ((~ (code.text def-code)))))))))} (let [[exported? tokens] (: [(Maybe (Either Unit Unit)) (List Code)] (case tokens - (^ (list& [_ (#;Tag ["" "hidden"])] tokens')) - [(#;Some #;Left) tokens'] + (^ (list& [_ (#.Tag ["" "hidden"])] tokens')) + [(#.Some #.Left) tokens'] - (^ (list& [_ (#;Tag ["" "export"])] tokens')) - [(#;Some #;Right) tokens'] + (^ (list& [_ (#.Tag ["" "export"])] tokens')) + [(#.Some #.Right) tokens'] _ - [#;None tokens])) + [#.None tokens])) ?parts (: (Maybe [Text (List Code) Code Code]) (case tokens - (^ (list [_ (#;Form (list& [_ (#;Symbol ["" name])] args))] + (^ (list [_ (#.Form (list& [_ (#.Symbol ["" name])] args))] body)) - (#;Some name args (` {}) body) + (#.Some name args (` {}) body) - (^ (list [_ (#;Form (list& [_ (#;Symbol ["" name])] args))] + (^ (list [_ (#.Form (list& [_ (#.Symbol ["" name])] args))] meta-data body)) - (#;Some name args meta-data body) + (#.Some name args meta-data body) _ - #;None))] + #.None))] (case ?parts - (#;Some [name args meta body]) + (#.Some [name args meta body]) (with-gensyms [g!tokens g!body g!msg] - (do macro;Monad<Meta> - [vars+parsers (monad;map @ + (do macro.Monad<Meta> + [vars+parsers (monad.map @ (: (-> Code (Meta [Code Code])) (function [arg] (case arg - (^ [_ (#;Tuple (list var parser))]) + (^ [_ (#.Tuple (list var parser))]) (wrap [var parser]) - [_ (#;Symbol var-name)] - (wrap [(code;symbol var-name) (` any)]) + [_ (#.Symbol var-name)] + (wrap [(code.symbol var-name) (` any)]) _ - (macro;fail "Syntax pattern expects tuples or symbols.")))) + (macro.fail "Syntax pattern expects tuples or symbols.")))) args) - #let [g!state (code;symbol ["" "*compiler*"]) - error-msg (code;text (text/compose "Wrong syntax for " name)) + #let [g!state (code.symbol ["" "*compiler*"]) + error-msg (code.text (text/compose "Wrong syntax for " name)) export-ast (: (List Code) (case exported? - (#;Some #;Left) + (#.Some #.Left) (list (' #hidden)) - (#;Some #;Right) + (#.Some #.Right) (list (' #export)) _ (list)))]] - (wrap (list (` (macro: (~@ export-ast) ((~ (code;symbol ["" name])) (~ g!tokens) (~ g!state)) + (wrap (list (` (macro: (~@ export-ast) ((~ (code.symbol ["" name])) (~ g!tokens) (~ g!state)) (~ meta) - ("lux case" (;;run (~ g!tokens) + ("lux case" (..run (~ g!tokens) (: (Syntax (Meta (List Code))) - (do ;;_Monad<Parser>_ + (do .._Monad<Parser>_ [(~@ (join-pairs vars+parsers))] - ((~' wrap) (do macro;Monad<Meta> + ((~' wrap) (do macro.Monad<Meta> [] (~ body)))))) - {(#E;Success (~ g!body)) + {(#E.Success (~ g!body)) ((~ g!body) (~ g!state)) - (#E;Error (~ g!msg)) - (#E;Error (text.join-with ": " (list (~ error-msg) (~ g!msg))))}))))))) + (#E.Error (~ g!msg)) + (#E.Error (text/join-with ": " (list (~ error-msg) (~ g!msg))))}))))))) _ - (macro;fail "Wrong syntax for syntax:")))) + (macro.fail "Wrong syntax for syntax:")))) diff --git a/stdlib/source/lux/macro/syntax/common.lux b/stdlib/source/lux/macro/syntax/common.lux index 72e52a4ab..8c684537e 100644 --- a/stdlib/source/lux/macro/syntax/common.lux +++ b/stdlib/source/lux/macro/syntax/common.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Commons syntax readers and writers. +(.module: {#.doc "Commons syntax readers and writers. The goal is to be able to reuse common syntax in macro definitions across libraries."} lux) diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux index 7759a7561..ac6d876c3 100644 --- a/stdlib/source/lux/macro/syntax/common/reader.lux +++ b/stdlib/source/lux/macro/syntax/common/reader.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Commons syntax readers."} +(.module: {#.doc "Commons syntax readers."} lux (lux (control monad ["p" parser]) @@ -12,139 +12,139 @@ ## Exports (def: #export export - {#;doc (doc "A reader for export levels." + {#.doc (doc "A reader for export levels." "Such as:" #export #hidden)} (Syntax (Maybe Export)) - (p;maybe (p;alt (s;this (' #export)) - (s;this (' #hidden))))) + (p.maybe (p.alt (s.this (' #export)) + (s.this (' #hidden))))) ## Declarations (def: #export declaration - {#;doc (doc "A reader for declaration syntax." + {#.doc (doc "A reader for declaration syntax." "Such as:" quux (foo bar baz))} (Syntax Declaration) - (p;either (p;seq s;local-symbol - (:: p;Monad<Parser> wrap (list))) - (s;form (p;seq s;local-symbol - (p;many s;local-symbol))))) + (p.either (p.seq s.local-symbol + (:: p.Monad<Parser> wrap (list))) + (s.form (p.seq s.local-symbol + (p.many s.local-symbol))))) ## Annotations (def: #export annotations - {#;doc "Reader for the common annotations syntax used by def: statements."} + {#.doc "Reader for the common annotations syntax used by def: statements."} (Syntax Annotations) - (s;record (p;some (p;seq s;tag s;any)))) + (s.record (p.some (p.seq s.tag s.any)))) ## Definitions (def: check^ (Syntax [(Maybe Code) Code]) - (p;either (s;form (do p;Monad<Parser> - [_ (s;this (' "lux check")) - type s;any - value s;any] - (wrap [(#;Some type) value]))) - (p;seq (:: p;Monad<Parser> wrap #;None) - s;any))) + (p.either (s.form (do p.Monad<Parser> + [_ (s.this (' "lux check")) + type s.any + value s.any] + (wrap [(#.Some type) value]))) + (p.seq (:: p.Monad<Parser> wrap #.None) + s.any))) (def: _definition-anns-tag^ (Syntax Ident) - (s;tuple (p;seq s;text s;text))) + (s.tuple (p.seq s.text s.text))) (def: (_definition-anns^ _) (-> Top (Syntax Annotations)) - (p;alt (s;this (' #lux;Nil)) - (s;form (do p;Monad<Parser> - [_ (s;this (' #lux;Cons)) - [head tail] (p;seq (s;tuple (p;seq _definition-anns-tag^ s;any)) + (p.alt (s.this (' #.Nil)) + (s.form (do p.Monad<Parser> + [_ (s.this (' #.Cons)) + [head tail] (p.seq (s.tuple (p.seq _definition-anns-tag^ s.any)) (_definition-anns^ []))] (wrap [head tail]))) )) (def: (flat-list^ _) (-> Top (Syntax (List Code))) - (p;either (do p;Monad<Parser> - [_ (s;this (' #lux;Nil))] + (p.either (do p.Monad<Parser> + [_ (s.this (' #.Nil))] (wrap (list))) - (s;form (do p;Monad<Parser> - [_ (s;this (' #lux;Cons)) - [head tail] (s;tuple (p;seq s;any s;any)) - tail (s;local (list tail) (flat-list^ []))] - (wrap (#;Cons head tail)))))) + (s.form (do p.Monad<Parser> + [_ (s.this (' #.Cons)) + [head tail] (s.tuple (p.seq s.any s.any)) + tail (s.local (list tail) (flat-list^ []))] + (wrap (#.Cons head tail)))))) (do-template [<name> <type> <tag> <then>] [(def: <name> (Syntax <type>) - (<| s;tuple - (p;after s;any) - s;form - (do p;Monad<Parser> - [_ (s;this (' <tag>))] + (<| s.tuple + (p.after s.any) + s.form + (do p.Monad<Parser> + [_ (s.this (' <tag>))] <then>)))] - [tuple-meta^ (List Code) #lux;Tuple (flat-list^ [])] - [text-meta^ Text #lux;Text s;text] + [tuple-meta^ (List Code) #.Tuple (flat-list^ [])] + [text-meta^ Text #.Text s.text] ) (def: (find-definition-args meta-data) (-> (List [Ident Code]) (List Text)) - (<| (maybe;default (list)) - (case (list;find (|>> product;left (ident/= ["lux" "func-args"])) meta-data) - (^multi (#;Some [_ value]) - [(p;run (list value) tuple-meta^) - (#;Right [_ args])] - [(p;run args (p;some text-meta^)) - (#;Right [_ args])]) - (#;Some args) + (<| (maybe.default (list)) + (case (list.find (|>> product.left (ident/= ["lux" "func-args"])) meta-data) + (^multi (#.Some [_ value]) + [(p.run (list value) tuple-meta^) + (#.Right [_ args])] + [(p.run args (p.some text-meta^)) + (#.Right [_ args])]) + (#.Some args) _ - #;None) + #.None) )) (def: #export (definition compiler) - {#;doc "A reader that first macro-expands and then analyses the input Code, to ensure it's a definition."} + {#.doc "A reader that first macro-expands and then analyses the input Code, to ensure it's a definition."} (-> Compiler (Syntax Definition)) - (do p;Monad<Parser> - [definition-raw s;any - me-definition-raw (s;on compiler - (macro;expand-all definition-raw))] - (s;local me-definition-raw - (s;form (do @ - [_ (s;this (' "lux def")) - definition-name s;local-symbol + (do p.Monad<Parser> + [definition-raw s.any + me-definition-raw (s.on compiler + (macro.expand-all definition-raw))] + (s.local me-definition-raw + (s.form (do @ + [_ (s.this (' "lux def")) + definition-name s.local-symbol [?definition-type definition-value] check^ - definition-anns s;any - definition-anns (s;local (list definition-anns) + definition-anns s.any + definition-anns (s.local (list definition-anns) (_definition-anns^ [])) #let [definition-args (find-definition-args definition-anns)]] - (wrap {#//;definition-name definition-name - #//;definition-type ?definition-type - #//;definition-anns definition-anns - #//;definition-value definition-value - #//;definition-args definition-args})))))) + (wrap {#//.definition-name definition-name + #//.definition-type ?definition-type + #//.definition-anns definition-anns + #//.definition-value definition-value + #//.definition-args definition-args})))))) (def: #export (typed-definition compiler) - {#;doc "A reader for definitions that ensures the input syntax is typed."} + {#.doc "A reader for definitions that ensures the input syntax is typed."} (-> Compiler (Syntax Definition)) - (do p;Monad<Parser> + (do p.Monad<Parser> [_definition (definition compiler) - _ (case (get@ #//;definition-type _definition) - (#;Some _) + _ (case (get@ #//.definition-type _definition) + (#.Some _) (wrap []) - #;None - (p;fail "Typed definition must have a type!") + #.None + (p.fail "Typed definition must have a type!") )] (wrap _definition))) (def: #export typed-input - {#;doc "Reader for the common typed-argument syntax used by many macros."} + {#.doc "Reader for the common typed-argument syntax used by many macros."} (Syntax [Text Code]) - (s;tuple (p;seq s;local-symbol s;any))) + (s.tuple (p.seq s.local-symbol s.any))) (def: #export type-variables - {#;doc "Reader for the common type var/param used by many macros."} + {#.doc "Reader for the common type var/param used by many macros."} (Syntax (List Text)) - (s;tuple (p;some s;local-symbol))) + (s.tuple (p.some s.local-symbol))) diff --git a/stdlib/source/lux/macro/syntax/common/writer.lux b/stdlib/source/lux/macro/syntax/common/writer.lux index 1a75e7309..d5ad8cb61 100644 --- a/stdlib/source/lux/macro/syntax/common/writer.lux +++ b/stdlib/source/lux/macro/syntax/common/writer.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Commons syntax writers."} +(.module: {#.doc "Commons syntax writers."} lux (lux (data (coll [list "L/" Functor<List>]) [product]) @@ -9,16 +9,16 @@ (def: #export (export ?el) (-> (Maybe Export) (List Code)) (case ?el - #;None + #.None (list) - (#;Some #//;Exported) + (#.Some #//.Exported) (list (' #export)) - (#;Some #//;Hidden) + (#.Some #//.Hidden) (list (' #hidden)))) ## Annotations (def: #export (annotations anns) (-> Annotations Code) - (|> anns (L/map (product;both code;tag id)) code;record)) + (|> anns (L/map (product.both code.tag id)) code.record)) |