diff options
Diffstat (limited to '')
| -rw-r--r-- | luxc/src/lux/analyser.clj | 2 | ||||
| -rw-r--r-- | luxc/src/lux/analyser/lux.clj | 6 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser.lux | 51 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/procedure.lux | 6 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/procedure/common.lux | 102 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/procedure/host.jvm.lux | 38 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/analyser/procedure/common.lux | 15 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/lux.lux | 2286 | ||||
| -rw-r--r-- | stdlib/source/lux/control/comonad.lux | 8 | ||||
| -rw-r--r-- | stdlib/source/lux/control/monad.lux | 14 | ||||
| -rw-r--r-- | stdlib/source/lux/host.jvm.lux | 8 | ||||
| -rw-r--r-- | stdlib/source/lux/meta/syntax.lux | 8 |
13 files changed, 1285 insertions, 1262 deletions
diff --git a/luxc/src/lux/analyser.clj b/luxc/src/lux/analyser.clj index 116102f37..2d029155e 100644 --- a/luxc/src/lux/analyser.clj +++ b/luxc/src/lux/analyser.clj @@ -145,7 +145,7 @@ (&&lux/analyse-program analyse optimize compile-program ?args ?body))) "lux case" - (|let [(&/$Cons ?value ?branches) parameters] + (|let [(&/$Cons ?value (&/$Cons [_ (&/$Record ?branches)] (&/$Nil))) parameters] (&/with-analysis-meta cursor exo-type (&&lux/analyse-case analyse exo-type ?value ?branches))) diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj index 8dc13680d..d6e82481d 100644 --- a/luxc/src/lux/analyser/lux.clj +++ b/luxc/src/lux/analyser/lux.clj @@ -393,9 +393,7 @@ ) (defn analyse-case [analyse exo-type ?value ?branches] - (|do [:let [num-branches (&/|length ?branches)] - _ (&/assert! (> num-branches 0) "[Analyser Error] Cannot have empty branches in \"case\" expression.") - _ (&/assert! (even? num-branches) "[Analyser Error] Unbalanced branches in \"case\" expression.") + (|do [_ (&/assert! (> (&/|length ?branches) 0) "[Analyser Error] Cannot have empty branches in \"case\" expression.") =value (&&/analyse-1+ analyse ?value) :let [var?? (|case =value [_ (&&/$var =var-kind)] @@ -403,7 +401,7 @@ _ &/$None)] - =match (&&case/analyse-branches analyse exo-type var?? (&&/expr-type* =value) (&/|as-pairs ?branches)) + =match (&&case/analyse-branches analyse exo-type var?? (&&/expr-type* =value) ?branches) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$case =value =match) diff --git a/new-luxc/source/luxc/analyser.lux b/new-luxc/source/luxc/analyser.lux index f0712794d..04d8d58b7 100644 --- a/new-luxc/source/luxc/analyser.lux +++ b/new-luxc/source/luxc/analyser.lux @@ -8,7 +8,7 @@ [meta] (meta [type] (type ["tc" check])) - [host #+ do-to]) + [host]) (luxc ["&" base] [";L" host] (lang ["la" analysis]) @@ -18,9 +18,7 @@ ["&&;" function] ["&&;" primitive] ["&&;" reference] - ["&&;" type] ["&&;" structure] - ["&&;" case] ["&&;" procedure])) (for {"JVM" (as-is (host;import java.lang.reflect.Method @@ -53,20 +51,7 @@ }) (exception: #export Macro-Expression-Must-Have-Single-Expansion) - -(def: (to-branches raw) - (-> (List Code) (Meta (List [Code Code]))) - (case raw - (^ (list)) - (:: meta;Monad<Meta> wrap (list)) - - (^ (list& patternH bodyH inputT)) - (do meta;Monad<Meta> - [outputT (to-branches inputT)] - (wrap (list& [patternH bodyH] outputT))) - - _ - (&;fail "Uneven expressions for pattern-matching."))) +(exception: #export Unrecognized-Syntax) (def: #export (analyser eval) (-> &;Eval &;Analyser) @@ -105,36 +90,8 @@ (#;Symbol reference) (&&reference;analyse-reference reference) - (^ (#;Form (list [_ (#;Text "lux function")] - [_ (#;Symbol ["" func-name])] - [_ (#;Symbol ["" arg-name])] - body))) - (&&function;analyse-function analyse func-name arg-name body) - - (^template [<special> <analyser>] - (^ (#;Form (list [_ (#;Text <special>)] type value))) - (<analyser> analyse eval type value)) - (["lux check" &&type;analyse-check] - ["lux coerce" &&type;analyse-coerce]) - - (^ (#;Form (list [_ (#;Text "lux check type")] valueC))) - (do meta;Monad<Meta> - [valueA (&;with-expected-type Type - (analyse valueC)) - expected meta;expected-type - _ (&;with-type-env - (tc;check expected Type))] - (wrap valueA)) - - (^ (#;Form (list& [_ (#;Text "lux case")] - input - branches))) - (do meta;Monad<Meta> - [paired (to-branches branches)] - (&&case;analyse-case analyse input paired)) - (^ (#;Form (list& [_ (#;Text proc-name)] proc-args))) - (&&procedure;analyse-procedure analyse proc-name proc-args) + (&&procedure;analyse-procedure analyse eval proc-name proc-args) (^template [<tag> <analyser>] (^ (#;Form (list& [_ (<tag> tag)] @@ -180,5 +137,5 @@ (&&function;analyse-apply analyse funcT =func args))) _ - (&;fail (format "Unrecognized syntax: " (%code ast))) + (&;throw Unrecognized-Syntax (%code ast)) ))))))) diff --git a/new-luxc/source/luxc/analyser/procedure.lux b/new-luxc/source/luxc/analyser/procedure.lux index 53ad8276c..225fb7b23 100644 --- a/new-luxc/source/luxc/analyser/procedure.lux +++ b/new-luxc/source/luxc/analyser/procedure.lux @@ -15,9 +15,9 @@ (|> ./common;procedures (dict;merge ./host;procedures))) -(def: #export (analyse-procedure analyse proc-name proc-args) - (-> &;Analyser Text (List Code) (Meta la;Analysis)) +(def: #export (analyse-procedure analyse eval proc-name proc-args) + (-> &;Analyser &;Eval Text (List Code) (Meta la;Analysis)) (<| (maybe;default (&;fail (format "Unknown procedure: " (%t proc-name)))) (do maybe;Monad<Maybe> [proc (dict;get proc-name procedures)] - (wrap (proc analyse proc-args))))) + (wrap (proc analyse eval proc-args))))) diff --git a/new-luxc/source/luxc/analyser/procedure/common.lux b/new-luxc/source/luxc/analyser/procedure/common.lux index 6c2e810b5..f64c537cb 100644 --- a/new-luxc/source/luxc/analyser/procedure/common.lux +++ b/new-luxc/source/luxc/analyser/procedure/common.lux @@ -12,11 +12,14 @@ [io]) (luxc ["&" base] (lang ["la" analysis]) - (analyser ["&;" common]))) + (analyser ["&;" common] + [";A" function] + [";A" case] + [";A" type]))) ## [Utils] (type: #export Proc - (-> &;Analyser (List Code) (Meta la;Analysis))) + (-> &;Analyser &;Eval (List Code) (Meta la;Analysis))) (type: #export Bundle (Dict Text Proc)) @@ -42,7 +45,7 @@ (def: (simple proc input-types output-type) (-> Text (List Type) Type Proc) (let [num-expected (list;size input-types)] - (function [analyse args] + (function [analyse eval args] (let [num-actual (list;size args)] (if (n.= num-expected num-actual) (do Monad<Meta> @@ -77,17 +80,17 @@ ## "lux is" represents reference/pointer equality. (def: (lux-is proc) (-> Text Proc) - (function [analyse args] + (function [analyse eval args] (&common;with-var (function [[var-id varT]] ((binary varT varT Bool proc) - analyse args))))) + analyse eval args))))) ## "lux try" provides a simple way to interact with the host platform's ## error-handling facilities. (def: (lux-try proc) (-> Text Proc) - (function [analyse args] + (function [analyse eval args] (&common;with-var (function [[var-id varT]] (case args @@ -105,11 +108,74 @@ _ (&;fail (wrong-arity proc +1 (list;size args)))))))) +(def: (lux//function proc) + (-> Text Proc) + (function [analyse eval args] + (&common;with-var + (function [[var-id varT]] + (case args + (^ (list [_ (#;Symbol ["" func-name])] + [_ (#;Symbol ["" arg-name])] + body)) + (functionA;analyse-function analyse func-name arg-name body) + + _ + (&;fail (wrong-arity proc +3 (list;size args)))))))) + +(def: (lux//case proc) + (-> Text Proc) + (function [analyse eval args] + (&common;with-var + (function [[var-id varT]] + (case args + (^ (list input [_ (#;Record branches)])) + (caseA;analyse-case analyse input branches) + + _ + (&;fail (wrong-arity proc +2 (list;size args)))))))) + +(do-template [<name> <analyser>] + [(def: (<name> proc) + (-> Text Proc) + (function [analyse eval args] + (&common;with-var + (function [[var-id varT]] + (case args + (^ (list typeC valueC)) + (<analyser> analyse eval typeC valueC) + + _ + (&;fail (wrong-arity proc +2 (list;size args))))))))] + + [lux//check typeA;analyse-check] + [lux//coerce typeA;analyse-coerce]) + +(def: (lux//check//type proc) + (-> Text Proc) + (function [analyse eval args] + (case args + (^ (list valueC)) + (do meta;Monad<Meta> + [valueA (&;with-expected-type Type + (analyse valueC)) + expected meta;expected-type + _ (&;with-type-env + (tc;check expected Type))] + (wrap valueA)) + + _ + (&;fail (wrong-arity proc +1 (list;size args)))))) + (def: lux-procs Bundle (|> (dict;new text;Hash<Text>) (install "is" lux-is) - (install "try" lux-try))) + (install "try" lux-try) + (install "function" lux//function) + (install "case" lux//case) + (install "check" lux//check) + (install "coerce" lux//coerce) + (install "check type" lux//check//type))) (def: io-procs Bundle @@ -222,27 +288,27 @@ (def: (array-get proc) (-> Text Proc) - (function [analyse args] + (function [analyse eval args] (&common;with-var (function [[var-id varT]] ((binary Nat (type (Array varT)) varT proc) - analyse args))))) + analyse eval args))))) (def: (array-put proc) (-> Text Proc) - (function [analyse args] + (function [analyse eval args] (&common;with-var (function [[var-id varT]] ((trinary Nat varT (type (Array varT)) (type (Array varT)) proc) - analyse args))))) + analyse eval args))))) (def: (array-remove proc) (-> Text Proc) - (function [analyse args] + (function [analyse eval args] (&common;with-var (function [[var-id varT]] ((binary Nat (type (Array varT)) (type (Array varT)) proc) - analyse args))))) + analyse eval args))))) (def: array-procs Bundle @@ -281,7 +347,7 @@ (def: (atom-new proc) (-> Text Proc) - (function [analyse args] + (function [analyse eval args] (&common;with-var (function [[var-id varT]] (case args @@ -301,19 +367,19 @@ (def: (atom-read proc) (-> Text Proc) - (function [analyse args] + (function [analyse eval args] (&common;with-var (function [[var-id varT]] ((unary (type (A;Atom varT)) varT proc) - analyse args))))) + analyse eval args))))) (def: (atom-compare-and-swap proc) (-> Text Proc) - (function [analyse args] + (function [analyse eval args] (&common;with-var (function [[var-id varT]] ((trinary varT varT (type (A;Atom varT)) Bool proc) - analyse args))))) + analyse eval args))))) (def: atom-procs Bundle diff --git a/new-luxc/source/luxc/analyser/procedure/host.jvm.lux b/new-luxc/source/luxc/analyser/procedure/host.jvm.lux index 84592d4ee..4db7b4dda 100644 --- a/new-luxc/source/luxc/analyser/procedure/host.jvm.lux +++ b/new-luxc/source/luxc/analyser/procedure/host.jvm.lux @@ -147,7 +147,7 @@ (def: (array-length proc) (-> Text @;Proc) - (function [analyse args] + (function [analyse eval args] (&common;with-var (function [[var-id varT]] (case args @@ -167,7 +167,7 @@ (def: (array-new proc) (-> Text @;Proc) - (function [analyse args] + (function [analyse eval args] (case args (^ (list lengthC)) (do meta;Monad<Meta> @@ -261,7 +261,7 @@ (def: (array-read proc) (-> Text @;Proc) - (function [analyse args] + (function [analyse eval args] (&common;with-var (function [[var-id varT]] (case args @@ -282,7 +282,7 @@ (def: (array-write proc) (-> Text @;Proc) - (function [analyse args] + (function [analyse eval args] (&common;with-var (function [[var-id varT]] (case args @@ -315,7 +315,7 @@ (def: (object-null proc) (-> Text @;Proc) - (function [analyse args] + (function [analyse eval args] (case args (^ (list)) (do meta;Monad<Meta> @@ -328,7 +328,7 @@ (def: (object-null? proc) (-> Text @;Proc) - (function [analyse args] + (function [analyse eval args] (&common;with-var (function [[var-id varT]] (case args @@ -347,7 +347,7 @@ (def: (object-synchronized proc) (-> Text @;Proc) - (function [analyse args] + (function [analyse eval args] (&common;with-var (function [[var-id varT]] (case args @@ -448,7 +448,7 @@ (def: (object-throw proc) (-> Text @;Proc) - (function [analyse args] + (function [analyse eval args] (&common;with-var (function [[var-id varT]] (case args @@ -472,7 +472,7 @@ (def: (object-class proc) (-> Text @;Proc) - (function [analyse args] + (function [analyse eval args] (case args (^ (list classC)) (case classC @@ -492,7 +492,7 @@ (def: (object-instance? proc) (-> Text @;Proc) - (function [analyse args] + (function [analyse eval args] (&common;with-var (function [[var-id varT]] (case args @@ -793,7 +793,7 @@ (def: (static-get proc) (-> Text @;Proc) - (function [analyse args] + (function [analyse eval args] (case args (^ (list classC fieldC)) (case [classC fieldC] @@ -811,7 +811,7 @@ (def: (static-put proc) (-> Text @;Proc) - (function [analyse args] + (function [analyse eval args] (case args (^ (list classC fieldC valueC)) (case [classC fieldC] @@ -834,7 +834,7 @@ (def: (virtual-get proc) (-> Text @;Proc) - (function [analyse args] + (function [analyse eval args] (case args (^ (list classC fieldC objectC)) (case [classC fieldC] @@ -853,7 +853,7 @@ (def: (virtual-put proc) (-> Text @;Proc) - (function [analyse args] + (function [analyse eval args] (case args (^ (list classC fieldC valueC objectC)) (case [classC fieldC] @@ -1104,7 +1104,7 @@ (def: (invoke//static proc) (-> Text @;Proc) - (function [analyse args] + (function [analyse eval args] (case (: (e;Error [Text Text (List [Text Code])]) (s;run args ($_ p;seq s;text s;text (p;some (s;tuple (p;seq s;text s;any)))))) (#e;Success [class method argsTC]) @@ -1121,7 +1121,7 @@ (def: (invoke//virtual proc) (-> Text @;Proc) - (function [analyse args] + (function [analyse eval args] (case (: (e;Error [Text Text Code (List [Text Code])]) (s;run args ($_ p;seq s;text s;text s;any (p;some (s;tuple (p;seq s;text s;any)))))) (#e;Success [class method objectC argsTC]) @@ -1144,7 +1144,7 @@ (def: (invoke//special proc) (-> Text @;Proc) - (function [analyse args] + (function [analyse eval args] (case (: (e;Error [(List Code) [Text Text Code (List [Text Code]) Unit]]) (p;run args ($_ p;seq s;text s;text s;any (p;some (s;tuple (p;seq s;text s;any))) s;end!))) (#e;Success [_ [class method objectC argsTC _]]) @@ -1163,7 +1163,7 @@ (def: (invoke//interface proc) (-> Text @;Proc) - (function [analyse args] + (function [analyse eval args] (case (: (e;Error [Text Text Code (List [Text Code])]) (s;run args ($_ p;seq s;text s;text s;any (p;some (s;tuple (p;seq s;text s;any)))))) (#e;Success [class-name method objectC argsTC]) @@ -1183,7 +1183,7 @@ (def: (invoke//constructor proc) (-> Text @;Proc) - (function [analyse args] + (function [analyse eval args] (case (: (e;Error [Text (List [Text Code])]) (s;run args ($_ p;seq s;text (p;some (s;tuple (p;seq s;text s;any)))))) (#e;Success [class argsTC]) diff --git a/new-luxc/test/test/luxc/analyser/procedure/common.lux b/new-luxc/test/test/luxc/analyser/procedure/common.lux index 8649de3d7..5e1619d38 100644 --- a/new-luxc/test/test/luxc/analyser/procedure/common.lux +++ b/new-luxc/test/test/luxc/analyser/procedure/common.lux @@ -16,6 +16,7 @@ (luxc ["&" base] ["&;" scope] ["&;" module] + [";L" eval] (lang ["~" analysis]) [analyser] (analyser ["@" procedure] @@ -28,7 +29,7 @@ (-> Text (List Code) Type Bool) (|> (&;with-scope (&;with-expected-type output-type - (@;analyse-procedure analyse procedure params))) + (@;analyse-procedure analyse evalL;eval procedure params))) (meta;run (init-compiler [])) (case> (#e;Success _) <success> @@ -262,7 +263,7 @@ (|> (&scope;with-scope "" (&scope;with-local [var-name arrayT] (&;with-expected-type elemT - (@;analyse-procedure analyse "lux array get" + (@;analyse-procedure analyse evalL;eval "lux array get" (list idxC (code;symbol ["" var-name])))))) (meta;run (init-compiler [])) @@ -275,7 +276,7 @@ (|> (&scope;with-scope "" (&scope;with-local [var-name arrayT] (&;with-expected-type arrayT - (@;analyse-procedure analyse "lux array put" + (@;analyse-procedure analyse evalL;eval "lux array put" (list idxC elemC (code;symbol ["" var-name])))))) @@ -289,7 +290,7 @@ (|> (&scope;with-scope "" (&scope;with-local [var-name arrayT] (&;with-expected-type arrayT - (@;analyse-procedure analyse "lux array remove" + (@;analyse-procedure analyse evalL;eval "lux array remove" (list idxC (code;symbol ["" var-name])))))) (meta;run (init-compiler [])) @@ -302,7 +303,7 @@ (|> (&scope;with-scope "" (&scope;with-local [var-name arrayT] (&;with-expected-type Nat - (@;analyse-procedure analyse "lux array size" + (@;analyse-procedure analyse evalL;eval "lux array size" (list (code;symbol ["" var-name])))))) (meta;run (init-compiler [])) (case> (#e;Success _) @@ -362,7 +363,7 @@ (|> (&scope;with-scope "" (&scope;with-local [var-name atomT] (&;with-expected-type elemT - (@;analyse-procedure analyse "lux atom read" + (@;analyse-procedure analyse evalL;eval "lux atom read" (list (code;symbol ["" var-name])))))) (meta;run (init-compiler [])) (case> (#e;Success _) @@ -374,7 +375,7 @@ (|> (&scope;with-scope "" (&scope;with-local [var-name atomT] (&;with-expected-type Bool - (@;analyse-procedure analyse "lux atom compare-and-swap" + (@;analyse-procedure analyse evalL;eval "lux atom compare-and-swap" (list elemC elemC (code;symbol ["" var-name])))))) diff --git a/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux b/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux index d1520e5b7..3cee1b160 100644 --- a/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux +++ b/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux @@ -20,6 +20,7 @@ (luxc ["&" base] ["&;" scope] ["&;" module] + [";L" eval] (lang ["~" analysis]) [analyser] (analyser ["@" procedure] @@ -36,7 +37,7 @@ [runtime-bytecode @runtime;generate] (&;with-scope (&;with-expected-type output-type - (@;analyse-procedure analyse procedure params)))) + (@;analyse-procedure analyse evalL;eval procedure params)))) (meta;run (init-compiler [])) (case> (#e;Success _) <success> diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index e3a81cebd..6b68b9f29 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -186,39 +186,39 @@ ("lux def" Type (+12 ["lux" "Type"] ("lux case" ("lux check type" (+11 (+6 +1) (+6 +0))) - Type - ("lux case" ("lux check type" (+11 Type List)) - Type-List - ("lux case" ("lux check type" (+4 Type Type)) - Type-Pair - (+11 Void - (+9 #Nil - (+3 ## "lux;Primitive" - (+4 Text Type-List) - (+3 ## "lux;Void" - (+2) - (+3 ## "lux;Unit" - (+2) - (+3 ## "lux;Sum" - Type-Pair - (+3 ## "lux;Product" - Type-Pair - (+3 ## "lux;Function" - Type-Pair - (+3 ## "lux;Bound" - Nat - (+3 ## "lux;Var" - Nat - (+3 ## "lux;Ex" - Nat - (+3 ## "lux;UnivQ" - (+4 Type-List Type) - (+3 ## "lux;ExQ" - (+4 Type-List Type) - (+3 ## "lux;App" - Type-Pair - ## "lux;Named" - (+4 Ident Type))))))))))))))))))) + {Type + ("lux case" ("lux check type" (+11 Type List)) + {Type-List + ("lux case" ("lux check type" (+4 Type Type)) + {Type-Pair + (+11 Void + (+9 #Nil + (+3 ## "lux;Primitive" + (+4 Text Type-List) + (+3 ## "lux;Void" + (+2) + (+3 ## "lux;Unit" + (+2) + (+3 ## "lux;Sum" + Type-Pair + (+3 ## "lux;Product" + Type-Pair + (+3 ## "lux;Function" + Type-Pair + (+3 ## "lux;Bound" + Nat + (+3 ## "lux;Var" + Nat + (+3 ## "lux;Ex" + Nat + (+3 ## "lux;UnivQ" + (+4 Type-List Type) + (+3 ## "lux;ExQ" + (+4 Type-List Type) + (+3 ## "lux;App" + Type-Pair + ## "lux;Named" + (+4 Ident Type)))))))))))))))})})})) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] [dummy-cursor (+0 true)]] @@ -339,34 +339,34 @@ ("lux case" ("lux check type" (#Apply (#Apply (#Bound +1) (#Bound +0)) (#Bound +1))) - Code - ("lux case" ("lux check type" (#Apply Code List)) - Code-List - (#UnivQ #Nil - (#Sum ## "lux;Bool" - Bool - (#Sum ## "lux;Nat" - Nat - (#Sum ## "lux;Int" - Int - (#Sum ## "lux;Deg" - Deg - (#Sum ## "lux;Frac" - Frac - (#Sum ## "lux;Text" - Text - (#Sum ## "lux;Symbol" - Ident - (#Sum ## "lux;Tag" - Ident - (#Sum ## "lux;Form" - Code-List - (#Sum ## "lux;Tuple" - Code-List - ## "lux;Record" - (#Apply (#Product Code Code) List) - )))))))))) - )))) + {Code + ("lux case" ("lux check type" (#Apply Code List)) + {Code-List + (#UnivQ #Nil + (#Sum ## "lux;Bool" + Bool + (#Sum ## "lux;Nat" + Nat + (#Sum ## "lux;Int" + Int + (#Sum ## "lux;Deg" + Deg + (#Sum ## "lux;Frac" + Frac + (#Sum ## "lux;Text" + Text + (#Sum ## "lux;Symbol" + Ident + (#Sum ## "lux;Tag" + Ident + (#Sum ## "lux;Form" + Code-List + (#Sum ## "lux;Tuple" + Code-List + ## "lux;Record" + (#Apply (#Product Code Code) List) + )))))))))) + )})})) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "tags"])] [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "Bool")] @@ -394,8 +394,8 @@ ("lux def" Code (#Named ["lux" "Code"] ("lux case" ("lux check type" (#Apply Cursor Ann)) - w - (#Apply (#Apply w Code') w))) + {w + (#Apply (#Apply w Code') w)})) [dummy-cursor (#Record (#Cons [[dummy-cursor (#Tag ["lux" "doc"])] [dummy-cursor (#Text "The type of Code nodes for Lux syntax.")]] @@ -824,51 +824,51 @@ ("lux check" Macro ("lux function" _ tokens ("lux case" tokens - (#Cons lhs (#Cons rhs (#Cons body #Nil))) - (return (#Cons (form$ (#Cons (text$ "lux case") - (#Cons rhs (#Cons lhs (#Cons body #Nil))))) - #Nil)) + {(#Cons lhs (#Cons rhs (#Cons body #Nil))) + (return (#Cons (form$ (#Cons (text$ "lux case") + (#Cons rhs (#Cons (record$ (#;Cons [lhs body] #Nil)) #Nil)))) + #Nil)) - _ - (fail "Wrong syntax for let''")))) + _ + (fail "Wrong syntax for let''")}))) (record$ default-macro-meta)) ("lux def" function'' ("lux check" Macro ("lux function" _ tokens ("lux case" tokens - (#Cons [_ (#Tuple (#Cons arg args'))] (#Cons body #Nil)) - (return (#Cons (_ann (#Form (#Cons (_ann (#Text "lux function")) - (#Cons (_ann (#Symbol "" "")) - (#Cons arg - (#Cons ("lux case" args' - #Nil - body - - _ - (_ann (#Form (#Cons (_ann (#Symbol "lux" "function''")) - (#Cons (_ann (#Tuple args')) - (#Cons body #Nil)))))) - #Nil)))))) - #Nil)) - - (#Cons [_ (#Symbol "" self)] (#Cons [_ (#Tuple (#Cons arg args'))] (#Cons body #Nil))) - (return (#Cons (_ann (#Form (#Cons (_ann (#Text "lux function")) - (#Cons (_ann (#Symbol "" self)) - (#Cons arg - (#Cons ("lux case" args' - #Nil - body - - _ - (_ann (#Form (#Cons (_ann (#Symbol "lux" "function''")) - (#Cons (_ann (#Tuple args')) - (#Cons body #Nil)))))) - #Nil)))))) - #Nil)) - - _ - (fail "Wrong syntax for function''")))) + {(#Cons [_ (#Tuple (#Cons arg args'))] (#Cons body #Nil)) + (return (#Cons (_ann (#Form (#Cons (_ann (#Text "lux function")) + (#Cons (_ann (#Symbol "" "")) + (#Cons arg + (#Cons ("lux case" args' + {#Nil + body + + _ + (_ann (#Form (#Cons (_ann (#Symbol "lux" "function''")) + (#Cons (_ann (#Tuple args')) + (#Cons body #Nil)))))}) + #Nil)))))) + #Nil)) + + (#Cons [_ (#Symbol "" self)] (#Cons [_ (#Tuple (#Cons arg args'))] (#Cons body #Nil))) + (return (#Cons (_ann (#Form (#Cons (_ann (#Text "lux function")) + (#Cons (_ann (#Symbol "" self)) + (#Cons arg + (#Cons ("lux case" args' + {#Nil + body + + _ + (_ann (#Form (#Cons (_ann (#Symbol "lux" "function''")) + (#Cons (_ann (#Tuple args')) + (#Cons body #Nil)))))}) + #Nil)))))) + #Nil)) + + _ + (fail "Wrong syntax for function''")}))) (record$ default-macro-meta)) ("lux def" cursor-code @@ -936,69 +936,69 @@ ("lux check" Macro (function'' [tokens] ("lux case" tokens - (#Cons [[_ (#Tag ["" "export"])] - (#Cons [[_ (#Form (#Cons [name args]))] - (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) - (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def")) - (#Cons [name - (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check")) - (#Cons [type - (#Cons [(_ann (#Form (#Cons [(_ann (#Symbol ["lux" "function''"])) - (#Cons [name - (#Cons [(_ann (#Tuple args)) - (#Cons [body #Nil])])])]))) - #Nil])])]))) - (#Cons (form$ (#Cons (symbol$ ["lux" "record$"]) - (#Cons (with-export-meta meta) - #Nil))) - #Nil)])])]))) - #Nil])) - - (#Cons [[_ (#Tag ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) - (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def")) - (#Cons [name - (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check")) - (#Cons [type - (#Cons [body - #Nil])])]))) - (#Cons (form$ (#Cons (symbol$ ["lux" "record$"]) - (#Cons (with-export-meta meta) - #Nil))) - #Nil)])])]))) - #Nil])) - - (#Cons [[_ (#Form (#Cons [name args]))] - (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) - (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def")) - (#Cons [name - (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check")) - (#Cons [type - (#Cons [(_ann (#Form (#Cons [(_ann (#Symbol ["lux" "function''"])) - (#Cons [name - (#Cons [(_ann (#Tuple args)) - (#Cons [body #Nil])])])]))) - #Nil])])]))) - (#Cons (form$ (#Cons (symbol$ ["lux" "record$"]) - (#Cons meta - #Nil))) - #Nil)])])]))) - #Nil])) - - (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) - (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def")) - (#Cons [name - (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check")) - (#Cons [type - (#Cons [body - #Nil])])]))) - (#Cons (form$ (#Cons (symbol$ ["lux" "record$"]) - (#Cons meta - #Nil))) - #Nil)])])]))) - #Nil])) + {(#Cons [[_ (#Tag ["" "export"])] + (#Cons [[_ (#Form (#Cons [name args]))] + (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) + (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def")) + (#Cons [name + (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check")) + (#Cons [type + (#Cons [(_ann (#Form (#Cons [(_ann (#Symbol ["lux" "function''"])) + (#Cons [name + (#Cons [(_ann (#Tuple args)) + (#Cons [body #Nil])])])]))) + #Nil])])]))) + (#Cons (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons (with-export-meta meta) + #Nil))) + #Nil)])])]))) + #Nil])) + + (#Cons [[_ (#Tag ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) + (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def")) + (#Cons [name + (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check")) + (#Cons [type + (#Cons [body + #Nil])])]))) + (#Cons (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons (with-export-meta meta) + #Nil))) + #Nil)])])]))) + #Nil])) + + (#Cons [[_ (#Form (#Cons [name args]))] + (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) + (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def")) + (#Cons [name + (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check")) + (#Cons [type + (#Cons [(_ann (#Form (#Cons [(_ann (#Symbol ["lux" "function''"])) + (#Cons [name + (#Cons [(_ann (#Tuple args)) + (#Cons [body #Nil])])])]))) + #Nil])])]))) + (#Cons (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons meta + #Nil))) + #Nil)])])]))) + #Nil])) + + (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) + (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def")) + (#Cons [name + (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check")) + (#Cons [type + (#Cons [body + #Nil])])]))) + (#Cons (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons meta + #Nil))) + #Nil)])])]))) + #Nil])) - _ - (fail "Wrong syntax for def''")) + _ + (fail "Wrong syntax for def''")}) )) (record$ default-macro-meta)) @@ -1006,40 +1006,40 @@ default-macro-meta Macro ("lux case" tokens - (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil)) - (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"]) - (#Cons (form$ (#Cons name args)) - (#Cons (with-macro-meta (tag$ ["lux" "Nil"])) - (#Cons (symbol$ ["lux" "Macro"]) - (#Cons body - #Nil))) - ))) - #Nil)) - - (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil))) - (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"]) - (#Cons (tag$ ["" "export"]) - (#Cons (form$ (#Cons name args)) - (#Cons (with-macro-meta (tag$ ["lux" "Nil"])) - (#Cons (symbol$ ["lux" "Macro"]) - (#Cons body - #Nil))) - )))) - #Nil)) - - (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons meta-data (#Cons body #Nil)))) - (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"]) - (#Cons (tag$ ["" "export"]) - (#Cons (form$ (#Cons name args)) - (#Cons (with-macro-meta meta-data) - (#Cons (symbol$ ["lux" "Macro"]) - (#Cons body - #Nil))) - )))) - #Nil)) - - _ - (fail "Wrong syntax for macro:'"))) + {(#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil)) + (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"]) + (#Cons (form$ (#Cons name args)) + (#Cons (with-macro-meta (tag$ ["lux" "Nil"])) + (#Cons (symbol$ ["lux" "Macro"]) + (#Cons body + #Nil))) + ))) + #Nil)) + + (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil))) + (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"]) + (#Cons (tag$ ["" "export"]) + (#Cons (form$ (#Cons name args)) + (#Cons (with-macro-meta (tag$ ["lux" "Nil"])) + (#Cons (symbol$ ["lux" "Macro"]) + (#Cons body + #Nil))) + )))) + #Nil)) + + (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons meta-data (#Cons body #Nil)))) + (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"]) + (#Cons (tag$ ["" "export"]) + (#Cons (form$ (#Cons name args)) + (#Cons (with-macro-meta meta-data) + (#Cons (symbol$ ["lux" "Macro"]) + (#Cons body + #Nil))) + )))) + #Nil)) + + _ + (fail "Wrong syntax for macro:'")})) (macro:' #export (comment tokens) (#Cons [(tag$ ["lux" "doc"]) @@ -1051,18 +1051,18 @@ (macro:' ($' tokens) ("lux case" tokens - (#Cons x #Nil) - (return tokens) - - (#Cons x (#Cons y xs)) - (return (#Cons (form$ (#Cons (symbol$ ["lux" "$'"]) - (#Cons (form$ (#Cons (tag$ ["lux" "Apply"]) - (#Cons y (#Cons x #Nil)))) - xs))) - #Nil)) + {(#Cons x #Nil) + (return tokens) + + (#Cons x (#Cons y xs)) + (return (#Cons (form$ (#Cons (symbol$ ["lux" "$'"]) + (#Cons (form$ (#Cons (tag$ ["lux" "Apply"]) + (#Cons y (#Cons x #Nil)))) + xs))) + #Nil)) - _ - (fail "Wrong syntax for $'"))) + _ + (fail "Wrong syntax for $'")})) (def:'' (map f xs) #;Nil @@ -1072,11 +1072,11 @@ (#Function ($' List (#Bound +3)) ($' List (#Bound +1)))))) ("lux case" xs - #Nil - #Nil + {#Nil + #Nil - (#Cons x xs') - (#Cons (f x) (map f xs')))) + (#Cons x xs') + (#Cons (f x) (map f xs'))})) (def:'' RepEnv #;Nil @@ -1087,11 +1087,11 @@ #;Nil (#Function ($' List Text) (#Function ($' List Code) RepEnv)) ("lux case" [xs ys] - [(#Cons x xs') (#Cons y ys')] - (#Cons [x y] (make-env xs' ys')) + {[(#Cons x xs') (#Cons y ys')] + (#Cons [x y] (make-env xs' ys')) - _ - #Nil)) + _ + #Nil})) (def:'' (text/= x y) #;Nil @@ -1102,69 +1102,69 @@ #;Nil (#Function Text (#Function RepEnv ($' Maybe Code))) ("lux case" env - #Nil - #None + {#Nil + #None - (#Cons [k v] env') - ("lux case" (text/= k key) - true - (#Some v) + (#Cons [k v] env') + ("lux case" (text/= k key) + {true + (#Some v) - false - (get-rep key env')))) + false + (get-rep key env')})})) (def:'' (replace-syntax reps syntax) #;Nil (#Function RepEnv (#Function Code Code)) ("lux case" syntax - [_ (#Symbol "" name)] - ("lux case" (get-rep name reps) - (#Some replacement) - replacement + {[_ (#Symbol "" name)] + ("lux case" (get-rep name reps) + {(#Some replacement) + replacement - #None - syntax) + #None + syntax}) - [meta (#Form parts)] - [meta (#Form (map (replace-syntax reps) parts))] + [meta (#Form parts)] + [meta (#Form (map (replace-syntax reps) parts))] - [meta (#Tuple members)] - [meta (#Tuple (map (replace-syntax reps) members))] + [meta (#Tuple members)] + [meta (#Tuple (map (replace-syntax reps) members))] - [meta (#Record slots)] - [meta (#Record (map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) - (function'' [slot] - ("lux case" slot - [k v] - [(replace-syntax reps k) (replace-syntax reps v)]))) - slots))] - - _ - syntax) + [meta (#Record slots)] + [meta (#Record (map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) + (function'' [slot] + ("lux case" slot + {[k v] + [(replace-syntax reps k) (replace-syntax reps v)]}))) + slots))] + + _ + syntax}) ) (def:'' (update-bounds code) #;Nil (#Function Code Code) ("lux case" code - [_ (#Tuple members)] - (tuple$ (map update-bounds members)) + {[_ (#Tuple members)] + (tuple$ (map update-bounds members)) - [_ (#Record pairs)] - (record$ (map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) - (function'' [pair] - (let'' [name val] pair - [name (update-bounds val)]))) - pairs)) + [_ (#Record pairs)] + (record$ (map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) + (function'' [pair] + (let'' [name val] pair + [name (update-bounds val)]))) + pairs)) - [_ (#Form (#Cons [_ (#Tag "lux" "Bound")] (#Cons [_ (#Nat idx)] #Nil)))] - (form$ (#Cons (tag$ ["lux" "Bound"]) (#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)) + [_ (#Form members)] + (form$ (map update-bounds members)) - _ - code)) + _ + code})) (def:'' (parse-quantified-args args next) #;Nil @@ -1174,14 +1174,14 @@ (#Apply ($' List Code) Meta) )) ("lux case" args - #Nil - (next #Nil) + {#Nil + (next #Nil) - (#Cons [_ (#Symbol "" arg-name)] args') - (parse-quantified-args args' (function'' [names] (next (#Cons arg-name names)))) + (#Cons [_ (#Symbol "" arg-name)] args') + (parse-quantified-args args' (function'' [names] (next (#Cons arg-name names)))) - _ - (fail "Expected symbol.") + _ + (fail "Expected symbol.")} )) (def:'' (make-bound idx) @@ -1199,11 +1199,11 @@ (#Function ($' List (#Bound +1)) (#Bound +3)))))) ("lux case" xs - #Nil - init + {#Nil + init - (#Cons x xs') - (fold f (f x init) xs'))) + (#Cons x xs') + (fold f (f x init) xs')})) (def:'' (length list) #;Nil @@ -1223,42 +1223,42 @@ [a (List a)]))")] #;Nil) (let'' [self-name tokens] ("lux case" tokens - (#Cons [_ (#Symbol "" self-name)] tokens) - [self-name tokens] + {(#Cons [_ (#Symbol "" self-name)] tokens) + [self-name tokens] - _ - ["" tokens]) + _ + ["" tokens]}) ("lux case" tokens - (#Cons [_ (#Tuple args)] (#Cons body #Nil)) - (parse-quantified-args args - (function'' [names] - (let'' body' (fold ("lux check" (#Function Text (#Function Code Code)) - (function'' [name' body'] - (form$ (#Cons (tag$ ["lux" "UnivQ"]) - (#Cons (tag$ ["lux" "Nil"]) - (#Cons (replace-syntax (#Cons [name' (make-bound +1)] #Nil) - (update-bounds body')) #Nil)))))) - body - names) - (return (#Cons ("lux case" [(text/= "" self-name) names] - [true _] - body' - - [_ #;Nil] - body' - - [false _] - (replace-syntax (#Cons [self-name (make-bound (_lux_proc ["nat" "*"] - [+2 (_lux_proc ["nat" "-"] - [(_lux_proc ["int" "to-nat"] - [(length names)]) - +1])]))] - #Nil) - body')) - #Nil))))) - - _ - (fail "Wrong syntax for All")) + {(#Cons [_ (#Tuple args)] (#Cons body #Nil)) + (parse-quantified-args args + (function'' [names] + (let'' body' (fold ("lux check" (#Function Text (#Function Code Code)) + (function'' [name' body'] + (form$ (#Cons (tag$ ["lux" "UnivQ"]) + (#Cons (tag$ ["lux" "Nil"]) + (#Cons (replace-syntax (#Cons [name' (make-bound +1)] #Nil) + (update-bounds body')) #Nil)))))) + body + names) + (return (#Cons ("lux case" [(text/= "" self-name) names] + {[true _] + body' + + [_ #;Nil] + body' + + [false _] + (replace-syntax (#Cons [self-name (make-bound (_lux_proc ["nat" "*"] + [+2 (_lux_proc ["nat" "-"] + [(_lux_proc ["int" "to-nat"] + [(length names)]) + +1])]))] + #Nil) + body')}) + #Nil))))) + + _ + (fail "Wrong syntax for All")}) )) (macro:' #export (Ex tokens) @@ -1275,42 +1275,42 @@ (List (Self a))])")] #;Nil) (let'' [self-name tokens] ("lux case" tokens - (#Cons [_ (#Symbol "" self-name)] tokens) - [self-name tokens] + {(#Cons [_ (#Symbol "" self-name)] tokens) + [self-name tokens] - _ - ["" tokens]) + _ + ["" tokens]}) ("lux case" tokens - (#Cons [_ (#Tuple args)] (#Cons body #Nil)) - (parse-quantified-args args - (function'' [names] - (let'' body' (fold ("lux check" (#Function Text (#Function Code Code)) - (function'' [name' body'] - (form$ (#Cons (tag$ ["lux" "ExQ"]) - (#Cons (tag$ ["lux" "Nil"]) - (#Cons (replace-syntax (#Cons [name' (make-bound +1)] #Nil) - (update-bounds body')) #Nil)))))) - body - names) - (return (#Cons ("lux case" [(text/= "" self-name) names] - [true _] - body' - - [_ #;Nil] - body' - - [false _] - (replace-syntax (#Cons [self-name (make-bound (_lux_proc ["nat" "*"] - [+2 (_lux_proc ["nat" "-"] - [(_lux_proc ["int" "to-nat"] - [(length names)]) - +1])]))] - #Nil) - body')) - #Nil))))) - - _ - (fail "Wrong syntax for Ex")) + {(#Cons [_ (#Tuple args)] (#Cons body #Nil)) + (parse-quantified-args args + (function'' [names] + (let'' body' (fold ("lux check" (#Function Text (#Function Code Code)) + (function'' [name' body'] + (form$ (#Cons (tag$ ["lux" "ExQ"]) + (#Cons (tag$ ["lux" "Nil"]) + (#Cons (replace-syntax (#Cons [name' (make-bound +1)] #Nil) + (update-bounds body')) #Nil)))))) + body + names) + (return (#Cons ("lux case" [(text/= "" self-name) names] + {[true _] + body' + + [_ #;Nil] + body' + + [false _] + (replace-syntax (#Cons [self-name (make-bound (_lux_proc ["nat" "*"] + [+2 (_lux_proc ["nat" "-"] + [(_lux_proc ["int" "to-nat"] + [(length names)]) + +1])]))] + #Nil) + body')}) + #Nil))))) + + _ + (fail "Wrong syntax for Ex")}) )) (def:'' (reverse list) @@ -1328,15 +1328,15 @@ ## This is the type of a function that takes 2 Ints and returns an Int.")] #;Nil) ("lux case" (reverse tokens) - (#Cons output inputs) - (return (#Cons (fold ("lux check" (#Function Code (#Function Code Code)) - (function'' [i o] (form$ (#Cons (tag$ ["lux" "Function"]) (#Cons i (#Cons o #Nil)))))) - output - inputs) - #Nil)) - - _ - (fail "Wrong syntax for ->"))) + {(#Cons output inputs) + (return (#Cons (fold ("lux check" (#Function Code (#Function Code Code)) + (function'' [i o] (form$ (#Cons (tag$ ["lux" "Function"]) (#Cons i (#Cons o #Nil)))))) + output + inputs) + #Nil)) + + _ + (fail "Wrong syntax for ->")})) (macro:' #export (list xs) (#Cons [(tag$ ["lux" "doc"]) @@ -1358,15 +1358,15 @@ (list& 1 2 3 (list 4 5 6))")] #;Nil) ("lux case" (reverse xs) - (#Cons last init) - (return (list (fold (function'' [head tail] - (form$ (list (tag$ ["lux" "Cons"]) - (tuple$ (list head tail))))) - last - init))) + {(#Cons last init) + (return (list (fold (function'' [head tail] + (form$ (list (tag$ ["lux" "Cons"]) + (tuple$ (list head tail))))) + last + init))) - _ - (fail "Wrong syntax for list&"))) + _ + (fail "Wrong syntax for list&")})) (macro:' #export (& tokens) (#Cons [(tag$ ["lux" "doc"]) @@ -1377,13 +1377,13 @@ (&)")] #;Nil) ("lux case" (reverse tokens) - #Nil - (return (list (tag$ ["lux" "Unit"]))) + {#Nil + (return (list (tag$ ["lux" "Unit"]))) - (#Cons last prevs) - (return (list (fold (function'' [left right] (form$ (list (tag$ ["lux" "Product"]) left right))) - last - prevs))) + (#Cons last prevs) + (return (list (fold (function'' [left right] (form$ (list (tag$ ["lux" "Product"]) left right))) + last + prevs)))} )) (macro:' #export (| tokens) @@ -1395,143 +1395,143 @@ (|)")] #;Nil) ("lux case" (reverse tokens) - #Nil - (return (list (tag$ ["lux" "Void"]))) + {#Nil + (return (list (tag$ ["lux" "Void"]))) - (#Cons last prevs) - (return (list (fold (function'' [left right] (form$ (list (tag$ ["lux" "Sum"]) left right))) - last - prevs))) + (#Cons last prevs) + (return (list (fold (function'' [left right] (form$ (list (tag$ ["lux" "Sum"]) left right))) + last + prevs)))} )) (macro:' (function' tokens) (let'' [name tokens'] ("lux case" tokens - (#Cons [[_ (#Symbol ["" name])] tokens']) - [name tokens'] + {(#Cons [[_ (#Symbol ["" name])] tokens']) + [name tokens'] - _ - ["" tokens]) + _ + ["" tokens]}) ("lux case" tokens' - (#Cons [[_ (#Tuple args)] (#Cons [body #Nil])]) - ("lux case" args - #Nil - (fail "function' requires a non-empty arguments tuple.") - - (#Cons [harg targs]) - (return (list (form$ (list (text$ "lux function") - (symbol$ ["" name]) - harg - (fold (function'' [arg body'] - (form$ (list (text$ "lux function") - (symbol$ ["" ""]) - arg - body'))) - body - (reverse targs))))))) + {(#Cons [[_ (#Tuple args)] (#Cons [body #Nil])]) + ("lux case" args + {#Nil + (fail "function' requires a non-empty arguments tuple.") + + (#Cons [harg targs]) + (return (list (form$ (list (text$ "lux function") + (symbol$ ["" name]) + harg + (fold (function'' [arg body'] + (form$ (list (text$ "lux function") + (symbol$ ["" ""]) + arg + body'))) + body + (reverse targs))))))}) - _ - (fail "Wrong syntax for function'")))) + _ + (fail "Wrong syntax for function'")}))) (macro:' (def:''' tokens) ("lux case" tokens - (#Cons [[_ (#Tag ["" "export"])] - (#Cons [[_ (#Form (#Cons [name args]))] - (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) - (return (list (form$ (list (text$ "lux def") - name - (form$ (list (text$ "lux check") - type - (form$ (list (symbol$ ["lux" "function'"]) - name - (tuple$ args) - body)))) - (form$ (#Cons (symbol$ ["lux" "record$"]) - (#Cons (with-export-meta meta) - #Nil))))))) - - (#Cons [[_ (#Tag ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) - (return (list (form$ (list (text$ "lux def") - name - (form$ (list (text$ "lux check") - type - body)) - (form$ (#Cons (symbol$ ["lux" "record$"]) - (#Cons (with-export-meta meta) - #Nil))))))) - - (#Cons [[_ (#Form (#Cons [name args]))] - (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) - (return (list (form$ (list (text$ "lux def") - name - (form$ (list (text$ "lux check") - type - (form$ (list (symbol$ ["lux" "function'"]) - name - (tuple$ args) - body)))) - (form$ (#Cons (symbol$ ["lux" "record$"]) - (#Cons meta - #Nil))))))) - - (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) - (return (list (form$ (list (text$ "lux def") - name - (form$ (list (text$ "lux check") type body)) - (form$ (#Cons (symbol$ ["lux" "record$"]) - (#Cons meta - #Nil))))))) - - _ - (fail "Wrong syntax for def'''") + {(#Cons [[_ (#Tag ["" "export"])] + (#Cons [[_ (#Form (#Cons [name args]))] + (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) + (return (list (form$ (list (text$ "lux def") + name + (form$ (list (text$ "lux check") + type + (form$ (list (symbol$ ["lux" "function'"]) + name + (tuple$ args) + body)))) + (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons (with-export-meta meta) + #Nil))))))) + + (#Cons [[_ (#Tag ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) + (return (list (form$ (list (text$ "lux def") + name + (form$ (list (text$ "lux check") + type + body)) + (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons (with-export-meta meta) + #Nil))))))) + + (#Cons [[_ (#Form (#Cons [name args]))] + (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) + (return (list (form$ (list (text$ "lux def") + name + (form$ (list (text$ "lux check") + type + (form$ (list (symbol$ ["lux" "function'"]) + name + (tuple$ args) + body)))) + (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons meta + #Nil))))))) + + (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) + (return (list (form$ (list (text$ "lux def") + name + (form$ (list (text$ "lux check") type body)) + (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons meta + #Nil))))))) + + _ + (fail "Wrong syntax for def'''")} )) (def:''' (as-pairs xs) #;Nil (All [a] (-> ($' List a) ($' List (& a a)))) ("lux case" xs - (#Cons x (#Cons y xs')) - (#Cons [x y] (as-pairs xs')) + {(#Cons x (#Cons y xs')) + (#Cons [x y] (as-pairs xs')) - _ - #Nil)) + _ + #Nil})) (macro:' (let' tokens) ("lux case" tokens - (#Cons [[_ (#Tuple bindings)] (#Cons [body #Nil])]) - (return (list (fold ("lux check" (-> (& Code Code) Code - Code) - (function' [binding body] - ("lux case" binding - [label value] - (form$ (list (text$ "lux case") value label body))))) - body - (reverse (as-pairs bindings))))) + {(#Cons [[_ (#Tuple bindings)] (#Cons [body #Nil])]) + (return (list (fold ("lux check" (-> (& Code Code) Code + Code) + (function' [binding body] + ("lux case" binding + {[label value] + (form$ (list (text$ "lux case") value (record$ (list [label body]))))}))) + body + (reverse (as-pairs bindings))))) - _ - (fail "Wrong syntax for let'"))) + _ + (fail "Wrong syntax for let'")})) (def:''' (any? p xs) #;Nil (All [a] (-> (-> a Bool) ($' List a) Bool)) ("lux case" xs - #Nil - false + {#Nil + false - (#Cons x xs') - ("lux case" (p x) - true true - false (any? p xs')))) + (#Cons x xs') + ("lux case" (p x) + {true true + false (any? p xs')})})) (def:''' (spliced? token) #;Nil (-> Code Bool) ("lux case" token - [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [_ #Nil])]))] - true + {[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [_ #Nil])]))] + true - _ - false)) + _ + false})) (def:''' (wrap-meta content) #;Nil @@ -1543,21 +1543,21 @@ #;Nil (-> ($' List Code) Code) ("lux case" tokens - #Nil - (_ann (#Tag ["lux" "Nil"])) + {#Nil + (_ann (#Tag ["lux" "Nil"])) - (#Cons [token tokens']) - (_ann (#Form (list (_ann (#Tag ["lux" "Cons"])) token (untemplate-list tokens')))))) + (#Cons [token tokens']) + (_ann (#Form (list (_ann (#Tag ["lux" "Cons"])) token (untemplate-list tokens'))))})) (def:''' (list/compose xs ys) #;Nil (All [a] (-> ($' List a) ($' List a) ($' List a))) ("lux case" xs - (#Cons x xs') - (#Cons x (list/compose xs' ys)) + {(#Cons x xs') + (#Cons x (list/compose xs' ys)) - #Nil - ys)) + #Nil + ys})) (def:''' #export (splice-helper xs ys) (#Cons [(tag$ ["lux" "hidden?"]) @@ -1565,21 +1565,21 @@ #;Nil) (-> ($' List Code) ($' List Code) ($' List Code)) ("lux case" xs - (#Cons x xs') - (#Cons x (splice-helper xs' ys)) + {(#Cons x xs') + (#Cons x (splice-helper xs' ys)) - #Nil - ys)) + #Nil + ys})) (def:''' (_$_joiner op a1 a2) #;Nil (-> Code Code Code Code) ("lux case" op - [_ (#Form parts)] - (form$ (list/compose parts (list a1 a2))) + {[_ (#Form parts)] + (form$ (list/compose parts (list a1 a2))) - _ - (form$ (list op a1 a2)))) + _ + (form$ (list op a1 a2))})) (macro:' #export (_$ tokens) (#Cons [(tag$ ["lux" "doc"]) @@ -1590,16 +1590,16 @@ (text/compose (text/compose \"Hello, \" name) \".\\nHow are you?\")")] #;Nil) ("lux case" tokens - (#Cons op tokens') - ("lux case" tokens' - (#Cons first nexts) - (return (list (fold (_$_joiner op) first nexts))) + {(#Cons op tokens') + ("lux case" tokens' + {(#Cons first nexts) + (return (list (fold (_$_joiner op) first nexts))) + _ + (fail "Wrong syntax for _$")}) + _ - (fail "Wrong syntax for _$")) - - _ - (fail "Wrong syntax for _$"))) + (fail "Wrong syntax for _$")})) (macro:' #export ($_ tokens) (#Cons [(tag$ ["lux" "doc"]) @@ -1610,16 +1610,16 @@ (text/compose \"Hello, \" (text/compose name \".\\nHow are you?\"))")] #;Nil) ("lux case" tokens - (#Cons op tokens') - ("lux case" (reverse tokens') - (#Cons last prevs) - (return (list (fold (_$_joiner op) last prevs))) + {(#Cons op tokens') + ("lux case" (reverse tokens') + {(#Cons last prevs) + (return (list (fold (_$_joiner op) last prevs))) + _ + (fail "Wrong syntax for $_")}) + _ - (fail "Wrong syntax for $_")) - - _ - (fail "Wrong syntax for $_"))) + (fail "Wrong syntax for $_")})) ## (sig: (Monad m) ## (: (All [a] (-> a (m a))) @@ -1647,8 +1647,8 @@ #bind (function' [f ma] ("lux case" ma - #None #None - (#Some a) (f a)))}) + {#None #None + (#Some a) (f a)}))}) (def:''' Monad<Meta> #Nil @@ -1662,37 +1662,37 @@ (function' [f ma] (function' [state] ("lux case" (ma state) - (#Left msg) - (#Left msg) + {(#Left msg) + (#Left msg) - (#Right state' a) - (f a state'))))}) + (#Right state' a) + (f a state')})))}) (macro:' (do tokens) ("lux case" tokens - (#Cons monad (#Cons [_ (#Tuple bindings)] (#Cons body #Nil))) - (let' [g!wrap (symbol$ ["" "wrap"]) - g!bind (symbol$ ["" " bind "]) - body' (fold ("lux check" (-> (& Code Code) Code Code) - (function' [binding body'] - (let' [[var value] binding] - ("lux case" var - [_ (#Tag "" "let")] - (form$ (list (symbol$ ["lux" "let'"]) value body')) - - _ - (form$ (list g!bind - (form$ (list (text$ "lux function") (symbol$ ["" ""]) var body')) - value)))))) - body - (reverse (as-pairs bindings)))] - (return (list (form$ (list (text$ "lux case") - monad - (record$ (list [(tag$ ["lux" "wrap"]) g!wrap] [(tag$ ["lux" "bind"]) g!bind])) - body'))))) + {(#Cons monad (#Cons [_ (#Tuple bindings)] (#Cons body #Nil))) + (let' [g!wrap (symbol$ ["" "wrap"]) + g!bind (symbol$ ["" " bind "]) + body' (fold ("lux check" (-> (& Code Code) Code Code) + (function' [binding body'] + (let' [[var value] binding] + ("lux case" var + {[_ (#Tag "" "let")] + (form$ (list (symbol$ ["lux" "let'"]) value body')) + + _ + (form$ (list g!bind + (form$ (list (text$ "lux function") (symbol$ ["" ""]) var body')) + value))})))) + body + (reverse (as-pairs bindings)))] + (return (list (form$ (list (text$ "lux case") + monad + (record$ (list [(record$ (list [(tag$ ["lux" "wrap"]) g!wrap] [(tag$ ["lux" "bind"]) g!bind])) + body']))))))) - _ - (fail "Wrong syntax for do"))) + _ + (fail "Wrong syntax for do")})) (def:''' (mapM m f xs) #Nil @@ -1705,14 +1705,14 @@ ($' m ($' List b)))) (let' [{#;wrap wrap #;bind _} m] ("lux case" xs - #Nil - (wrap #Nil) - - (#Cons x xs') - (do m - [y (f x) - ys (mapM m f xs')] - (wrap (#Cons y ys))) + {#Nil + (wrap #Nil) + + (#Cons x xs') + (do m + [y (f x) + ys (mapM m f xs')] + (wrap (#Cons y ys)))} ))) (macro:' #export (if tokens) @@ -1725,39 +1725,39 @@ => \"Oh, yeah!\"")]) ("lux case" tokens - (#Cons test (#Cons then (#Cons else #Nil))) - (return (list (form$ (list (text$ "lux case") test - (bool$ true) then - (bool$ false) else)))) + {(#Cons test (#Cons then (#Cons else #Nil))) + (return (list (form$ (list (text$ "lux case") test + (record$ (list [(bool$ true) then] + [(bool$ false) else])))))) - _ - (fail "Wrong syntax for if"))) + _ + (fail "Wrong syntax for if")})) (def:''' (get k plist) #Nil (All [a] (-> Text ($' List (& Text a)) ($' Maybe a))) ("lux case" plist - (#Cons [[k' v] plist']) - (if (text/= k k') - (#Some v) - (get k plist')) + {(#Cons [[k' v] plist']) + (if (text/= k k') + (#Some v) + (get k plist')) - #Nil - #None)) + #Nil + #None})) (def:''' (put k v dict) #Nil (All [a] (-> Text a ($' List (& Text a)) ($' List (& Text a)))) ("lux case" dict - #Nil - (list [k v]) + {#Nil + (list [k v]) - (#Cons [[k' v'] dict']) - (if (text/= k k') - (#Cons [[k' v] dict']) - (#Cons [[k' v'] (put k v dict')])))) + (#Cons [[k' v'] dict']) + (if (text/= k k') + (#Cons [[k' v] dict']) + (#Cons [[k' v'] (put k v dict')]))})) (def:''' #export (log! message) (list [(tag$ ["lux" "doc"]) @@ -1777,35 +1777,35 @@ (-> Ident Text) (let' [[module name] ident] ("lux case" module - "" name - _ ($_ text/compose module ";" name)))) + {"" name + _ ($_ text/compose module ";" name)}))) (def:''' (get-meta tag def-meta) #Nil (-> Ident Code ($' Maybe Code)) (let' [[prefix name] tag] ("lux case" def-meta - [_ (#Record def-meta)] - ("lux case" def-meta - (#Cons [key value] def-meta') - ("lux case" key - [_ (#Tag [prefix' name'])] - ("lux case" [(text/= prefix prefix') - (text/= name name')] - [true true] - (#Some value) + {[_ (#Record def-meta)] + ("lux case" def-meta + {(#Cons [key value] def-meta') + ("lux case" key + {[_ (#Tag [prefix' name'])] + ("lux case" [(text/= prefix prefix') + (text/= name name')] + {[true true] + (#Some value) - _ - (get-meta tag (record$ def-meta'))) + _ + (get-meta tag (record$ def-meta'))}) - _ - (get-meta tag (record$ def-meta'))) + _ + (get-meta tag (record$ def-meta'))}) - #Nil - #None) + #Nil + #None}) - _ - #None))) + _ + #None}))) (def:''' (resolve-global-symbol ident state) #Nil @@ -1816,136 +1816,136 @@ #seed seed #expected expected #cursor cursor #scope-type-vars scope-type-vars} state] ("lux case" (get module modules) - (#Some {#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-annotations _ #module-state _}) - ("lux case" (get name defs) - (#Some [def-type def-meta def-value]) - ("lux case" (get-meta ["lux" "alias"] def-meta) - (#Some [_ (#Symbol real-name)]) - (#Right [state real-name]) + {(#Some {#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-annotations _ #module-state _}) + ("lux case" (get name defs) + {(#Some [def-type def-meta def-value]) + ("lux case" (get-meta ["lux" "alias"] def-meta) + {(#Some [_ (#Symbol real-name)]) + (#Right [state real-name]) - _ - (#Right [state ident])) + _ + (#Right [state ident])}) + #None + (#Left ($_ text/compose "Unknown definition: " (ident/encode ident)))}) + #None - (#Left ($_ text/compose "Unknown definition: " (ident/encode ident)))) - - #None - (#Left ($_ text/compose "Unknown module: " module " @ " (ident/encode ident)))))) + (#Left ($_ text/compose "Unknown module: " module " @ " (ident/encode ident)))}))) (def:''' (splice replace? untemplate tag elems) #Nil (-> Bool (-> Code ($' Meta Code)) Code ($' List Code) ($' Meta Code)) ("lux case" replace? - true - ("lux case" (any? spliced? elems) - true - (do Monad<Meta> - [elems' ("lux check" ($' Meta ($' List Code)) - (mapM Monad<Meta> - ("lux check" (-> Code ($' Meta Code)) - (function' [elem] - ("lux case" elem - [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] - (wrap spliced) - - _ - (do Monad<Meta> - [=elem (untemplate elem)] - (wrap (form$ (list (text$ "lux check") - (form$ (list (tag$ ["lux" "Apply"]) (tuple$ (list (symbol$ ["lux" "Code"]) (symbol$ ["lux" "List"]))))) - (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list =elem (tag$ ["lux" "Nil"])))))))))))) - elems))] - (wrap (wrap-meta (form$ (list tag - (form$ (list& (symbol$ ["lux" "$_"]) - (symbol$ ["lux" "splice-helper"]) - elems'))))))) - + {true + ("lux case" (any? spliced? elems) + {true + (do Monad<Meta> + [elems' ("lux check" ($' Meta ($' List Code)) + (mapM Monad<Meta> + ("lux check" (-> Code ($' Meta Code)) + (function' [elem] + ("lux case" elem + {[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] + (wrap spliced) + + _ + (do Monad<Meta> + [=elem (untemplate elem)] + (wrap (form$ (list (text$ "lux check") + (form$ (list (tag$ ["lux" "Apply"]) (tuple$ (list (symbol$ ["lux" "Code"]) (symbol$ ["lux" "List"]))))) + (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list =elem (tag$ ["lux" "Nil"])))))))))}))) + elems))] + (wrap (wrap-meta (form$ (list tag + (form$ (list& (symbol$ ["lux" "$_"]) + (symbol$ ["lux" "splice-helper"]) + elems'))))))) + + false + (do Monad<Meta> + [=elems (mapM Monad<Meta> untemplate elems)] + (wrap (wrap-meta (form$ (list tag (untemplate-list =elems))))))}) false (do Monad<Meta> [=elems (mapM Monad<Meta> untemplate elems)] - (wrap (wrap-meta (form$ (list tag (untemplate-list =elems))))))) - false - (do Monad<Meta> - [=elems (mapM Monad<Meta> untemplate elems)] - (wrap (wrap-meta (form$ (list tag (untemplate-list =elems)))))))) + (wrap (wrap-meta (form$ (list tag (untemplate-list =elems))))))})) (def:''' (untemplate replace? subst token) #Nil (-> Bool Text Code ($' Meta Code)) ("lux case" [replace? token] - [_ [_ (#Bool value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Bool"]) (bool$ value))))) + {[_ [_ (#Bool value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Bool"]) (bool$ value))))) - [_ [_ (#Nat value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Nat"]) (nat$ value))))) + [_ [_ (#Nat value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Nat"]) (nat$ value))))) - [_ [_ (#Int value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Int"]) (int$ value))))) + [_ [_ (#Int value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Int"]) (int$ value))))) - [_ [_ (#Deg value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Deg"]) (deg$ value))))) - - [_ [_ (#Frac value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Frac"]) (frac$ value))))) + [_ [_ (#Deg value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Deg"]) (deg$ value))))) + + [_ [_ (#Frac value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Frac"]) (frac$ value))))) + + [_ [_ (#Text value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Text"]) (text$ value))))) - [_ [_ (#Text value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Text"]) (text$ value))))) + [false [_ (#Tag [module name])]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module) (text$ name))))))) - [false [_ (#Tag [module name])]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module) (text$ name))))))) + [true [_ (#Tag [module name])]] + (let' [module' ("lux case" module + {"" + subst + + _ + module})] + (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module') (text$ name)))))))) - [true [_ (#Tag [module name])]] - (let' [module' ("lux case" module - "" - subst + [true [_ (#Symbol [module name])]] + (do Monad<Meta> + [real-name ("lux case" module + {"" + (if (text/= "" subst) + (wrap [module name]) + (resolve-global-symbol [subst name])) _ - module)] - (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module') (text$ name)))))))) - - [true [_ (#Symbol [module name])]] - (do Monad<Meta> - [real-name ("lux case" module - "" - (if (text/= "" subst) - (wrap [module name]) - (resolve-global-symbol [subst name])) - - _ - (wrap [module name])) - #let [[module name] real-name]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (tuple$ (list (text$ module) (text$ name)))))))) - - [false [_ (#Symbol [module name])]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (tuple$ (list (text$ module) (text$ name))))))) - - [_ [_ (#Tuple elems)]] - (splice replace? (untemplate replace? subst) (tag$ ["lux" "Tuple"]) elems) - - [true [_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))]] - (return unquoted) - - [true [_ (#Form (#Cons [[_ (#Symbol ["" "~'"])] (#Cons [keep-quoted #Nil])]))]] - (untemplate false subst keep-quoted) - - [_ [meta (#Form elems)]] - (do Monad<Meta> - [output (splice replace? (untemplate replace? subst) (tag$ ["lux" "Form"]) elems) - #let [[_ form'] output]] - (return [meta form'])) - - [_ [_ (#Record fields)]] - (do Monad<Meta> - [=fields (mapM Monad<Meta> - ("lux check" (-> (& Code Code) ($' Meta Code)) - (function' [kv] - (let' [[k v] kv] - (do Monad<Meta> - [=k (untemplate replace? subst k) - =v (untemplate replace? subst v)] - (wrap (tuple$ (list =k =v))))))) - fields)] - (wrap (wrap-meta (form$ (list (tag$ ["lux" "Record"]) (untemplate-list =fields)))))) + (wrap [module name])}) + #let [[module name] real-name]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (tuple$ (list (text$ module) (text$ name)))))))) + + [false [_ (#Symbol [module name])]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (tuple$ (list (text$ module) (text$ name))))))) + + [_ [_ (#Tuple elems)]] + (splice replace? (untemplate replace? subst) (tag$ ["lux" "Tuple"]) elems) + + [true [_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))]] + (return unquoted) + + [true [_ (#Form (#Cons [[_ (#Symbol ["" "~'"])] (#Cons [keep-quoted #Nil])]))]] + (untemplate false subst keep-quoted) + + [_ [meta (#Form elems)]] + (do Monad<Meta> + [output (splice replace? (untemplate replace? subst) (tag$ ["lux" "Form"]) elems) + #let [[_ form'] output]] + (return [meta form'])) + + [_ [_ (#Record fields)]] + (do Monad<Meta> + [=fields (mapM Monad<Meta> + ("lux check" (-> (& Code Code) ($' Meta Code)) + (function' [kv] + (let' [[k v] kv] + (do Monad<Meta> + [=k (untemplate replace? subst k) + =v (untemplate replace? subst v)] + (wrap (tuple$ (list =k =v))))))) + fields)] + (wrap (wrap-meta (form$ (list (tag$ ["lux" "Record"]) (untemplate-list =fields))))))} )) (macro:' #export (primitive tokens) @@ -1955,36 +1955,36 @@ (primitive java.util.List [java.lang.Long])")]) ("lux case" tokens - (#Cons [_ (#Symbol "" class-name)] #Nil) - (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (tag$ ["lux" "Nil"]))))) + {(#Cons [_ (#Symbol "" class-name)] #Nil) + (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (tag$ ["lux" "Nil"]))))) - (#Cons [_ (#Symbol "" class-name)] (#Cons [_ (#Tuple params)] #Nil)) - (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (untemplate-list params))))) + (#Cons [_ (#Symbol "" class-name)] (#Cons [_ (#Tuple params)] #Nil)) + (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (untemplate-list params))))) - (#Cons [_ (#Text class-name)] #Nil) - (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (tag$ ["lux" "Nil"]))))) + (#Cons [_ (#Text class-name)] #Nil) + (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (tag$ ["lux" "Nil"]))))) - (#Cons [_ (#Text class-name)] (#Cons [_ (#Tuple params)] #Nil)) - (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (untemplate-list params))))) + (#Cons [_ (#Text class-name)] (#Cons [_ (#Tuple params)] #Nil)) + (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (untemplate-list params))))) - _ - (fail "Wrong syntax for primitive"))) + _ + (fail "Wrong syntax for primitive")})) (def:'' (current-module-name state) #Nil ($' Meta Text) ("lux case" state - {#info info #source source #current-module current-module #modules modules - #scopes scopes #type-context types #host host - #seed seed #expected expected #cursor cursor - #scope-type-vars scope-type-vars} - ("lux case" current-module - (#;Some module-name) - (#Right [state module-name]) + {{#info info #source source #current-module current-module #modules modules + #scopes scopes #type-context types #host host + #seed seed #expected expected #cursor cursor + #scope-type-vars scope-type-vars} + ("lux case" current-module + {(#;Some module-name) + (#Right [state module-name]) - _ - (#Left "Cannot get the module name without a module!") - ))) + _ + (#Left "Cannot get the module name without a module!")} + )})) (macro:' #export (` tokens) (list [(tag$ ["lux" "doc"]) @@ -1994,14 +1994,14 @@ (function [(~@ args)] (~ body))))")]) ("lux case" tokens - (#Cons template #Nil) - (do Monad<Meta> - [current-module current-module-name - =template (untemplate true current-module template)] - (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template))))) + {(#Cons template #Nil) + (do Monad<Meta> + [current-module current-module-name + =template (untemplate true current-module template)] + (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template))))) - _ - (fail "Wrong syntax for `"))) + _ + (fail "Wrong syntax for `")})) (macro:' #export (`' tokens) (list [(tag$ ["lux" "doc"]) @@ -2010,26 +2010,26 @@ (function [(~@ args)] (~ body))))")]) ("lux case" tokens - (#Cons template #Nil) - (do Monad<Meta> - [=template (untemplate true "" template)] - (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template))))) + {(#Cons template #Nil) + (do Monad<Meta> + [=template (untemplate true "" template)] + (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template))))) - _ - (fail "Wrong syntax for `"))) + _ + (fail "Wrong syntax for `")})) (macro:' #export (' tokens) (list [(tag$ ["lux" "doc"]) (text$ "## Quotation as a macro. (' \"YOLO\")")]) ("lux case" tokens - (#Cons template #Nil) - (do Monad<Meta> - [=template (untemplate false "" template)] - (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template))))) + {(#Cons template #Nil) + (do Monad<Meta> + [=template (untemplate false "" template)] + (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template))))) - _ - (fail "Wrong syntax for '"))) + _ + (fail "Wrong syntax for '")})) (macro:' #export (|> tokens) (list [(tag$ ["lux" "doc"]) @@ -2041,23 +2041,23 @@ (interpose \" \" (map int/encode elems)))")]) ("lux case" tokens - (#Cons [init apps]) - (return (list (fold ("lux check" (-> Code Code Code) - (function' [app acc] - ("lux case" app - [_ (#Tuple parts)] - (tuple$ (list/compose parts (list acc))) + {(#Cons [init apps]) + (return (list (fold ("lux check" (-> Code Code Code) + (function' [app acc] + ("lux case" app + {[_ (#Tuple parts)] + (tuple$ (list/compose parts (list acc))) - [_ (#Form parts)] - (form$ (list/compose parts (list acc))) + [_ (#Form parts)] + (form$ (list/compose parts (list acc))) - _ - (` ((~ app) (~ acc)))))) - init - apps))) + _ + (` ((~ app) (~ acc)))}))) + init + apps))) - _ - (fail "Wrong syntax for |>"))) + _ + (fail "Wrong syntax for |>")})) (macro:' #export (<| tokens) (list [(tag$ ["lux" "doc"]) @@ -2069,23 +2069,23 @@ (interpose \" \" (map int/encode elems)))")]) ("lux case" (reverse tokens) - (#Cons [init apps]) - (return (list (fold ("lux check" (-> Code Code Code) - (function' [app acc] - ("lux case" app - [_ (#Tuple parts)] - (tuple$ (list/compose parts (list acc))) + {(#Cons [init apps]) + (return (list (fold ("lux check" (-> Code Code Code) + (function' [app acc] + ("lux case" app + {[_ (#Tuple parts)] + (tuple$ (list/compose parts (list acc))) - [_ (#Form parts)] - (form$ (list/compose parts (list acc))) + [_ (#Form parts)] + (form$ (list/compose parts (list acc))) - _ - (` ((~ app) (~ acc)))))) - init - apps))) + _ + (` ((~ app) (~ acc)))}))) + init + apps))) - _ - (fail "Wrong syntax for <|"))) + _ + (fail "Wrong syntax for <|")})) (def:''' #export (. f g) (list [(tag$ ["lux" "doc"]) @@ -2098,80 +2098,80 @@ #Nil (-> Code ($' Maybe Ident)) ("lux case" x - [_ (#Symbol sname)] - (#Some sname) + {[_ (#Symbol sname)] + (#Some sname) - _ - #None)) + _ + #None})) (def:''' (get-tag x) #Nil (-> Code ($' Maybe Ident)) ("lux case" x - [_ (#Tag sname)] - (#Some sname) + {[_ (#Tag sname)] + (#Some sname) - _ - #None)) + _ + #None})) (def:''' (get-name x) #Nil (-> Code ($' Maybe Text)) ("lux case" x - [_ (#Symbol "" sname)] - (#Some sname) + {[_ (#Symbol "" sname)] + (#Some sname) - _ - #None)) + _ + #None})) (def:''' (tuple->list tuple) #Nil (-> Code ($' Maybe ($' List Code))) ("lux case" tuple - [_ (#Tuple members)] - (#Some members) + {[_ (#Tuple members)] + (#Some members) - _ - #None)) + _ + #None})) (def:''' (apply-template env template) #Nil (-> RepEnv Code Code) ("lux case" template - [_ (#Symbol "" sname)] - ("lux case" (get-rep sname env) - (#Some subst) - subst + {[_ (#Symbol "" sname)] + ("lux case" (get-rep sname env) + {(#Some subst) + subst - _ - template) + _ + template}) - [meta (#Tuple elems)] - [meta (#Tuple (map (apply-template env) elems))] + [meta (#Tuple elems)] + [meta (#Tuple (map (apply-template env) elems))] - [meta (#Form elems)] - [meta (#Form (map (apply-template env) elems))] + [meta (#Form elems)] + [meta (#Form (map (apply-template env) elems))] - [meta (#Record members)] - [meta (#Record (map ("lux check" (-> (& Code Code) (& Code Code)) - (function' [kv] - (let' [[slot value] kv] - [(apply-template env slot) (apply-template env value)]))) - members))] + [meta (#Record members)] + [meta (#Record (map ("lux check" (-> (& Code Code) (& Code Code)) + (function' [kv] + (let' [[slot value] kv] + [(apply-template env slot) (apply-template env value)]))) + members))] - _ - template)) + _ + template})) (def:''' (join-map f xs) #Nil (All [a b] (-> (-> a ($' List b)) ($' List a) ($' List b))) ("lux case" xs - #Nil - #Nil + {#Nil + #Nil - (#Cons [x xs']) - (list/compose (f x) (join-map f xs')))) + (#Cons [x xs']) + (list/compose (f x) (join-map f xs'))})) (def:''' (every? p xs) #Nil @@ -2190,25 +2190,25 @@ [i.inc 1] [i.dec -1])")]) ("lux case" tokens - (#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])]) - ("lux case" [(mapM Monad<Maybe> get-name bindings) - (mapM Monad<Maybe> tuple->list data)] - [(#Some bindings') (#Some data')] - (let' [apply ("lux check" (-> RepEnv ($' List Code)) - (function' [env] (map (apply-template env) templates))) - num-bindings (length bindings')] - (if (every? (function' [sample] (_lux_proc ["int" "="] [num-bindings sample])) - (map length data')) - (|> data' - (join-map (. apply (make-env bindings'))) - return) - (fail "Irregular arguments tuples for do-template."))) + {(#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])]) + ("lux case" [(mapM Monad<Maybe> get-name bindings) + (mapM Monad<Maybe> tuple->list data)] + {[(#Some bindings') (#Some data')] + (let' [apply ("lux check" (-> RepEnv ($' List Code)) + (function' [env] (map (apply-template env) templates))) + num-bindings (length bindings')] + (if (every? (function' [sample] (_lux_proc ["int" "="] [num-bindings sample])) + (map length data')) + (|> data' + (join-map (. apply (make-env bindings'))) + return) + (fail "Irregular arguments tuples for do-template."))) - _ - (fail "Wrong syntax for do-template")) + _ + (fail "Wrong syntax for do-template")}) - _ - (fail "Wrong syntax for do-template"))) + _ + (fail "Wrong syntax for do-template")})) (do-template [<type> <category> <=-name> <lt-name> <lte-name> <gt-name> <gte-name> <eq-doc> <<-doc> <<=-doc> <>-doc> <>=-doc>] @@ -2325,28 +2325,28 @@ #Nil (-> Nat Text) ("lux case" digit - +0 "0" - +1 "1" +2 "2" +3 "3" - +4 "4" +5 "5" +6 "6" - +7 "7" +8 "8" +9 "9" - _ (_lux_proc ["io" "error"] ["undefined"]))) + {+0 "0" + +1 "1" +2 "2" +3 "3" + +4 "4" +5 "5" +6 "6" + +7 "7" +8 "8" +9 "9" + _ (_lux_proc ["io" "error"] ["undefined"])})) (def:''' (nat/encode value) #Nil (-> Nat Text) ("lux case" value - +0 - "+0" - - _ - (let' [loop ("lux check" (-> Nat Text Text) - (function' recur [input output] - (if (_lux_proc ["nat" "="] [input +0]) - (_lux_proc ["text" "append"] ["+" output]) - (recur (_lux_proc ["nat" "/"] [input +10]) - (_lux_proc ["text" "append"] [(digit-to-text (_lux_proc ["nat" "%"] [input +10])) - output])))))] - (loop value "")))) + {+0 + "+0" + + _ + (let' [loop ("lux check" (-> Nat Text Text) + (function' recur [input output] + (if (_lux_proc ["nat" "="] [input +0]) + (_lux_proc ["text" "append"] ["+" output]) + (recur (_lux_proc ["nat" "/"] [input +10]) + (_lux_proc ["text" "append"] [(digit-to-text (_lux_proc ["nat" "%"] [input +10])) + output])))))] + (loop value ""))})) (def:''' (int/abs value) #Nil @@ -2404,23 +2404,23 @@ (get name bindings))] (let' [[def-type def-meta def-value] ("lux check" Def gdef)] ("lux case" (get-meta ["lux" "macro?"] def-meta) - (#Some [_ (#Bool true)]) - ("lux case" (get-meta ["lux" "export?"] def-meta) - (#Some [_ (#Bool true)]) - (#Some ("lux coerce" Macro def-value)) - - _ - (if (text/= module current-module) + {(#Some [_ (#Bool true)]) + ("lux case" (get-meta ["lux" "export?"] def-meta) + {(#Some [_ (#Bool true)]) (#Some ("lux coerce" Macro def-value)) - #None)) - - _ - ("lux case" (get-meta ["lux" "alias"] def-meta) - (#Some [_ (#Symbol [r-module r-name])]) - (find-macro' modules current-module r-module r-name) + _ + (if (text/= module current-module) + (#Some ("lux coerce" Macro def-value)) + #None)}) + _ - #None) + ("lux case" (get-meta ["lux" "alias"] def-meta) + {(#Some [_ (#Symbol [r-module r-name])]) + (find-macro' modules current-module r-module r-name) + + _ + #None})} )) )) @@ -2428,13 +2428,13 @@ #Nil (-> Ident ($' Meta Ident)) ("lux case" ident - ["" name] - (do Monad<Meta> - [module-name current-module-name] - (wrap [module-name name])) + {["" name] + (do Monad<Meta> + [module-name current-module-name] + (wrap [module-name name])) - _ - (return ident))) + _ + (return ident)})) (def:''' (find-macro ident) #Nil @@ -2444,12 +2444,12 @@ (let' [[module name] ident] (function' [state] ("lux case" state - {#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host - #seed seed #expected expected - #cursor cursor - #scope-type-vars scope-type-vars} - (#Right state (find-macro' modules current-module module name))))))) + {{#info info #source source #current-module _ #modules modules + #scopes scopes #type-context types #host host + #seed seed #expected expected + #cursor cursor + #scope-type-vars scope-type-vars} + (#Right state (find-macro' modules current-module module name))}))))) (def:''' (macro? ident) #Nil @@ -2458,8 +2458,8 @@ [ident (normalize ident) output (find-macro ident)] (wrap ("lux case" output - (#Some _) true - #None false)))) + {(#Some _) true + #None false})))) (def:''' (list/join xs) #Nil @@ -2472,168 +2472,168 @@ (All [a] (-> a ($' List a) ($' List a))) ("lux case" xs - #Nil - xs + {#Nil + xs - (#Cons [x #Nil]) - xs + (#Cons [x #Nil]) + xs - (#Cons [x xs']) - (list& x sep (interpose sep xs')))) + (#Cons [x xs']) + (list& x sep (interpose sep xs'))})) (def:''' (macro-expand-once token) #Nil (-> Code ($' Meta ($' List Code))) ("lux case" token - [_ (#Form (#Cons [_ (#Symbol macro-name)] args))] - (do Monad<Meta> - [macro-name' (normalize macro-name) - ?macro (find-macro macro-name')] - ("lux case" ?macro - (#Some macro) - (macro args) - - #None - (return (list token)))) + {[_ (#Form (#Cons [_ (#Symbol macro-name)] args))] + (do Monad<Meta> + [macro-name' (normalize macro-name) + ?macro (find-macro macro-name')] + ("lux case" ?macro + {(#Some macro) + (macro args) + + #None + (return (list token))})) - _ - (return (list token)))) + _ + (return (list token))})) (def:''' (macro-expand token) #Nil (-> Code ($' Meta ($' List Code))) ("lux case" token - [_ (#Form (#Cons [_ (#Symbol macro-name)] args))] - (do Monad<Meta> - [macro-name' (normalize macro-name) - ?macro (find-macro macro-name')] - ("lux case" ?macro - (#Some macro) - (do Monad<Meta> - [expansion (macro args) - expansion' (mapM Monad<Meta> macro-expand expansion)] - (wrap (list/join expansion'))) - - #None - (return (list token)))) + {[_ (#Form (#Cons [_ (#Symbol macro-name)] args))] + (do Monad<Meta> + [macro-name' (normalize macro-name) + ?macro (find-macro macro-name')] + ("lux case" ?macro + {(#Some macro) + (do Monad<Meta> + [expansion (macro args) + expansion' (mapM Monad<Meta> macro-expand expansion)] + (wrap (list/join expansion'))) + + #None + (return (list token))})) - _ - (return (list token)))) + _ + (return (list token))})) (def:''' (macro-expand-all syntax) #Nil (-> Code ($' Meta ($' List Code))) ("lux case" syntax - [_ (#Form (#Cons [_ (#Symbol macro-name)] args))] - (do Monad<Meta> - [macro-name' (normalize macro-name) - ?macro (find-macro macro-name')] - ("lux case" ?macro - (#Some macro) - (do Monad<Meta> - [expansion (macro args) - expansion' (mapM Monad<Meta> macro-expand-all expansion)] - (wrap (list/join expansion'))) - - #None - (do Monad<Meta> - [args' (mapM Monad<Meta> macro-expand-all args)] - (wrap (list (form$ (#Cons (symbol$ macro-name) (list/join args')))))))) - - [_ (#Form members)] - (do Monad<Meta> - [members' (mapM Monad<Meta> macro-expand-all members)] - (wrap (list (form$ (list/join members'))))) - - [_ (#Tuple members)] - (do Monad<Meta> - [members' (mapM Monad<Meta> macro-expand-all members)] - (wrap (list (tuple$ (list/join members'))))) - - [_ (#Record pairs)] - (do Monad<Meta> - [pairs' (mapM Monad<Meta> - (function' [kv] - (let' [[key val] kv] - (do Monad<Meta> - [val' (macro-expand-all val)] - ("lux case" val' - (#;Cons val'' #;Nil) - (return [key val'']) - - _ - (fail "The value-part of a KV-pair in a record must macro-expand to a single Code."))))) - pairs)] - (wrap (list (record$ pairs')))) - - _ - (return (list syntax)))) + {[_ (#Form (#Cons [_ (#Symbol macro-name)] args))] + (do Monad<Meta> + [macro-name' (normalize macro-name) + ?macro (find-macro macro-name')] + ("lux case" ?macro + {(#Some macro) + (do Monad<Meta> + [expansion (macro args) + expansion' (mapM Monad<Meta> macro-expand-all expansion)] + (wrap (list/join expansion'))) + + #None + (do Monad<Meta> + [args' (mapM Monad<Meta> macro-expand-all args)] + (wrap (list (form$ (#Cons (symbol$ macro-name) (list/join args'))))))})) + + [_ (#Form members)] + (do Monad<Meta> + [members' (mapM Monad<Meta> macro-expand-all members)] + (wrap (list (form$ (list/join members'))))) + + [_ (#Tuple members)] + (do Monad<Meta> + [members' (mapM Monad<Meta> macro-expand-all members)] + (wrap (list (tuple$ (list/join members'))))) + + [_ (#Record pairs)] + (do Monad<Meta> + [pairs' (mapM Monad<Meta> + (function' [kv] + (let' [[key val] kv] + (do Monad<Meta> + [val' (macro-expand-all val)] + ("lux case" val' + {(#;Cons val'' #;Nil) + (return [key val'']) + + _ + (fail "The value-part of a KV-pair in a record must macro-expand to a single Code.")})))) + pairs)] + (wrap (list (record$ pairs')))) + + _ + (return (list syntax))})) (def:''' (walk-type type) #Nil (-> Code Code) ("lux case" type - [_ (#Form (#Cons [_ (#Tag tag)] parts))] - (form$ (#Cons [(tag$ tag) (map walk-type parts)])) + {[_ (#Form (#Cons [_ (#Tag tag)] parts))] + (form$ (#Cons [(tag$ tag) (map walk-type parts)])) - [_ (#Tuple members)] - (` (& (~@ (map walk-type members)))) + [_ (#Tuple members)] + (` (& (~@ (map walk-type members)))) - [_ (#Form (#Cons type-fn args))] - (fold ("lux check" (-> Code Code Code) - (function' [arg type-fn] (` (#;Apply (~ arg) (~ type-fn))))) - (walk-type type-fn) - (map walk-type args)) - - _ - type)) + [_ (#Form (#Cons type-fn args))] + (fold ("lux check" (-> Code Code Code) + (function' [arg type-fn] (` (#;Apply (~ arg) (~ type-fn))))) + (walk-type type-fn) + (map walk-type args)) + + _ + type})) (macro:' #export (type tokens) (list [(tag$ ["lux" "doc"]) (text$ "## Takes a type expression and returns it's representation as data-structure. (type (All [a] (Maybe (List a))))")]) ("lux case" tokens - (#Cons type #Nil) - (do Monad<Meta> - [type+ (macro-expand-all type)] - ("lux case" type+ - (#Cons type' #Nil) - (wrap (list (walk-type type'))) - - _ - (fail "The expansion of the type-syntax had to yield a single element."))) + {(#Cons type #Nil) + (do Monad<Meta> + [type+ (macro-expand-all type)] + ("lux case" type+ + {(#Cons type' #Nil) + (wrap (list (walk-type type'))) + + _ + (fail "The expansion of the type-syntax had to yield a single element.")})) - _ - (fail "Wrong syntax for type"))) + _ + (fail "Wrong syntax for type")})) (macro:' #export (: tokens) (list [(tag$ ["lux" "doc"]) (text$ "## The type-annotation macro. (: (List Int) (list 1 2 3))")]) ("lux case" tokens - (#Cons type (#Cons value #Nil)) - (return (list (` ("lux check" (type (~ type)) (~ value))))) + {(#Cons type (#Cons value #Nil)) + (return (list (` ("lux check" (type (~ type)) (~ value))))) - _ - (fail "Wrong syntax for :"))) + _ + (fail "Wrong syntax for :")})) (macro:' #export (:! tokens) (list [(tag$ ["lux" "doc"]) (text$ "## The type-coercion macro. (:! Dinosaur (list 1 2 3))")]) ("lux case" tokens - (#Cons type (#Cons value #Nil)) - (return (list (` ("lux coerce" (type (~ type)) (~ value))))) + {(#Cons type (#Cons value #Nil)) + (return (list (` ("lux coerce" (type (~ type)) (~ value))))) - _ - (fail "Wrong syntax for :!"))) + _ + (fail "Wrong syntax for :!")})) (def:''' (empty? xs) #Nil (All [a] (-> ($' List a) Bool)) ("lux case" xs - #Nil true - _ false)) + {#Nil true + _ false})) (do-template [<name> <type> <value>] [(def:''' (<name> xy) @@ -2648,71 +2648,71 @@ #Nil (-> ($' List Code) ($' Meta (& Code ($' Maybe ($' List Text))))) ("lux case" type-codes - (#Cons [_ (#Record pairs)] #;Nil) - (do Monad<Meta> - [members (mapM Monad<Meta> - (: (-> [Code Code] (Meta [Text Code])) - (function' [pair] - ("lux case" pair - [[_ (#Tag "" member-name)] member-type] - (return [member-name member-type]) + {(#Cons [_ (#Record pairs)] #;Nil) + (do Monad<Meta> + [members (mapM Monad<Meta> + (: (-> [Code Code] (Meta [Text Code])) + (function' [pair] + ("lux case" pair + {[[_ (#Tag "" member-name)] member-type] + (return [member-name member-type]) + + _ + (fail "Wrong syntax for variant case.")}))) + pairs)] + (return [(` (& (~@ (map second members)))) + (#Some (map first members))])) + + (#Cons type #Nil) + ("lux case" type + {[_ (#Tag "" member-name)] + (return [(` #;Unit) (#;Some (list member-name))]) + + [_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))] + (return [(` (& (~@ member-types))) (#;Some (list member-name))]) - _ - (fail "Wrong syntax for variant case.")))) - pairs)] - (return [(` (& (~@ (map second members)))) - (#Some (map first members))])) + _ + (return [type #None])}) - (#Cons type #Nil) - ("lux case" type - [_ (#Tag "" member-name)] - (return [(` #;Unit) (#;Some (list member-name))]) - - [_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))] - (return [(` (& (~@ member-types))) (#;Some (list member-name))]) + (#Cons case cases) + (do Monad<Meta> + [members (mapM Monad<Meta> + (: (-> Code (Meta [Text Code])) + (function' [case] + ("lux case" case + {[_ (#Tag "" member-name)] + (return [member-name (` Unit)]) + + [_ (#Form (#Cons [_ (#Tag "" member-name)] (#Cons member-type #Nil)))] + (return [member-name member-type]) + + [_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))] + (return [member-name (` (& (~@ member-types)))]) + + _ + (fail "Wrong syntax for variant case.")}))) + (list& case cases))] + (return [(` (| (~@ (map second members)))) + (#Some (map first members))])) _ - (return [type #None])) - - (#Cons case cases) - (do Monad<Meta> - [members (mapM Monad<Meta> - (: (-> Code (Meta [Text Code])) - (function' [case] - ("lux case" case - [_ (#Tag "" member-name)] - (return [member-name (` Unit)]) - - [_ (#Form (#Cons [_ (#Tag "" member-name)] (#Cons member-type #Nil)))] - (return [member-name member-type]) - - [_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))] - (return [member-name (` (& (~@ member-types)))]) - - _ - (fail "Wrong syntax for variant case.")))) - (list& case cases))] - (return [(` (| (~@ (map second members)))) - (#Some (map first members))])) - - _ - (fail "Improper type-definition syntax"))) + (fail "Improper type-definition syntax")})) (def:''' (gensym prefix state) #Nil (-> Text ($' Meta Code)) ("lux case" state - {#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host - #seed seed #expected expected - #cursor cursor - #scope-type-vars scope-type-vars} - (#Right {#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host - #seed (n.+ +1 seed) #expected expected - #cursor cursor - #scope-type-vars scope-type-vars} - (symbol$ ["" ($_ text/compose "__gensym__" prefix (nat/encode seed))])))) + {{#info info #source source #current-module _ #modules modules + #scopes scopes #type-context types #host host + #seed seed #expected expected + #cursor cursor + #scope-type-vars scope-type-vars} + (#Right {#info info #source source #current-module _ #modules modules + #scopes scopes #type-context types #host host + #seed (n.+ +1 seed) #expected expected + #cursor cursor + #scope-type-vars scope-type-vars} + (symbol$ ["" ($_ text/compose "__gensym__" prefix (nat/encode seed))]))})) (macro:' #export (Rec tokens) (list [(tag$ ["lux" "doc"]) @@ -2721,13 +2721,13 @@ (Rec Self [Int (List Self)])")]) ("lux case" tokens - (#Cons [_ (#Symbol "" name)] (#Cons body #Nil)) - (let' [body' (replace-syntax (list [name (` (#Apply (~ (make-bound +1)) (~ (make-bound +0))))]) - (update-bounds body))] - (return (list (` (#Apply #;Void (#UnivQ #Nil (~ body'))))))) - - _ - (fail "Wrong syntax for Rec"))) + {(#Cons [_ (#Symbol "" name)] (#Cons body #Nil)) + (let' [body' (replace-syntax (list [name (` (#Apply (~ (make-bound +1)) (~ (make-bound +0))))]) + (update-bounds body))] + (return (list (` (#Apply #;Void (#UnivQ #Nil (~ body'))))))) + + _ + (fail "Wrong syntax for Rec")})) (macro:' #export (exec tokens) (list [(tag$ ["lux" "doc"]) @@ -2738,61 +2738,61 @@ (log! \"#3\") \"YOLO\")")]) ("lux case" (reverse tokens) - (#Cons value actions) - (let' [dummy (symbol$ ["" ""])] - (return (list (fold ("lux check" (-> Code Code Code) - (function' [pre post] (` ("lux case" (~ pre) (~ dummy) (~ post))))) - value - actions)))) + {(#Cons value actions) + (let' [dummy (symbol$ ["" ""])] + (return (list (fold ("lux check" (-> Code Code Code) + (function' [pre post] (` ("lux case" (~ pre) {(~ dummy) (~ post)})))) + value + actions)))) - _ - (fail "Wrong syntax for exec"))) + _ + (fail "Wrong syntax for exec")})) (macro:' (def:' tokens) (let' [[export? tokens'] ("lux case" tokens - (#Cons [_ (#Tag ["" "export"])] tokens') - [true tokens'] + {(#Cons [_ (#Tag ["" "export"])] tokens') + [true tokens'] - _ - [false tokens]) + _ + [false tokens]}) parts (: (Maybe [Code (List Code) (Maybe Code) Code]) ("lux case" tokens' - (#Cons [_ (#Form (#Cons name args))] (#Cons type (#Cons body #Nil))) - (#Some name args (#Some type) body) - - (#Cons name (#Cons type (#Cons body #Nil))) - (#Some name #Nil (#Some type) body) - - (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil)) - (#Some name args #None body) - - (#Cons name (#Cons body #Nil)) - (#Some name #Nil #None body) + {(#Cons [_ (#Form (#Cons name args))] (#Cons type (#Cons body #Nil))) + (#Some name args (#Some type) body) + + (#Cons name (#Cons type (#Cons body #Nil))) + (#Some name #Nil (#Some type) body) + + (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil)) + (#Some name args #None body) + + (#Cons name (#Cons body #Nil)) + (#Some name #Nil #None body) - _ - #None))] + _ + #None}))] ("lux case" parts - (#Some name args ?type body) - (let' [body' ("lux case" args - #Nil - body + {(#Some name args ?type body) + (let' [body' ("lux case" args + {#Nil + body - _ - (` (function' (~ name) [(~@ args)] (~ body)))) - body'' ("lux case" ?type - (#Some type) - (` (: (~ type) (~ body'))) - - #None - body')] - (return (list (` ("lux def" (~ name) (~ body'') - [(~ cursor-code) - (#;Record (~ (if export? - (with-export-meta (tag$ ["lux" "Nil"])) - (tag$ ["lux" "Nil"]))))]))))) - - #None - (fail "Wrong syntax for def'")))) + _ + (` (function' (~ name) [(~@ args)] (~ body)))}) + body'' ("lux case" ?type + {(#Some type) + (` (: (~ type) (~ body'))) + + #None + body'})] + (return (list (` ("lux def" (~ name) (~ body'') + [(~ cursor-code) + (#;Record (~ (if export? + (with-export-meta (tag$ ["lux" "Nil"])) + (tag$ ["lux" "Nil"]))))]))))) + + #None + (fail "Wrong syntax for def'")}))) (def:' (rejoin-pair pair) (-> [Code Code] (List Code)) @@ -2802,88 +2802,88 @@ (def:' (code-to-text code) (-> Code Text) ("lux case" code - [_ (#Bool value)] - (bool/encode value) + {[_ (#Bool value)] + (bool/encode value) - [_ (#Nat value)] - (nat/encode value) + [_ (#Nat value)] + (nat/encode value) - [_ (#Int value)] - (int/encode value) + [_ (#Int value)] + (int/encode value) - [_ (#Deg value)] - (_lux_proc ["io" "error"] ["Undefined behavior."]) - - [_ (#Frac value)] - (frac/encode value) + [_ (#Deg value)] + (_lux_proc ["io" "error"] ["Undefined behavior."]) + + [_ (#Frac value)] + (frac/encode value) - [_ (#Text value)] - ($_ text/compose "\"" value "\"") - - [_ (#Symbol [prefix name])] - (if (text/= "" prefix) - name - ($_ text/compose prefix ";" name)) - - [_ (#Tag [prefix name])] - (if (text/= "" prefix) - ($_ text/compose "#" name) - ($_ text/compose "#" prefix ";" name)) - - [_ (#Form xs)] - ($_ text/compose "(" (|> xs - (map code-to-text) - (interpose " ") - reverse - (fold text/compose "")) ")") - - [_ (#Tuple xs)] - ($_ text/compose "[" (|> xs - (map code-to-text) - (interpose " ") - reverse - (fold text/compose "")) "]") - - [_ (#Record kvs)] - ($_ text/compose "{" (|> kvs - (map (function' [kv] ("lux case" kv [k v] ($_ text/compose (code-to-text k) " " (code-to-text v))))) - (interpose " ") - reverse - (fold text/compose "")) "}") + [_ (#Text value)] + ($_ text/compose "\"" value "\"") + + [_ (#Symbol [prefix name])] + (if (text/= "" prefix) + name + ($_ text/compose prefix ";" name)) + + [_ (#Tag [prefix name])] + (if (text/= "" prefix) + ($_ text/compose "#" name) + ($_ text/compose "#" prefix ";" name)) + + [_ (#Form xs)] + ($_ text/compose "(" (|> xs + (map code-to-text) + (interpose " ") + reverse + (fold text/compose "")) ")") + + [_ (#Tuple xs)] + ($_ text/compose "[" (|> xs + (map code-to-text) + (interpose " ") + reverse + (fold text/compose "")) "]") + + [_ (#Record kvs)] + ($_ text/compose "{" (|> kvs + (map (function' [kv] ("lux case" kv {[k v] ($_ text/compose (code-to-text k) " " (code-to-text v))}))) + (interpose " ") + reverse + (fold text/compose "")) "}")} )) (def:' (expander branches) (-> (List Code) (Meta (List Code))) ("lux case" branches - (#;Cons [_ (#Form (#Cons [_ (#Symbol macro-name)] macro-args))] - (#;Cons body - branches')) - (do Monad<Meta> - [??? (macro? macro-name)] - (if ??? - (do Monad<Meta> - [init-expansion (macro-expand-once (form$ (list& (symbol$ macro-name) (form$ macro-args) body branches')))] - (expander init-expansion)) - (do Monad<Meta> - [sub-expansion (expander branches')] - (wrap (list& (form$ (list& (symbol$ macro-name) macro-args)) - body - sub-expansion))))) + {(#;Cons [_ (#Form (#Cons [_ (#Symbol macro-name)] macro-args))] + (#;Cons body + branches')) + (do Monad<Meta> + [??? (macro? macro-name)] + (if ??? + (do Monad<Meta> + [init-expansion (macro-expand-once (form$ (list& (symbol$ macro-name) (form$ macro-args) body branches')))] + (expander init-expansion)) + (do Monad<Meta> + [sub-expansion (expander branches')] + (wrap (list& (form$ (list& (symbol$ macro-name) macro-args)) + body + sub-expansion))))) - (#;Cons pattern (#;Cons body branches')) - (do Monad<Meta> - [sub-expansion (expander branches')] - (wrap (list& pattern body sub-expansion))) + (#;Cons pattern (#;Cons body branches')) + (do Monad<Meta> + [sub-expansion (expander branches')] + (wrap (list& pattern body sub-expansion))) - #;Nil - (do Monad<Meta> [] (wrap (list))) + #;Nil + (do Monad<Meta> [] (wrap (list))) - _ - (fail ($_ text/compose "\"lux;case\" expects an even number of tokens: " (|> branches - (map code-to-text) - (interpose " ") - reverse - (fold text/compose "")))))) + _ + (fail ($_ text/compose "\"lux;case\" expects an even number of tokens: " (|> branches + (map code-to-text) + (interpose " ") + reverse + (fold text/compose ""))))})) (macro:' #export (case tokens) (list [(tag$ ["lux" "doc"]) @@ -2896,13 +2896,13 @@ _ #None)")]) ("lux case" tokens - (#Cons value branches) - (do Monad<Meta> - [expansion (expander branches)] - (wrap (list (` ("lux case" (~ value) (~@ expansion)))))) + {(#Cons value branches) + (do Monad<Meta> + [expansion (expander branches)] + (wrap (list (` ("lux case" (~ value) (~ (record$ (as-pairs expansion)))))))) - _ - (fail "Wrong syntax for case"))) + _ + (fail "Wrong syntax for case")})) (macro:' #export (^ tokens) (list [(tag$ ["lux" "doc"]) @@ -2987,7 +2987,7 @@ (function' [lr body'] (let' [[l r] lr] (if (symbol? l) - (` ("lux case" (~ r) (~ l) (~ body'))) + (` ("lux case" (~ r) {(~ l) (~ body')})) (` (case (~ r) (~ l) (~ body'))))))) body) list @@ -4401,7 +4401,7 @@ (wrap enhanced-target)))) target (zip2 tags members))] - (wrap (` ("lux case" (~ (symbol$ source)) (~ pattern) (~ enhanced-target)))))))) + (wrap (` ("lux case" (~ (symbol$ source)) {(~ pattern) (~ enhanced-target)}))))))) name tags&members body)] (wrap (list full-body))))) @@ -4486,7 +4486,7 @@ g!output g!_)])) (zip2 tags (enumerate members))))] - (return (list (` ("lux case" (~ record) (~ pattern) (~ g!output)))))) + (return (list (` ("lux case" (~ record) {(~ pattern) (~ g!output)}))))) _ (fail "get@ can only use records."))) @@ -4808,7 +4808,7 @@ value r-var)])) pattern'))] - (return (list (` ("lux case" (~ record) (~ pattern) (~ output))))))) + (return (list (` ("lux case" (~ record) {(~ pattern) (~ output)})))))) _ (fail "set@ can only use records."))) @@ -4894,7 +4894,7 @@ (` ((~ fun) (~ r-var))) r-var)])) pattern'))] - (return (list (` ("lux case" (~ record) (~ pattern) (~ output))))))) + (return (list (` ("lux case" (~ record) {(~ pattern) (~ output)})))))) _ (fail "update@ can only use records."))) @@ -5573,12 +5573,12 @@ (~ g!temp) #;None)) - (#;Some (~ g!temp)) - (~ g!temp) + {(#;Some (~ g!temp)) + (~ g!temp) - #;None - (case (~ g!temp) - (~@ next-branches)))))] + #;None + (case (~ g!temp) + (~@ next-branches))})))] (wrap output))) _ diff --git a/stdlib/source/lux/control/comonad.lux b/stdlib/source/lux/control/comonad.lux index eca4cd4f1..7886d8c3c 100644 --- a/stdlib/source/lux/control/comonad.lux +++ b/stdlib/source/lux/control/comonad.lux @@ -49,10 +49,10 @@ body (list;reverse (list;as-pairs bindings)))] (#;Right [state (#;Cons (` ("lux case" (~ comonad) - (~' @) - ("lux case" (~' @) - {#functor {#F;map (~ g!map)} #unwrap (~' unwrap) #split (~ g!split)} - (~ body')))) + {(~' @) + ("lux case" (~' @) + {{#functor {#F;map (~ g!map)} #unwrap (~' unwrap) #split (~ g!split)} + (~ body')})})) #;Nil)])) (#;Left "'be' bindings must have an even number of parts.")) diff --git a/stdlib/source/lux/control/monad.lux b/stdlib/source/lux/control/monad.lux index 856509baa..b9ecf5470 100644 --- a/stdlib/source/lux/control/monad.lux +++ b/stdlib/source/lux/control/monad.lux @@ -77,13 +77,13 @@ body (reverse (as-pairs bindings)))] (#;Right [state (#;Cons (` ("lux case" (~ monad) - (~' @) - ("lux case" (~' @) - {#applicative {#A;functor {#F;map (~ g!map)} - #A;wrap (~' wrap) - #A;apply (~ g!apply)} - #join (~ g!join)} - (~ body')))) + {(~' @) + ("lux case" (~' @) + {{#applicative {#A;functor {#F;map (~ g!map)} + #A;wrap (~' wrap) + #A;apply (~ g!apply)} + #join (~ g!join)} + (~ body')})})) #;Nil)])) (#;Left "'do' bindings must have an even number of parts.")) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index b1cc9735c..d8105ca0a 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -1409,11 +1409,11 @@ "YOLO")} (with-gensyms [g!value] (wrap (list (` ("lux case" (~ expr) - (#;Some (~ g!value)) - (~ g!value) + {(#;Some (~ g!value)) + (~ g!value) - #;None - (;_lux_proc ["jvm" "null"] []))))))) + #;None + (;_lux_proc ["jvm" "null"] [])})))))) (syntax: #export (try expr) {#;doc (doc "Covers the expression in a try-catch block." diff --git a/stdlib/source/lux/meta/syntax.lux b/stdlib/source/lux/meta/syntax.lux index dd10d7123..4574b9f5d 100644 --- a/stdlib/source/lux/meta/syntax.lux +++ b/stdlib/source/lux/meta/syntax.lux @@ -287,11 +287,11 @@ ((~' wrap) (do meta;Monad<Meta> [] (~ body)))))) - (#E;Success (~ g!body)) - ((~ g!body) (~ g!state)) + {(#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))))}))))))) _ (meta;fail "Wrong syntax for syntax:")))) |