diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/library/lux.lux | 2280 |
1 files changed, 1156 insertions, 1124 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index cfbf864f1..891065652 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -813,7 +813,7 @@ {#End}}}))) #0) -("lux def" def'' +("lux def" def-3 ("lux macro" (function'' [tokens] ({{#Item [export_policy @@ -830,7 +830,7 @@ {#End}]}) _ - (failure "Wrong syntax for def''")} + (failure "Wrong syntax for def-3")} tokens))) #0) @@ -846,12 +846,12 @@ tokens))) #1) -(def'' .public comment +(def-3 .public comment Macro (macro (_ tokens) (meta#in {#End}))) -(def'' .private $' +(def-3 .private $' Macro (macro (_ tokens) ({{#Item x {#End}} @@ -868,7 +868,7 @@ (failure "Wrong syntax for $'")} tokens))) -(def'' .private (list#mix f init xs) +(def-3 .private (list#mix f init xs) ... (All (_ a b) (-> (-> b a a) a (List b) a)) {#UnivQ {#End} {#UnivQ {#End} {#Function {#Function {#Parameter 1} {#Function {#Parameter 3} @@ -883,7 +883,7 @@ (list#mix f (f x init) xs')} xs)) -(def'' .private (list#reversed list) +(def-3 .private (list#reversed list) {#UnivQ {#End} {#Function ($' List {#Parameter 1}) ($' List {#Parameter 1})}} (list#mix ("lux type check" {#UnivQ {#End} @@ -892,7 +892,7 @@ {#End} list)) -(def'' .private (list#each f xs) +(def-3 .private (list#each f xs) {#UnivQ {#End} {#UnivQ {#End} {#Function {#Function {#Parameter 3} {#Parameter 1}} @@ -902,11 +902,11 @@ {#End} (list#reversed xs))) -(def'' .private Replacement_Environment +(def-3 .private Replacement_Environment Type ($' List {#Product Text Code})) -(def'' .private (replacement_environment xs ys) +(def-3 .private (replacement_environment xs ys) {#Function ($' List Text) {#Function ($' List Code) Replacement_Environment}} ({[{#Item x xs'} {#Item y ys'}] {#Item [x y] (replacement_environment xs' ys')} @@ -915,11 +915,11 @@ {#End}} [xs ys])) -(def'' .private (text#= reference sample) +(def-3 .private (text#= reference sample) {#Function Text {#Function Text Bit}} ("lux text =" reference sample)) -(def'' .private (replacement for environment) +(def-3 .private (replacement for environment) {#Function Text {#Function Replacement_Environment ($' Maybe Code)}} ({{#End} {#None} @@ -930,7 +930,7 @@ (text#= k for))} environment)) -(def'' .private (with_replacements reps syntax) +(def-3 .private (with_replacements reps syntax) {#Function Replacement_Environment {#Function Code Code}} ({[_ {#Symbol "" name}] ({{#Some replacement} @@ -953,53 +953,53 @@ syntax} syntax)) -(def'' .private (n/* param subject) +(def-3 .private (n/* param subject) {#Function Nat {#Function Nat Nat}} ("lux type as" Nat ("lux i64 *" ("lux type as" Int param) ("lux type as" Int subject)))) -(def'' .private (list#size list) +(def-3 .private (list#size list) {#UnivQ {#End} {#Function ($' List {#Parameter 1}) Nat}} (list#mix (function'' [_ acc] ("lux i64 +" 1 acc)) 0 list)) -(def'' .private (let$ binding value body) +(def-3 .private (let$ binding value body) {#Function Code {#Function Code {#Function Code Code}}} (form$ {#Item (variant$ {#Item binding {#Item body {#End}}}) {#Item value {#End}}})) -(def'' .private |#End| +(def-3 .private |#End| Code (variant$ {#Item (symbol$ [..prelude "#End"]) {#End}})) -(def'' .private (|#Item| head tail) +(def-3 .private (|#Item| head tail) {#Function Code {#Function Code Code}} (variant$ {#Item (symbol$ [..prelude "#Item"]) {#Item head {#Item tail {#End}}}})) -(def'' .private (UnivQ$ body) +(def-3 .private (UnivQ$ body) {#Function Code Code} (variant$ {#Item (symbol$ [..prelude "#UnivQ"]) {#Item ..|#End| {#Item body {#End}}}})) -(def'' .private (ExQ$ body) +(def-3 .private (ExQ$ body) {#Function Code Code} (variant$ {#Item (symbol$ [..prelude "#ExQ"]) {#Item ..|#End| {#Item body {#End}}}})) -(def'' .private quantification_level +(def-3 .private quantification_level Text ("lux text concat" double_quote ("lux text concat" "quantification_level" double_quote))) -(def'' .private quantified +(def-3 .private quantified {#Function Code Code} (let$ (local$ ..quantification_level) (nat$ 0))) -(def'' .private (quantified_type_parameter idx) +(def-3 .private (quantified_type_parameter idx) {#Function Nat Code} (variant$ {#Item (symbol$ [..prelude "#Parameter"]) {#Item (form$ {#Item (text$ "lux i64 +") @@ -1008,11 +1008,11 @@ {#End}}}}) {#End}}})) -(def'' .private (next_level depth) +(def-3 .private (next_level depth) {#Function Nat Nat} ("lux i64 +" 2 depth)) -(def'' .private (self_id? id) +(def-3 .private (self_id? id) {#Function Nat Bit} ("lux i64 =" id ("lux type as" Nat ("lux i64 *" +2 @@ -1020,7 +1020,7 @@ ("lux type as" Int id)))))) -(def'' .public (__adjusted_quantified_type__ permission depth type) +(def-3 .public (__adjusted_quantified_type__ permission depth type) {#Function Nat {#Function Nat {#Function Type Type}}} ({0 ({... Jackpot! @@ -1070,7 +1070,7 @@ type} permission)) -(def'' .private (with_correct_quantification body) +(def-3 .private (with_correct_quantification body) {#Function Code Code} (form$ {#Item (symbol$ [prelude "__adjusted_quantified_type__"]) {#Item (local$ ..quantification_level) @@ -1078,7 +1078,7 @@ {#Item body {#End}}}}})) -(def'' .private (with_quantification depth body) +(def-3 .private (with_quantification depth body) {#Function Nat {#Function Code Code}} ({g!level (let$ g!level @@ -1092,7 +1092,7 @@ body)} (local$ ..quantification_level))) -(def'' .private (initialized_quantification? lux) +(def-3 .private (initialized_quantification? lux) {#Function Lux Bit} ({[..#info _ ..#source _ ..#current_module _ ..#modules _ ..#scopes scopes ..#type_context _ ..#host _ @@ -1117,7 +1117,7 @@ scopes)} lux)) -(def'' .public All +(def-3 .public All Macro (macro (_ tokens lux) ({{#Item [_ {#Form {#Item self_name args}}] @@ -1151,7 +1151,7 @@ {#Left "Wrong syntax for All"}} tokens))) -(def'' .public Ex +(def-3 .public Ex Macro (macro (_ tokens lux) ({{#Item [_ {#Form {#Item self_name args}}] @@ -1185,7 +1185,7 @@ {#Left "Wrong syntax for Ex"}} tokens))) -(def'' .public -> +(def-3 .public -> Macro (macro (_ tokens) ({{#Item output inputs} @@ -1199,13 +1199,13 @@ (failure "Wrong syntax for ->")} (list#reversed tokens)))) -(def'' .public list +(def-3 .public list Macro (macro (_ xs) (meta#in {#Item (list#mix |#Item| |#End| (list#reversed xs)) {#End}}))) -(def'' .private partial_list +(def-3 .private partial_list Macro (macro (_ xs) ({{#Item last init} @@ -1215,7 +1215,7 @@ (failure "Wrong syntax for partial_list")} (list#reversed xs)))) -(def'' .public Union +(def-3 .public Union Macro (macro (_ tokens) ({{#End} @@ -1227,7 +1227,7 @@ prevs)))} (list#reversed tokens)))) -(def'' .public Tuple +(def-3 .public Tuple Macro (macro (_ tokens) ({{#End} @@ -1239,7 +1239,7 @@ prevs)))} (list#reversed tokens)))) -(def'' .private function' +(def-3 .private function' Macro (macro (_ tokens) (let'' [name tokens'] ({{#Item [[_ {#Symbol ["" name]}] tokens']} @@ -1267,7 +1267,7 @@ (failure "Wrong syntax for function'")} tokens')))) -(def'' .private def''' +(def-3 .private def-2 Macro (macro (_ tokens) ({{#Item [export_policy @@ -1292,35 +1292,35 @@ export_policy)))) _ - (failure "Wrong syntax for def'''")} + (failure "Wrong syntax for def-2")} tokens))) -(def''' .public Or - Macro - ..Union) +(def-2 .public Or + Macro + ..Union) -(def''' .public And - Macro - ..Tuple) +(def-2 .public And + Macro + ..Tuple) -(def''' .private (pairs xs) - (All (_ a) (-> ($' List a) ($' Maybe ($' List (Tuple a a))))) - ({{#Item x {#Item y xs'}} - ({{#Some tail} - {#Some {#Item [x y] tail}} - - {#None} - {#None}} - (pairs xs')) +(def-2 .private (pairs xs) + (All (_ a) (-> ($' List a) ($' Maybe ($' List (Tuple a a))))) + ({{#Item x {#Item y xs'}} + ({{#Some tail} + {#Some {#Item [x y] tail}} + + {#None} + {#None}} + (pairs xs')) - {#End} - {#Some {#End}} + {#End} + {#Some {#End}} - _ - {#None}} - xs)) + _ + {#None}} + xs)) -(def'' .private let' +(def-3 .private let' Macro (macro (_ tokens) ({{#Item [_ {#Tuple bindings}] {#Item body {#End}}} @@ -1342,54 +1342,54 @@ (failure "Wrong syntax for let'")} tokens))) -(def''' .private (any? p xs) - (All (_ a) - (-> (-> a Bit) ($' List a) Bit)) - ({{#End} - #0 - - {#Item x xs'} - ({[#1] #1 - [#0] (any? p xs')} - (p x))} - xs)) - -(def''' .private (with_location content) - (-> Code Code) - (tuple$ (list (tuple$ (list (text$ "") (nat$ 0) (nat$ 0))) - content))) - -(def''' .private (untemplated_list tokens) - (-> ($' List Code) Code) - ({{#End} - |#End| - - {#Item token tokens'} - (|#Item| token (untemplated_list tokens'))} - tokens)) - -(def''' .private (list#composite xs ys) - (All (_ a) (-> ($' List a) ($' List a) ($' List a))) - (list#mix (function' [head tail] {#Item head tail}) - ys - (list#reversed xs))) - -(def''' .private (right_associativity op a1 a2) - (-> Code Code Code Code) - ({[_ {#Form parts}] - (form$ (list#composite parts (list a1 a2))) +(def-2 .private (any? p xs) + (All (_ a) + (-> (-> a Bit) ($' List a) Bit)) + ({{#End} + #0 - _ - (form$ (list op a1 a2))} - op)) + {#Item x xs'} + ({[#1] #1 + [#0] (any? p xs')} + (p x))} + xs)) + +(def-2 .private (with_location content) + (-> Code Code) + (tuple$ (list (tuple$ (list (text$ "") (nat$ 0) (nat$ 0))) + content))) -(def''' .private (function#flipped func) - (All (_ a b c) - (-> (-> a b c) (-> b a c))) - (function' [right left] - (func left right))) +(def-2 .private (untemplated_list tokens) + (-> ($' List Code) Code) + ({{#End} + |#End| + + {#Item token tokens'} + (|#Item| token (untemplated_list tokens'))} + tokens)) + +(def-2 .private (list#composite xs ys) + (All (_ a) (-> ($' List a) ($' List a) ($' List a))) + (list#mix (function' [head tail] {#Item head tail}) + ys + (list#reversed xs))) + +(def-2 .private (right_associativity op a1 a2) + (-> Code Code Code Code) + ({[_ {#Form parts}] + (form$ (list#composite parts (list a1 a2))) + + _ + (form$ (list op a1 a2))} + op)) + +(def-2 .private (function#flipped func) + (All (_ a b c) + (-> (-> a b c) (-> b a c))) + (function' [right left] + (func left right))) -(def'' .public left +(def-3 .public left Macro (macro (_ tokens) ({{#Item op tokens'} @@ -1404,7 +1404,7 @@ (failure "Wrong syntax for left")} tokens))) -(def'' .public right +(def-3 .public right Macro (macro (_ tokens) ({{#Item op tokens'} @@ -1419,7 +1419,7 @@ (failure "Wrong syntax for right")} tokens))) -(def''' .public all Macro ..right) +(def-2 .public all Macro ..right) ... (type (Monad m) ... (Interface @@ -1439,35 +1439,35 @@ ["#in" "#then"] #0) -(def''' .private maybe#monad - ($' Monad Maybe) - [#in - (function' [x] {#Some x}) - - #then - (function' [f ma] - ({{#None} {#None} - {#Some a} (f a)} - ma))]) - -(def''' .private meta#monad - ($' Monad Meta) - [#in - (function' [x] - (function' [state] - {#Right state x})) - - #then - (function' [f ma] - (function' [state] - ({{#Left msg} - {#Left msg} +(def-2 .private maybe#monad + ($' Monad Maybe) + [#in + (function' [x] {#Some x}) + + #then + (function' [f ma] + ({{#None} {#None} + {#Some a} (f a)} + ma))]) + +(def-2 .private meta#monad + ($' Monad Meta) + [#in + (function' [x] + (function' [state] + {#Right state x})) + + #then + (function' [f ma] + (function' [state] + ({{#Left msg} + {#Left msg} - {#Right [state' a]} - (f a state')} - (ma state))))]) + {#Right [state' a]} + (f a state')} + (ma state))))]) -(def'' .private do +(def-3 .private do Macro (macro (_ tokens) ({{#Item monad {#Item [_ {#Tuple bindings}] {#Item body {#End}}}} @@ -1507,41 +1507,41 @@ (failure "Wrong syntax for do")} tokens))) -(def''' .private (monad#each m f xs) - (All (_ m a b) - (-> ($' Monad m) - (-> a ($' m b)) - ($' List a) - ($' m ($' List b)))) - (let' [[..#in in ..#then _] m] - ({{#End} - (in {#End}) - - {#Item x xs'} - (do m - [y (f x) - ys (monad#each m f xs')] - (in {#Item y ys}))} - xs))) - -(def''' .private (monad#mix m f y xs) - (All (_ m a b) - (-> ($' Monad m) - (-> a b ($' m b)) - b - ($' List a) - ($' m b))) - (let' [[..#in in ..#then _] m] - ({{#End} - (in y) - - {#Item x xs'} - (do m - [y' (f x y)] - (monad#mix m f y' xs'))} - xs))) - -(def'' .public if +(def-2 .private (monad#each m f xs) + (All (_ m a b) + (-> ($' Monad m) + (-> a ($' m b)) + ($' List a) + ($' m ($' List b)))) + (let' [[..#in in ..#then _] m] + ({{#End} + (in {#End}) + + {#Item x xs'} + (do m + [y (f x) + ys (monad#each m f xs')] + (in {#Item y ys}))} + xs))) + +(def-2 .private (monad#mix m f y xs) + (All (_ m a b) + (-> ($' Monad m) + (-> a b ($' m b)) + b + ($' List a) + ($' m b))) + (let' [[..#in in ..#then _] m] + ({{#End} + (in y) + + {#Item x xs'} + (do m + [y' (f x y)] + (monad#mix m f y' xs'))} + xs))) + +(def-3 .public if Macro (macro (_ tokens) ({{#Item test {#Item then {#Item else {#End}}}} @@ -1553,120 +1553,96 @@ (failure "Wrong syntax for if")} tokens))) -(def''' .private PList - Type - (All (_ a) ($' List (Tuple Text a)))) - -(def''' .private (plist#value k plist) - (All (_ a) - (-> Text ($' PList a) ($' Maybe a))) - ({{#Item [[k' v] plist']} - (if (text#= k k') - {#Some v} - (plist#value k plist')) - - {#End} - {#None}} - plist)) - -(def''' .private (plist#with k v plist) - (All (_ a) - (-> Text a ($' PList a) ($' PList a))) - ({{#Item [k' v'] plist'} - (if (text#= k k') - (partial_list [k v] plist') - (partial_list [k' v'] (plist#with k v plist'))) - - {#End} - (list [k v])} - plist)) - -(def''' .private (global_symbol full_name state) - (-> Symbol ($' Meta Symbol)) - (let' [[module name] full_name - [..#info info ..#source source ..#current_module _ ..#modules modules - ..#scopes scopes ..#type_context types ..#host host - ..#seed seed ..#expected expected ..#location location ..#extensions extensions - ..#scope_type_vars scope_type_vars ..#eval _eval] state] - ({{#Some [..#module_hash _ ..#module_aliases _ ..#definitions definitions ..#imports _ ..#module_state _]} - ({{#Some constant} - ({{#Definition _} {#Right [state full_name]} - {#Tag _} {#Right [state full_name]} - {#Slot _} {#Right [state full_name]} - {#Type _} {#Right [state full_name]} - - {#Alias real_name} - {#Right [state real_name]}} - constant) - - {#None} - {#Left (all text#composite "Unknown definition: " (symbol#encoded full_name))}} - (plist#value name definitions)) - - {#None} - {#Left (all text#composite "Unknown module: " module " @ " (symbol#encoded full_name))}} - (plist#value module modules)))) - -(def''' .private (:List<Code> expression) - (-> Code Code) - (let' [type (variant$ (list (symbol$ [..prelude "#Apply"]) - (symbol$ [..prelude "Code"]) - (symbol$ [..prelude "List"])))] - (form$ (list (text$ "lux type check") type expression)))) +(def-2 .private PList + Type + (All (_ a) ($' List (Tuple Text a)))) -(def''' .private (spliced replace? untemplated elems) - (-> Bit (-> Code ($' Meta Code)) ($' List Code) ($' Meta Code)) - ({[#1] ({{#End} - (meta#in |#End|) - - {#Item lastI inits} - (do meta#monad - [lastO ({[_ {#Form {#Item [[_ {#Symbol ["" "~+"]}] {#Item [spliced {#End}]}]}}] - (in (:List<Code> spliced)) +(def-2 .private (plist#value k plist) + (All (_ a) + (-> Text ($' PList a) ($' Maybe a))) + ({{#Item [[k' v] plist']} + (if (text#= k k') + {#Some v} + (plist#value k plist')) - _ - (do meta#monad - [lastO (untemplated lastI)] - (in (:List<Code> (|#Item| lastO |#End|))))} - lastI)] - (monad#mix meta#monad - (function' [leftI rightO] - ({[_ {#Form {#Item [[_ {#Symbol ["" "~+"]}] {#Item [spliced {#End}]}]}}] - (let' [g!in-module (form$ (list (text$ "lux in-module") - (text$ ..prelude) - (symbol$ [..prelude "list#composite"])))] - (in (form$ (list g!in-module (:List<Code> spliced) rightO)))) + {#End} + {#None}} + plist)) - _ - (do meta#monad - [leftO (untemplated leftI)] - (in (|#Item| leftO rightO)))} - leftI)) - lastO - inits))} - (list#reversed elems)) - [#0] (do meta#monad - [=elems (monad#each meta#monad untemplated elems)] - (in (untemplated_list =elems)))} - replace?)) - -(def''' .private (untemplated_text value) - (-> Text Code) - (with_location (variant$ (list (symbol$ [..prelude "#Text"]) (text$ value))))) - -(def'' .public UnQuote +(def-2 .private (plist#with k v plist) + (All (_ a) + (-> Text a ($' PList a) ($' PList a))) + ({{#Item [k' v'] plist'} + (if (text#= k k') + (partial_list [k v] plist') + (partial_list [k' v'] (plist#with k v plist'))) + + {#End} + (list [k v])} + plist)) + +(def-2 .private (global_symbol full_name state) + (-> Symbol ($' Meta Symbol)) + (let' [[module name] full_name + [..#info info ..#source source ..#current_module _ ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed seed ..#expected expected ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] state] + ({{#Some [..#module_hash _ ..#module_aliases _ ..#definitions definitions ..#imports _ ..#module_state _]} + ({{#Some constant} + ({{#Definition _} {#Right [state full_name]} + {#Tag _} {#Right [state full_name]} + {#Slot _} {#Right [state full_name]} + {#Type _} {#Right [state full_name]} + + {#Alias real_name} + {#Right [state real_name]}} + constant) + + {#None} + {#Left (all text#composite "Unknown definition: " (symbol#encoded full_name))}} + (plist#value name definitions)) + + {#None} + {#Left (all text#composite "Unknown module: " module " @ " (symbol#encoded full_name))}} + (plist#value module modules)))) + +(def-2 .private (|List<Code>| expression) + (-> Code Code) + (let' [type (variant$ (list (symbol$ [..prelude "#Apply"]) + (symbol$ [..prelude "Code"]) + (symbol$ [..prelude "List"])))] + (form$ (list (text$ "lux type check") type expression)))) + +(def-2 .private (untemplated_text value) + (-> Text Code) + (with_location (variant$ (list (symbol$ [..prelude "#Text"]) (text$ value))))) + +(def-3 .public UnQuote Type {#Primitive "#Macro/UnQuote" {#End}}) -(def'' .public (unquote it) +(def-3 .public (unquote it) (-> Macro UnQuote) ("lux type as" UnQuote it)) -(def'' .public (unquote_macro it) +(def-3 .public (unquote_macro it) (-> UnQuote Macro') ("lux type as" Macro' it)) -(def'' .private (list#one f xs) +(def-3 .public Spliced_UnQuote + Type + {#Primitive "#Macro/Spliced_UnQuote" {#End}}) + +(def-3 .public (spliced_unquote it) + (-> Macro Spliced_UnQuote) + ("lux type as" Spliced_UnQuote it)) + +(def-3 .public (spliced_unquote_macro it) + (-> Spliced_UnQuote Macro') + ("lux type as" Macro' it)) + +(def-3 .private (list#one f xs) (All (_ a b) (-> (-> a ($' Maybe b)) ($' List a) ($' Maybe b))) ({{#End} @@ -1681,7 +1657,7 @@ (f x))} xs)) -(def'' .private (in_env name state) +(def-3 .private (in_env name state) (-> Text Lux ($' Maybe Type)) (let' [[..#info info ..#source source ..#current_module _ ..#modules modules ..#scopes scopes ..#type_context types ..#host host @@ -1704,7 +1680,7 @@ locals)))) scopes))) -(def'' .private (definition_value name state) +(def-3 .private (definition_value name state) (-> Symbol ($' Meta (Tuple Type Any))) (let' [[v_module v_name] name [..#info info ..#source source ..#current_module _ ..#modules modules @@ -1741,7 +1717,7 @@ (plist#value v_name definitions))} (plist#value v_module modules)))) -(def'' .private (global_value global lux) +(def-3 .private (global_value global lux) (-> Symbol ($' Meta ($' Maybe (Tuple Type Any)))) (let' [[module short] global] ({{#Right [lux' type,value]} @@ -1760,13 +1736,13 @@ (definition_value global lux)} module)))) -(def'' .private (bit#and left right) +(def-3 .private (bit#and left right) (-> Bit Bit Bit) (if left right #0)) -(def'' .private (symbol#= left right) +(def-3 .private (symbol#= left right) (-> Symbol Symbol Bit) (let' [[moduleL shortL] left [moduleR shortR] right] @@ -1774,12 +1750,12 @@ (text#= moduleL moduleR) (text#= shortL shortR)))) -(def'' .private (every? ?) +(def-3 .private (every? ?) (All (_ a) (-> (-> a Bit) ($' List a) Bit)) (list#mix (function' [_2 _1] (if _1 (? _2) #0)) #1)) -(def'' .private (zipped_2 xs ys) +(def-3 .private (zipped_2 xs ys) (All (_ a b) (-> ($' List a) ($' List b) ($' List (Tuple a b)))) ({{#Item x xs'} @@ -1794,7 +1770,7 @@ (list)} xs)) -(def'' .private (type#= left right) +(def-3 .private (type#= left right) (-> Type Type Bit) ({[{#Primitive nameL parametersL} {#Primitive nameR parametersR}] (all bit#and @@ -1855,26 +1831,18 @@ #0} [left right])) -(def''' .private (one_expansion it) - (-> ($' Meta ($' List Code)) ($' Meta Code)) - (do meta#monad - [it it] - ({{#Item it {#End}} - (in it) - - _ - (failure "Must expand to a single element.")} - it))) +(def-2 .private (one_expansion it) + (-> ($' Meta ($' List Code)) ($' Meta Code)) + (do meta#monad + [it it] + ({{#Item it {#End}} + (in it) -(def''' .private (untemplated_form @form untemplated replace? subst elements) - (-> Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) - ($' Meta Code)) - (do meta#monad - [output (spliced replace? (untemplated replace? subst) elements) - .let' [[_ output'] (with_location (variant$ (list (symbol$ [..prelude "#Form"]) output)))]] - (in [@form output']))) + _ + (failure "Must expand to 1 element.")} + it))) -(def'' .private (current_module_name state) +(def-3 .private (current_module_name state) ($' Meta Text) ({[..#info info ..#source source ..#current_module current_module ..#modules modules ..#scopes scopes ..#type_context types ..#host host @@ -1888,87 +1856,137 @@ current_module)} state)) -(def''' .private (normal name) - (-> Symbol ($' Meta Symbol)) - ({["" name] - (do meta#monad - [module_name ..current_module_name] - (in [module_name name])) - - _ - (meta#in name)} - name)) - -(def''' .private (untemplated replace? subst token) - (-> Bit Text Code ($' Meta Code)) - ({[_ [_ {#Bit value}]] - (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Bit"]) (bit$ value))))) +(def-2 .private (normal name) + (-> Symbol ($' Meta Symbol)) + ({["" name] + (do meta#monad + [module_name ..current_module_name] + (in [module_name name])) - [_ [_ {#Nat value}]] - (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Nat"]) (nat$ value))))) - - [_ [_ {#Int value}]] - (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Int"]) (int$ value))))) - - [_ [_ {#Rev value}]] - (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Rev"]) (rev$ value))))) - - [_ [_ {#Frac value}]] - (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Frac"]) (frac$ value))))) + _ + (meta#in name)} + name)) - [_ [_ {#Text value}]] - (meta#in (untemplated_text value)) +(def-2 .private (untemplated_composite tag @form untemplated replace? subst elements) + (-> Text Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) + ($' Meta Code)) + (do meta#monad + [.let' [cons ("lux type check" + (-> Code Code ($' Meta Code)) + (function' [head tail] + (do meta#monad + [head (untemplated replace? subst head)] + (in (|#Item| head tail)))))] + output (if replace? + (monad#mix meta#monad + (function' [head tail] + ({[@composite {#Form {#Item [@symbol {#Symbol global}] parameters}}] + (do meta#monad + [|global| (..normal global) + ?type,value (global_value |global|)] + ({{#Some [type value]} + (if (type#= Spliced_UnQuote type) + (do meta#monad + [.let' [it (spliced_unquote_macro ("lux type as" Spliced_UnQuote value))] + output (one_expansion (it {#Item tail parameters})) + .let' [[_ output] output]] + (in [@composite output])) + (cons head tail)) + + {#None} + (cons head tail)} + ?type,value)) - [#1 [_ {#Symbol [module name]}]] - (do meta#monad - [real_name ({"" - (if (text#= "" subst) - (in [module name]) - (global_symbol [subst name])) + _ + (cons head tail)} + head)) + |#End| + (list#reversed elements)) + (do meta#monad + [=elements (monad#each meta#monad (untemplated replace? subst) elements)] + (in (untemplated_list =elements)))) + .let' [[_ output'] (with_location (variant$ (list (symbol$ [..prelude tag]) output)))]] + (in [@form output']))) + +(def-2 .private untemplated_form + (-> Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) + ($' Meta Code)) + (untemplated_composite "#Form")) + +(def-2 .private untemplated_variant + (-> Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) + ($' Meta Code)) + (untemplated_composite "#Variant")) + +(def-2 .private untemplated_tuple + (-> Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) + ($' Meta Code)) + (untemplated_composite "#Tuple")) + +(def-2 .private (untemplated replace? subst token) + (-> Bit Text Code ($' Meta Code)) + ({[_ [_ {#Bit value}]] + (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Bit"]) (bit$ value))))) + + [_ [_ {#Nat value}]] + (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Nat"]) (nat$ value))))) + + [_ [_ {#Int value}]] + (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Int"]) (int$ value))))) + + [_ [_ {#Rev value}]] + (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Rev"]) (rev$ value))))) + + [_ [_ {#Frac value}]] + (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Frac"]) (frac$ value))))) - _ - (in [module name])} - module) - .let' [[module name] real_name]] - (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Symbol"]) (tuple$ (list (text$ module) (text$ name)))))))) + [_ [_ {#Text value}]] + (meta#in (untemplated_text value)) - [#0 [_ {#Symbol [module name]}]] - (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Symbol"]) (tuple$ (list (text$ module) (text$ name))))))) + [#1 [_ {#Symbol [module name]}]] + (do meta#monad + [real_name ({"" + (if (text#= "" subst) + (in [module name]) + (global_symbol [subst name])) - [#1 [@form {#Form {#Item [@symbol {#Symbol global}] parameters}}]] - (do meta#monad - [|global| (..normal global) - ?type,value (global_value |global|)] - ({{#Some [type value]} - (if (type#= UnQuote type) - (do meta#monad - [.let' [it (unquote_macro ("lux type as" UnQuote value))] - output (one_expansion (it parameters)) - .let' [[_ output] output]] - (in [@form output])) - (untemplated_form @form untemplated replace? subst {#Item [@symbol {#Symbol global}] parameters})) - - {#None} - (untemplated_form @form untemplated replace? subst {#Item [@symbol {#Symbol global}] parameters})} - ?type,value)) + _ + (in [module name])} + module) + .let' [[module name] real_name]] + (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Symbol"]) (tuple$ (list (text$ module) (text$ name)))))))) + + [#0 [_ {#Symbol [module name]}]] + (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Symbol"]) (tuple$ (list (text$ module) (text$ name))))))) + + [#1 [@composite {#Form {#Item [@symbol {#Symbol global}] parameters}}]] + (do meta#monad + [|global| (..normal global) + ?type,value (global_value |global|)] + ({{#Some [type value]} + (if (type#= UnQuote type) + (do meta#monad + [.let' [it (unquote_macro ("lux type as" UnQuote value))] + output (one_expansion (it parameters)) + .let' [[_ output] output]] + (in [@composite output])) + (untemplated_form @composite untemplated replace? subst {#Item [@symbol {#Symbol global}] parameters})) + + {#None} + (untemplated_form @composite untemplated replace? subst {#Item [@symbol {#Symbol global}] parameters})} + ?type,value)) - [_ [@form {#Form elements}]] - (untemplated_form @form untemplated replace? subst elements) + [_ [@composite {#Form elements}]] + (untemplated_form @composite untemplated replace? subst elements) - [_ [meta {#Variant elems}]] - (do meta#monad - [output (spliced replace? (untemplated replace? subst) elems) - .let' [[_ output'] (with_location (variant$ (list (symbol$ [..prelude "#Variant"]) output)))]] - (in [meta output'])) + [_ [@composite {#Variant elements}]] + (untemplated_variant @composite untemplated replace? subst elements) - [_ [meta {#Tuple elems}]] - (do meta#monad - [output (spliced replace? (untemplated replace? subst) elems) - .let' [[_ output'] (with_location (variant$ (list (symbol$ [..prelude "#Tuple"]) output)))]] - (in [meta output']))} - [replace? token])) + [_ [@composite {#Tuple elements}]] + (untemplated_tuple @composite untemplated replace? subst elements)} + [replace? token])) -(def'' .public Primitive +(def-3 .public Primitive Macro (macro (_ tokens) ({{#Item [_ {#Text class_name}] {#End}} @@ -1981,7 +1999,7 @@ (failure "Wrong syntax for Primitive")} tokens))) -(def'' .public ` +(def-3 .public ` Macro (macro (_ tokens) ({{#Item template {#End}} @@ -1996,7 +2014,7 @@ (failure "Wrong syntax for `")} tokens))) -(def'' .public `' +(def-3 .public `' Macro (macro (_ tokens) ({{#Item template {#End}} @@ -2008,7 +2026,7 @@ (failure "Wrong syntax for `'")} tokens))) -(def'' .public ' +(def-3 .public ' Macro (macro (_ tokens) ({{#Item template {#End}} @@ -2020,7 +2038,7 @@ (failure "Wrong syntax for '")} tokens))) -(def'' .public ~ +(def-3 .public ~ UnQuote (..unquote (macro (_ tokens) @@ -2033,7 +2051,7 @@ (failure (wrong_syntax_error [..prelude "~"]))} tokens)))) -(def'' .public ~! +(def-3 .public ~! UnQuote (..unquote (macro (_ tokens) @@ -2050,7 +2068,7 @@ (failure (wrong_syntax_error [..prelude "~!"]))} tokens)))) -(def'' .public ~' +(def-3 .public ~' UnQuote (..unquote (macro (_ tokens) @@ -2064,7 +2082,21 @@ (failure (wrong_syntax_error [..prelude "~'"]))} tokens)))) -(def'' .public |> +(def-3 .public ~+ + Spliced_UnQuote + (let' [g!list#composite (form$ (list (text$ "lux in-module") + (text$ ..prelude) + (symbol$ [..prelude "list#composite"])))] + (..spliced_unquote + (macro (_ tokens) + ({{#Item tail {#Item it {#End}}} + (meta#in (list (form$ (list g!list#composite (|List<Code>| it) tail)))) + + _ + (failure (wrong_syntax_error [..prelude "~+"]))} + tokens))))) + +(def-3 .public |> Macro (macro (_ tokens) ({{#Item [init apps]} @@ -2089,7 +2121,7 @@ (failure "Wrong syntax for |>")} tokens))) -(def'' .public <| +(def-3 .public <| Macro (macro (_ tokens) ({{#Item [init apps]} @@ -2114,91 +2146,91 @@ (failure "Wrong syntax for <|")} (list#reversed tokens)))) -(def''' .private (function#composite f g) - (All (_ a b c) - (-> (-> b c) (-> a b) (-> a c))) - (function' [x] (f (g x)))) +(def-2 .private (function#composite f g) + (All (_ a b c) + (-> (-> b c) (-> a b) (-> a c))) + (function' [x] (f (g x)))) -(def''' .private (symbol_name x) - (-> Code ($' Maybe Symbol)) - ({[_ {#Symbol sname}] - {#Some sname} +(def-2 .private (symbol_name x) + (-> Code ($' Maybe Symbol)) + ({[_ {#Symbol sname}] + {#Some sname} - _ - {#None}} - x)) + _ + {#None}} + x)) -(def''' .private (symbol_short x) - (-> Code ($' Maybe Text)) - ({[_ {#Symbol "" sname}] - {#Some sname} +(def-2 .private (symbol_short x) + (-> Code ($' Maybe Text)) + ({[_ {#Symbol "" sname}] + {#Some sname} - _ - {#None}} - x)) + _ + {#None}} + x)) -(def''' .private (tuple_list tuple) - (-> Code ($' Maybe ($' List Code))) - ({[_ {#Tuple members}] - {#Some members} +(def-2 .private (tuple_list tuple) + (-> Code ($' Maybe ($' List Code))) + ({[_ {#Tuple members}] + {#Some members} - _ - {#None}} - tuple)) + _ + {#None}} + tuple)) -(def''' .private (realized_template env template) - (-> Replacement_Environment Code Code) - ({[_ {#Symbol "" sname}] - ({{#Some subst} - subst +(def-2 .private (realized_template env template) + (-> Replacement_Environment Code Code) + ({[_ {#Symbol "" sname}] + ({{#Some subst} + subst - _ - template} - (..replacement sname env)) + _ + template} + (..replacement sname env)) - [meta {#Form elems}] - [meta {#Form (list#each (realized_template env) elems)}] + [meta {#Form elems}] + [meta {#Form (list#each (realized_template env) elems)}] - [meta {#Tuple elems}] - [meta {#Tuple (list#each (realized_template env) elems)}] + [meta {#Tuple elems}] + [meta {#Tuple (list#each (realized_template env) elems)}] - [meta {#Variant elems}] - [meta {#Variant (list#each (realized_template env) elems)}] + [meta {#Variant elems}] + [meta {#Variant (list#each (realized_template env) elems)}] - _ - template} - template)) - -(def''' .private (high_bits value) - (-> ($' I64 Any) I64) - ("lux i64 right-shift" 32 value)) - -(def''' .private low_mask - I64 - (|> 1 ("lux i64 left-shift" 32) ("lux i64 -" 1))) - -(def''' .private (low_bits value) - (-> ($' I64 Any) I64) - ("lux i64 and" low_mask value)) - -(def''' .private (n/< reference sample) - (-> Nat Nat Bit) - (let' [referenceH (high_bits reference) - sampleH (high_bits sample)] - (if ("lux i64 <" referenceH sampleH) - #1 - (if ("lux i64 =" referenceH sampleH) - ("lux i64 <" - (low_bits reference) - (low_bits sample)) - #0)))) - -(def''' .private (list#conjoint xs) - (All (_ a) - (-> ($' List ($' List a)) ($' List a))) - (list#mix list#composite {#End} (list#reversed xs))) - -(def'' .public with_template + _ + template} + template)) + +(def-2 .private (high_bits value) + (-> ($' I64 Any) I64) + ("lux i64 right-shift" 32 value)) + +(def-2 .private low_mask + I64 + (|> 1 ("lux i64 left-shift" 32) ("lux i64 -" 1))) + +(def-2 .private (low_bits value) + (-> ($' I64 Any) I64) + ("lux i64 and" low_mask value)) + +(def-2 .private (n/< reference sample) + (-> Nat Nat Bit) + (let' [referenceH (high_bits reference) + sampleH (high_bits sample)] + (if ("lux i64 <" referenceH sampleH) + #1 + (if ("lux i64 =" referenceH sampleH) + ("lux i64 <" + (low_bits reference) + (low_bits sample)) + #0)))) + +(def-2 .private (list#conjoint xs) + (All (_ a) + (-> ($' List ($' List a)) ($' List a))) + (list#mix list#composite {#End} (list#reversed xs))) + +(def-3 .public with_template Macro (macro (_ tokens) ({{#Item [[_ {#Tuple bindings}] {#Item [[_ {#Tuple templates}] data]}]} @@ -2223,394 +2255,394 @@ (failure (..wrong_syntax_error [..prelude "with_template"]))} tokens))) -(def''' .private (n// param subject) - (-> Nat Nat Nat) - (if ("lux i64 <" +0 ("lux type as" Int param)) - (if (n/< param subject) - 0 - 1) - (let' [quotient (|> subject - ("lux i64 right-shift" 1) - ("lux i64 /" ("lux type as" Int param)) - ("lux i64 left-shift" 1)) - flat ("lux i64 *" - ("lux type as" Int param) - ("lux type as" Int quotient)) - remainder ("lux i64 -" flat subject)] - (if (n/< param remainder) - quotient - ("lux i64 +" 1 quotient))))) - -(def''' .private (n/% param subject) - (-> Nat Nat Nat) - (let' [flat ("lux i64 *" - ("lux type as" Int param) - ("lux type as" Int (n// param subject)))] - ("lux i64 -" flat subject))) - -(def''' .private (n/min left right) - (-> Nat Nat Nat) - (if (n/< right left) - left - right)) - -(def''' .private (bit#encoded x) - (-> Bit Text) - (if x "#1" "#0")) - -(def''' .private (digit::format digit) - (-> Nat Text) - ({[0] "0" - [1] "1" [2] "2" [3] "3" - [4] "4" [5] "5" [6] "6" - [7] "7" [8] "8" [9] "9" - _ ("lux io error" "@digit::format Undefined behavior.")} - digit)) - -(def''' .private (nat#encoded value) - (-> Nat Text) - ({[0] "0" - _ (let' [loop ("lux type check" (-> Nat Text Text) - (function' again [input output] - (if ("lux i64 =" 0 input) - output - (again (n// 10 input) - (text#composite (|> input (n/% 10) digit::format) - output)))))] - (loop value ""))} +(def-2 .private (n// param subject) + (-> Nat Nat Nat) + (if ("lux i64 <" +0 ("lux type as" Int param)) + (if (n/< param subject) + 0 + 1) + (let' [quotient (|> subject + ("lux i64 right-shift" 1) + ("lux i64 /" ("lux type as" Int param)) + ("lux i64 left-shift" 1)) + flat ("lux i64 *" + ("lux type as" Int param) + ("lux type as" Int quotient)) + remainder ("lux i64 -" flat subject)] + (if (n/< param remainder) + quotient + ("lux i64 +" 1 quotient))))) + +(def-2 .private (n/% param subject) + (-> Nat Nat Nat) + (let' [flat ("lux i64 *" + ("lux type as" Int param) + ("lux type as" Int (n// param subject)))] + ("lux i64 -" flat subject))) + +(def-2 .private (n/min left right) + (-> Nat Nat Nat) + (if (n/< right left) + left + right)) + +(def-2 .private (bit#encoded x) + (-> Bit Text) + (if x "#1" "#0")) + +(def-2 .private (digit::format digit) + (-> Nat Text) + ({[0] "0" + [1] "1" [2] "2" [3] "3" + [4] "4" [5] "5" [6] "6" + [7] "7" [8] "8" [9] "9" + _ ("lux io error" "@digit::format Undefined behavior.")} + digit)) + +(def-2 .private (nat#encoded value) + (-> Nat Text) + ({[0] "0" + _ (let' [loop ("lux type check" (-> Nat Text Text) + (function' again [input output] + (if ("lux i64 =" 0 input) + output + (again (n// 10 input) + (text#composite (|> input (n/% 10) digit::format) + output)))))] + (loop value ""))} + value)) + +(def-2 .private (int#abs value) + (-> Int Int) + (if ("lux i64 <" +0 value) + ("lux i64 *" -1 value) value)) -(def''' .private (int#abs value) - (-> Int Int) - (if ("lux i64 <" +0 value) - ("lux i64 *" -1 value) - value)) - -(def''' .private (int#encoded value) - (-> Int Text) - (if ("lux i64 =" +0 value) - "+0" - (let' [sign (if ("lux i64 <" value +0) - "+" - "-")] - (("lux type check" (-> Int Text Text) - (function' again [input output] - (if ("lux i64 =" +0 input) - (text#composite sign output) - (again ("lux i64 /" +10 input) - (text#composite (|> input ("lux i64 %" +10) ("lux type as" Nat) digit::format) - output))))) - (|> value ("lux i64 /" +10) int#abs) - (|> value ("lux i64 %" +10) int#abs ("lux type as" Nat) digit::format))))) - -(def''' .private (frac#encoded x) - (-> Frac Text) - ("lux f64 encode" x)) - -(def''' .public (not x) - (-> Bit Bit) - (if x #0 #1)) - -(def''' .private (macro_type? type) - (-> Type Bit) - ({{#Named ["library/lux" "Macro"] {#Primitive "#Macro" {#End}}} - #1 +(def-2 .private (int#encoded value) + (-> Int Text) + (if ("lux i64 =" +0 value) + "+0" + (let' [sign (if ("lux i64 <" value +0) + "+" + "-")] + (("lux type check" (-> Int Text Text) + (function' again [input output] + (if ("lux i64 =" +0 input) + (text#composite sign output) + (again ("lux i64 /" +10 input) + (text#composite (|> input ("lux i64 %" +10) ("lux type as" Nat) digit::format) + output))))) + (|> value ("lux i64 /" +10) int#abs) + (|> value ("lux i64 %" +10) int#abs ("lux type as" Nat) digit::format))))) + +(def-2 .private (frac#encoded x) + (-> Frac Text) + ("lux f64 encode" x)) + +(def-2 .public (not x) + (-> Bit Bit) + (if x #0 #1)) + +(def-2 .private (macro_type? type) + (-> Type Bit) + ({{#Named ["library/lux" "Macro"] {#Primitive "#Macro" {#End}}} + #1 - _ - #0} - type)) - -(def''' .private (named_macro' modules current_module module name) - (-> ($' List (Tuple Text Module)) - Text Text Text - ($' Maybe Macro)) - (do maybe#monad - [$module (plist#value module modules) - gdef (let' [[..#module_hash _ ..#module_aliases _ ..#definitions bindings ..#imports _ ..#module_state _] ("lux type check" Module $module)] - (plist#value name bindings))] - ({{#Alias [r_module r_name]} - (named_macro' modules current_module r_module r_name) - - {#Definition [exported? def_type def_value]} - (if (macro_type? def_type) - (if exported? - {#Some ("lux type as" Macro def_value)} - (if (text#= module current_module) - {#Some ("lux type as" Macro def_value)} - {#None})) - {#None}) - - {#Type [exported? type labels]} - {#None} - - {#Tag _} - {#None} - - {#Slot _} - {#None}} - ("lux type check" Global gdef)))) - -(def''' .private (named_macro full_name) - (-> Symbol ($' Meta ($' Maybe Macro))) - (do meta#monad - [current_module current_module_name] - (let' [[module name] full_name] - (function' [state] - ({[..#info info ..#source source ..#current_module _ ..#modules modules - ..#scopes scopes ..#type_context types ..#host host - ..#seed seed ..#expected expected - ..#location location ..#extensions extensions - ..#scope_type_vars scope_type_vars ..#eval _eval] - {#Right state (named_macro' modules current_module module name)}} - state))))) - -(def''' .private (macro? name) - (-> Symbol ($' Meta Bit)) - (do meta#monad - [name (normal name) - output (named_macro name)] - (in ({{#Some _} #1 - {#None} #0} - output)))) - -(def''' .private (list#interposed sep xs) - (All (_ a) - (-> a ($' List a) ($' List a))) - ({{#End} - xs - - {#Item [x {#End}]} - xs - - {#Item [x xs']} - (partial_list x sep (list#interposed sep xs'))} - xs)) - -(def''' .private (single_expansion token) - (-> Code ($' Meta ($' List Code))) - ({[_ {#Form {#Item [_ {#Symbol name}] args}}] - (do meta#monad - [name' (normal name) - ?macro (named_macro name')] - ({{#Some macro} - (("lux type as" Macro' macro) args) - - {#None} - (in (list token))} - ?macro)) + _ + #0} + type)) + +(def-2 .private (named_macro' modules current_module module name) + (-> ($' List (Tuple Text Module)) + Text Text Text + ($' Maybe Macro)) + (do maybe#monad + [$module (plist#value module modules) + gdef (let' [[..#module_hash _ ..#module_aliases _ ..#definitions bindings ..#imports _ ..#module_state _] ("lux type check" Module $module)] + (plist#value name bindings))] + ({{#Alias [r_module r_name]} + (named_macro' modules current_module r_module r_name) + + {#Definition [exported? def_type def_value]} + (if (macro_type? def_type) + (if exported? + {#Some ("lux type as" Macro def_value)} + (if (text#= module current_module) + {#Some ("lux type as" Macro def_value)} + {#None})) + {#None}) + + {#Type [exported? type labels]} + {#None} - _ - (meta#in (list token))} - token)) + {#Tag _} + {#None} -(def''' .private (expansion token) - (-> Code ($' Meta ($' List Code))) - ({[_ {#Form {#Item [_ {#Symbol name}] args}}] - (do meta#monad - [name' (normal name) - ?macro (named_macro name')] - ({{#Some macro} - (do meta#monad - [top_level_expansion (("lux type as" Macro' macro) args) - recursive_expansion (monad#each meta#monad expansion top_level_expansion)] - (in (list#conjoint recursive_expansion))) - - {#None} - (in (list token))} - ?macro)) + {#Slot _} + {#None}} + ("lux type check" Global gdef)))) - _ - (meta#in (list token))} - token)) +(def-2 .private (named_macro full_name) + (-> Symbol ($' Meta ($' Maybe Macro))) + (do meta#monad + [current_module current_module_name] + (let' [[module name] full_name] + (function' [state] + ({[..#info info ..#source source ..#current_module _ ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed seed ..#expected expected + ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] + {#Right state (named_macro' modules current_module module name)}} + state))))) + +(def-2 .private (macro? name) + (-> Symbol ($' Meta Bit)) + (do meta#monad + [name (normal name) + output (named_macro name)] + (in ({{#Some _} #1 + {#None} #0} + output)))) -(def''' .private (full_expansion' full_expansion name args) - (-> (-> Code ($' Meta ($' List Code))) Symbol ($' List Code) ($' Meta ($' List Code))) - (do meta#monad - [name' (normal name) - ?macro (named_macro name')] - ({{#Some macro} - (do meta#monad - [expansion (("lux type as" Macro' macro) args) - expansion' (monad#each meta#monad full_expansion expansion)] - (in (list#conjoint expansion'))) - - {#None} - (do meta#monad - [args' (monad#each meta#monad full_expansion args)] - (in (list (form$ {#Item (symbol$ name) (list#conjoint args')}))))} - ?macro))) - -(def''' .private (in_module module meta) - (All (_ a) - (-> Text ($' Meta a) ($' Meta a))) - (function' [lux] - ({[..#info info ..#source source - ..#current_module current_module ..#modules modules - ..#scopes scopes ..#type_context type_context - ..#host host ..#seed seed - ..#expected expected ..#location location - ..#extensions extensions ..#scope_type_vars scope_type_vars - ..#eval eval] - ({{#Left error} - {#Left error} - - {#Right [[..#info info' ..#source source' - ..#current_module _ ..#modules modules' - ..#scopes scopes' ..#type_context type_context' - ..#host host' ..#seed seed' - ..#expected expected' ..#location location' - ..#extensions extensions' ..#scope_type_vars scope_type_vars' - ..#eval eval'] - output]} - {#Right [[..#info info' ..#source source' - ..#current_module current_module ..#modules modules' - ..#scopes scopes' ..#type_context type_context' - ..#host host' ..#seed seed' - ..#expected expected' ..#location location' - ..#extensions extensions' ..#scope_type_vars scope_type_vars' - ..#eval eval'] - output]}} - (meta [..#info info ..#source source - ..#current_module {.#Some module} ..#modules modules - ..#scopes scopes ..#type_context type_context - ..#host host ..#seed seed - ..#expected expected ..#location location - ..#extensions extensions ..#scope_type_vars scope_type_vars - ..#eval eval]))} - lux))) - -(def''' .private (full_expansion expand_in_module?) - (-> Bit Code ($' Meta ($' List Code))) - (function' again [syntax] - ({[_ {#Form {#Item head tail}}] - ({[_ {#Form {#Item [_ {#Text "lux in-module"}] - {#Item [_ {#Text module}] - {#Item [_ {#Symbol name}] - {#End}}}}}] - (if expand_in_module? - (..in_module module (..full_expansion' again name tail)) - (do meta#monad - [members' (monad#each meta#monad again {#Item head tail})] - (in (list (form$ (list#conjoint members')))))) - - [_ {#Symbol name}] - (..full_expansion' again name tail) - - _ - (do meta#monad - [members' (monad#each meta#monad again {#Item head tail})] - (in (list (form$ (list#conjoint members')))))} - head) - - [_ {#Variant members}] - (do meta#monad - [members' (monad#each meta#monad again members)] - (in (list (variant$ (list#conjoint members'))))) - - [_ {#Tuple members}] - (do meta#monad - [members' (monad#each meta#monad again members)] - (in (list (tuple$ (list#conjoint members'))))) +(def-2 .private (list#interposed sep xs) + (All (_ a) + (-> a ($' List a) ($' List a))) + ({{#End} + xs - _ - (meta#in (list syntax))} - syntax))) + {#Item [x {#End}]} + xs -(def''' .private (text#encoded original) - (-> Text Text) - (all text#composite ..double_quote original ..double_quote)) + {#Item [x xs']} + (partial_list x sep (list#interposed sep xs'))} + xs)) + +(def-2 .private (single_expansion token) + (-> Code ($' Meta ($' List Code))) + ({[_ {#Form {#Item [_ {#Symbol name}] args}}] + (do meta#monad + [name' (normal name) + ?macro (named_macro name')] + ({{#Some macro} + (("lux type as" Macro' macro) args) + + {#None} + (in (list token))} + ?macro)) + + _ + (meta#in (list token))} + token)) + +(def-2 .private (expansion token) + (-> Code ($' Meta ($' List Code))) + ({[_ {#Form {#Item [_ {#Symbol name}] args}}] + (do meta#monad + [name' (normal name) + ?macro (named_macro name')] + ({{#Some macro} + (do meta#monad + [top_level_expansion (("lux type as" Macro' macro) args) + recursive_expansion (monad#each meta#monad expansion top_level_expansion)] + (in (list#conjoint recursive_expansion))) + + {#None} + (in (list token))} + ?macro)) -(def''' .private (code#encoded code) - (-> Code Text) - ({[_ {#Bit value}] - (bit#encoded value) + _ + (meta#in (list token))} + token)) - [_ {#Nat value}] - (nat#encoded value) +(def-2 .private (full_expansion' full_expansion name args) + (-> (-> Code ($' Meta ($' List Code))) Symbol ($' List Code) ($' Meta ($' List Code))) + (do meta#monad + [name' (normal name) + ?macro (named_macro name')] + ({{#Some macro} + (do meta#monad + [expansion (("lux type as" Macro' macro) args) + expansion' (monad#each meta#monad full_expansion expansion)] + (in (list#conjoint expansion'))) + + {#None} + (do meta#monad + [args' (monad#each meta#monad full_expansion args)] + (in (list (form$ {#Item (symbol$ name) (list#conjoint args')}))))} + ?macro))) - [_ {#Int value}] - (int#encoded value) +(def-2 .private (in_module module meta) + (All (_ a) + (-> Text ($' Meta a) ($' Meta a))) + (function' [lux] + ({[..#info info ..#source source + ..#current_module current_module ..#modules modules + ..#scopes scopes ..#type_context type_context + ..#host host ..#seed seed + ..#expected expected ..#location location + ..#extensions extensions ..#scope_type_vars scope_type_vars + ..#eval eval] + ({{#Left error} + {#Left error} + + {#Right [[..#info info' ..#source source' + ..#current_module _ ..#modules modules' + ..#scopes scopes' ..#type_context type_context' + ..#host host' ..#seed seed' + ..#expected expected' ..#location location' + ..#extensions extensions' ..#scope_type_vars scope_type_vars' + ..#eval eval'] + output]} + {#Right [[..#info info' ..#source source' + ..#current_module current_module ..#modules modules' + ..#scopes scopes' ..#type_context type_context' + ..#host host' ..#seed seed' + ..#expected expected' ..#location location' + ..#extensions extensions' ..#scope_type_vars scope_type_vars' + ..#eval eval'] + output]}} + (meta [..#info info ..#source source + ..#current_module {.#Some module} ..#modules modules + ..#scopes scopes ..#type_context type_context + ..#host host ..#seed seed + ..#expected expected ..#location location + ..#extensions extensions ..#scope_type_vars scope_type_vars + ..#eval eval]))} + lux))) + +(def-2 .private (full_expansion expand_in_module?) + (-> Bit Code ($' Meta ($' List Code))) + (function' again [syntax] + ({[_ {#Form {#Item head tail}}] + ({[_ {#Form {#Item [_ {#Text "lux in-module"}] + {#Item [_ {#Text module}] + {#Item [_ {#Symbol name}] + {#End}}}}}] + (if expand_in_module? + (..in_module module (..full_expansion' again name tail)) + (do meta#monad + [members' (monad#each meta#monad again {#Item head tail})] + (in (list (form$ (list#conjoint members')))))) + + [_ {#Symbol name}] + (..full_expansion' again name tail) + + _ + (do meta#monad + [members' (monad#each meta#monad again {#Item head tail})] + (in (list (form$ (list#conjoint members')))))} + head) + + [_ {#Variant members}] + (do meta#monad + [members' (monad#each meta#monad again members)] + (in (list (variant$ (list#conjoint members'))))) + + [_ {#Tuple members}] + (do meta#monad + [members' (monad#each meta#monad again members)] + (in (list (tuple$ (list#conjoint members'))))) - [_ {#Rev value}] - ("lux io error" "@code#encoded Undefined behavior.") - - [_ {#Frac value}] - (frac#encoded value) + _ + (meta#in (list syntax))} + syntax))) - [_ {#Text value}] - (text#encoded value) - - [_ {#Symbol [module name]}] - (symbol#encoded [module name]) - - [_ {#Form xs}] - (all text#composite "(" (|> xs - (list#each code#encoded) - (list#interposed " ") - list#reversed - (list#mix text#composite "")) ")") - - [_ {#Tuple xs}] - (all text#composite "[" (|> xs - (list#each code#encoded) - (list#interposed " ") - list#reversed - (list#mix text#composite "")) "]") - - [_ {#Variant xs}] - (all text#composite "{" (|> xs - (list#each code#encoded) - (list#interposed " ") - list#reversed - (list#mix text#composite "")) "}")} - code)) - -(def''' .private (normal_type type) - (-> Code Code) - ({[_ {#Variant {#Item [_ {#Symbol symbol}] parts}}] - (` {(~ (symbol$ symbol)) (~+ (list#each normal_type parts))}) - - [_ {#Tuple members}] - (` (Tuple (~+ (list#each normal_type members)))) - - [_ {#Form {#Item [_ {#Text "lux in-module"}] - {#Item [_ {#Text module}] - {#Item type' - {#End}}}}}] - (` ("lux in-module" (~ (text$ module)) (~ (normal_type type')))) - - [_ {#Form {#Item [_ {#Symbol ["" "~"]}] {#Item expression {#End}}}}] - expression - - [_0 {#Form {#Item [_1 {#Variant {#Item binding {#Item body {#End}}}}] - {#Item value - {#End}}}}] - [_0 {#Form {#Item [_1 {#Variant {#Item binding {#Item (normal_type body) {#End}}}}] - {#Item value - {#End}}}}] - - [_0 {#Form {#Item [_1 {#Symbol ["library/lux" "__adjusted_quantified_type__"]}] - {#Item _permission - {#Item _level - {#Item body - {#End}}}}}}] - [_0 {#Form {#Item [_1 {#Symbol [..prelude "__adjusted_quantified_type__"]}] - {#Item _permission - {#Item _level - {#Item (normal_type body) - {#End}}}}}}] - - [_ {#Form {#Item type_fn args}}] - (list#mix ("lux type check" (-> Code Code Code) - (function' [arg type_fn] (` {.#Apply (~ arg) (~ type_fn)}))) - (normal_type type_fn) - (list#each normal_type args)) +(def-2 .private (text#encoded original) + (-> Text Text) + (all text#composite ..double_quote original ..double_quote)) - _ - type} - type)) +(def-2 .private (code#encoded code) + (-> Code Text) + ({[_ {#Bit value}] + (bit#encoded value) -(def'' .public type_literal + [_ {#Nat value}] + (nat#encoded value) + + [_ {#Int value}] + (int#encoded value) + + [_ {#Rev value}] + ("lux io error" "@code#encoded Undefined behavior.") + + [_ {#Frac value}] + (frac#encoded value) + + [_ {#Text value}] + (text#encoded value) + + [_ {#Symbol [module name]}] + (symbol#encoded [module name]) + + [_ {#Form xs}] + (all text#composite "(" (|> xs + (list#each code#encoded) + (list#interposed " ") + list#reversed + (list#mix text#composite "")) ")") + + [_ {#Tuple xs}] + (all text#composite "[" (|> xs + (list#each code#encoded) + (list#interposed " ") + list#reversed + (list#mix text#composite "")) "]") + + [_ {#Variant xs}] + (all text#composite "{" (|> xs + (list#each code#encoded) + (list#interposed " ") + list#reversed + (list#mix text#composite "")) "}")} + code)) + +(def-2 .private (normal_type type) + (-> Code Code) + ({[_ {#Variant {#Item [_ {#Symbol symbol}] parts}}] + (` {(~ (symbol$ symbol)) (~+ (list#each normal_type parts))}) + + [_ {#Tuple members}] + (` (Tuple (~+ (list#each normal_type members)))) + + [_ {#Form {#Item [_ {#Text "lux in-module"}] + {#Item [_ {#Text module}] + {#Item type' + {#End}}}}}] + (` ("lux in-module" (~ (text$ module)) (~ (normal_type type')))) + + [_ {#Form {#Item [_ {#Symbol ["" "~"]}] {#Item expression {#End}}}}] + expression + + [_0 {#Form {#Item [_1 {#Variant {#Item binding {#Item body {#End}}}}] + {#Item value + {#End}}}}] + [_0 {#Form {#Item [_1 {#Variant {#Item binding {#Item (normal_type body) {#End}}}}] + {#Item value + {#End}}}}] + + [_0 {#Form {#Item [_1 {#Symbol ["library/lux" "__adjusted_quantified_type__"]}] + {#Item _permission + {#Item _level + {#Item body + {#End}}}}}}] + [_0 {#Form {#Item [_1 {#Symbol [..prelude "__adjusted_quantified_type__"]}] + {#Item _permission + {#Item _level + {#Item (normal_type body) + {#End}}}}}}] + + [_ {#Form {#Item type_fn args}}] + (list#mix ("lux type check" (-> Code Code Code) + (function' [arg type_fn] (` {.#Apply (~ arg) (~ type_fn)}))) + (normal_type type_fn) + (list#each normal_type args)) + + _ + type} + type)) + +(def-3 .public type_literal Macro (macro (_ tokens) ({{#Item type {#End}} @@ -2631,7 +2663,7 @@ (failure "Wrong syntax for type")} tokens))) -(def'' .public is +(def-3 .public is Macro (macro (_ tokens) ({{#Item type {#Item value {#End}}} @@ -2643,7 +2675,7 @@ (failure "Wrong syntax for :")} tokens))) -(def'' .public as +(def-3 .public as Macro (macro (_ tokens) ({{#Item type {#Item value {#End}}} @@ -2655,39 +2687,39 @@ (failure "Wrong syntax for as")} tokens))) -(def''' .private (empty? xs) - (All (_ a) - (-> ($' List a) Bit)) - ({{#End} #1 - _ #0} - xs)) +(def-2 .private (empty? xs) + (All (_ a) + (-> ($' List a) Bit)) + ({{#End} #1 + _ #0} + xs)) (with_template [<name> <type> <value>] - [(def''' .private (<name> xy) - (All (_ a b) - (-> (Tuple a b) <type>)) - (let' [[x y] xy] - <value>))] + [(def-2 .private (<name> xy) + (All (_ a b) + (-> (Tuple a b) <type>)) + (let' [[x y] xy] + <value>))] [product#left a x] [product#right b y]) -(def''' .private (generated_symbol prefix state) - (-> Text ($' Meta Code)) - ({[..#info info ..#source source ..#current_module _ ..#modules modules - ..#scopes scopes ..#type_context types ..#host host - ..#seed seed ..#expected expected - ..#location location ..#extensions extensions - ..#scope_type_vars scope_type_vars ..#eval _eval] - {#Right [..#info info ..#source source ..#current_module _ ..#modules modules - ..#scopes scopes ..#type_context types ..#host host - ..#seed ("lux i64 +" 1 seed) ..#expected expected - ..#location location ..#extensions extensions - ..#scope_type_vars scope_type_vars ..#eval _eval] - (local$ (all text#composite "__gensym__" prefix (nat#encoded seed)))}} - state)) - -(def'' .public exec +(def-2 .private (generated_symbol prefix state) + (-> Text ($' Meta Code)) + ({[..#info info ..#source source ..#current_module _ ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed seed ..#expected expected + ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] + {#Right [..#info info ..#source source ..#current_module _ ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed ("lux i64 +" 1 seed) ..#expected expected + ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] + (local$ (all text#composite "__gensym__" prefix (nat#encoded seed)))}} + state)) + +(def-3 .public exec Macro (macro (_ tokens) ({{#Item value actions} @@ -2702,7 +2734,7 @@ (failure "Wrong syntax for exec")} (list#reversed tokens)))) -(def'' .private def' +(def-3 .private def-1 Macro (macro (_ tokens) (let' [parts (is (Maybe [Code Code (List Code) (Maybe Code) Code]) @@ -2739,43 +2771,43 @@ (~ export_policy)))))) {#None} - (failure "Wrong syntax for def'")} + (failure "Wrong syntax for def-1")} parts)))) -(def' .private (case_expansion branches) - (-> (List Code) (Meta (List Code))) - ({{#Item [_ {#Form {#Item [_ {#Symbol name}] args}}] - {#Item body - branches'}} - (do meta#monad - [??? (macro? name)] - (if ??? - (do meta#monad - [init_expansion (single_expansion (form$ (partial_list (symbol$ name) (form$ args) body branches')))] - (case_expansion init_expansion)) - (do meta#monad - [sub_expansion (case_expansion branches')] - (in (partial_list (form$ (partial_list (symbol$ name) args)) - body - sub_expansion))))) - - {#Item pattern {#Item body branches'}} - (do meta#monad - [sub_expansion (case_expansion branches')] - (in (partial_list pattern body sub_expansion))) +(def-1 .private (case_expansion branches) + (-> (List Code) (Meta (List Code))) + ({{#Item [_ {#Form {#Item [_ {#Symbol name}] args}}] + {#Item body + branches'}} + (do meta#monad + [??? (macro? name)] + (if ??? + (do meta#monad + [init_expansion (single_expansion (form$ (partial_list (symbol$ name) (form$ args) body branches')))] + (case_expansion init_expansion)) + (do meta#monad + [sub_expansion (case_expansion branches')] + (in (partial_list (form$ (partial_list (symbol$ name) args)) + body + sub_expansion))))) + + {#Item pattern {#Item body branches'}} + (do meta#monad + [sub_expansion (case_expansion branches')] + (in (partial_list pattern body sub_expansion))) + + {#End} + (do meta#monad [] (in (list))) - {#End} - (do meta#monad [] (in (list))) - - _ - (failure (all text#composite "'lux.case' expects an even number of tokens: " (|> branches - (list#each code#encoded) - (list#interposed " ") - list#reversed - (list#mix text#composite ""))))} - branches)) - -(def'' .public case + _ + (failure (all text#composite "'lux.case' expects an even number of tokens: " (|> branches + (list#each code#encoded) + (list#interposed " ") + list#reversed + (list#mix text#composite ""))))} + branches)) + +(def-3 .public case Macro (macro (_ tokens) ({{#Item value branches} @@ -2787,7 +2819,7 @@ (failure "Wrong syntax for case")} tokens))) -(def'' .public pattern +(def-3 .public pattern Macro (macro (_ tokens) (case tokens @@ -2804,7 +2836,7 @@ _ (failure "Wrong syntax for `pattern` macro")))) -(def'' .private pattern#or +(def-3 .private pattern#or Macro (macro (_ tokens) (case tokens @@ -2821,7 +2853,7 @@ _ (failure "Wrong syntax for pattern#or")))) -(def'' .public symbol +(def-3 .public symbol Macro (macro (_ tokens) (case tokens @@ -2831,16 +2863,16 @@ _ (failure (..wrong_syntax_error [..prelude "symbol"]))))) -(def' .private (symbol? code) - (-> Code Bit) - (case code - [_ {#Symbol _}] - #1 +(def-1 .private (symbol? code) + (-> Code Bit) + (case code + [_ {#Symbol _}] + #1 - _ - #0)) + _ + #0)) -(def'' .public let +(def-3 .public let Macro (macro (_ tokens) (case tokens @@ -2865,7 +2897,7 @@ _ (failure (..wrong_syntax_error (symbol ..let)))))) -(def'' .public function +(def-3 .public function Macro (macro (_ tokens) (case (is (Maybe [Text Code (List Code) Code]) @@ -2890,279 +2922,279 @@ {#None} (failure (..wrong_syntax_error (symbol ..function)))))) -(def' .private Parser - Type - {#Named [..prelude "Parser"] - (..type_literal (All (_ a) - (-> (List Code) (Maybe [(List Code) a]))))}) +(def-1 .private Parser + Type + {#Named [..prelude "Parser"] + (..type_literal (All (_ a) + (-> (List Code) (Maybe [(List Code) a]))))}) -(def' .private (parsed parser tokens) - (All (_ a) (-> (Parser a) (List Code) (Maybe a))) - (case (parser tokens) - (pattern {#Some [(list) it]}) - {#Some it} +(def-1 .private (parsed parser tokens) + (All (_ a) (-> (Parser a) (List Code) (Maybe a))) + (case (parser tokens) + (pattern {#Some [(list) it]}) + {#Some it} - _ - {#None})) - -(def' .private (inP it tokens) - (All (_ a) - (-> a (Parser a))) - {#Some [tokens it]}) - -(def' .private (orP leftP rightP tokens) - (All (_ l r) - (-> (Parser l) - (Parser r) - (Parser (Or l r)))) - (case (leftP tokens) - {#Some [tokens left]} - {#Some [tokens {#Left left}]} + _ + {#None})) - _ - (case (rightP tokens) - {#Some [tokens right]} - {#Some [tokens {#Right right}]} +(def-1 .private (inP it tokens) + (All (_ a) + (-> a (Parser a))) + {#Some [tokens it]}) + +(def-1 .private (orP leftP rightP tokens) + (All (_ l r) + (-> (Parser l) + (Parser r) + (Parser (Or l r)))) + (case (leftP tokens) + {#Some [tokens left]} + {#Some [tokens {#Left left}]} - _ - {#None}))) - -(def' .private (eitherP leftP rightP tokens) - (All (_ a) - (-> (Parser a) - (Parser a) - (Parser a))) - (case (leftP tokens) - {#None} - (rightP tokens) - - it - it)) - -(def' .private (andP leftP rightP tokens) - (All (_ l r) - (-> (Parser l) - (Parser r) - (Parser [l r]))) - (do maybe#monad - [left (leftP tokens) - .let [[tokens left] left] - right (rightP tokens) - .let [[tokens right] right]] - (in [tokens [left right]]))) - -(def' .private (afterP leftP rightP tokens) - (All (_ l r) - (-> (Parser l) - (Parser r) - (Parser r))) - (do maybe#monad - [left (leftP tokens) - .let [[tokens left] left]] - (rightP tokens))) - -(def' .private (someP itP tokens) - (All (_ a) - (-> (Parser a) - (Parser (List a)))) - (case (itP tokens) - {#Some [tokens head]} - (do maybe#monad - [it (someP itP tokens) - .let [[tokens tail] it]] - (in [tokens (partial_list head tail)])) + _ + (case (rightP tokens) + {#Some [tokens right]} + {#Some [tokens {#Right right}]} - {#None} - {#Some [tokens (list)]})) - -(def' .private (manyP itP tokens) - (All (_ a) - (-> (Parser a) - (Parser (List a)))) - (do maybe#monad - [it (itP tokens) - .let [[tokens head] it] - it (someP itP tokens) - .let [[tokens tail] it]] - (in [tokens (partial_list head tail)]))) - -(def' .private (maybeP itP tokens) - (All (_ a) - (-> (Parser a) - (Parser (Maybe a)))) - (case (itP tokens) - {#Some [tokens it]} - {#Some [tokens {#Some it}]} + _ + {#None}))) - {#None} - {#Some [tokens {#None}]})) +(def-1 .private (eitherP leftP rightP tokens) + (All (_ a) + (-> (Parser a) + (Parser a) + (Parser a))) + (case (leftP tokens) + {#None} + (rightP tokens) + + it + it)) + +(def-1 .private (andP leftP rightP tokens) + (All (_ l r) + (-> (Parser l) + (Parser r) + (Parser [l r]))) + (do maybe#monad + [left (leftP tokens) + .let [[tokens left] left] + right (rightP tokens) + .let [[tokens right] right]] + (in [tokens [left right]]))) + +(def-1 .private (afterP leftP rightP tokens) + (All (_ l r) + (-> (Parser l) + (Parser r) + (Parser r))) + (do maybe#monad + [left (leftP tokens) + .let [[tokens left] left]] + (rightP tokens))) + +(def-1 .private (someP itP tokens) + (All (_ a) + (-> (Parser a) + (Parser (List a)))) + (case (itP tokens) + {#Some [tokens head]} + (do maybe#monad + [it (someP itP tokens) + .let [[tokens tail] it]] + (in [tokens (partial_list head tail)])) -(def' .private (tupleP itP tokens) - (All (_ a) - (-> (Parser a) (Parser a))) - (case tokens - (pattern (partial_list [_ {#Tuple input}] tokens')) - (do maybe#monad - [it (parsed itP input)] - (in [tokens' it])) + {#None} + {#Some [tokens (list)]})) - _ - {#None})) +(def-1 .private (manyP itP tokens) + (All (_ a) + (-> (Parser a) + (Parser (List a)))) + (do maybe#monad + [it (itP tokens) + .let [[tokens head] it] + it (someP itP tokens) + .let [[tokens tail] it]] + (in [tokens (partial_list head tail)]))) + +(def-1 .private (maybeP itP tokens) + (All (_ a) + (-> (Parser a) + (Parser (Maybe a)))) + (case (itP tokens) + {#Some [tokens it]} + {#Some [tokens {#Some it}]} -(def' .private (formP itP tokens) - (All (_ a) - (-> (Parser a) (Parser a))) - (case tokens - (pattern (partial_list [_ {#Form input}] tokens')) - (do maybe#monad - [it (parsed itP input)] - (in [tokens' it])) + {#None} + {#Some [tokens {#None}]})) - _ - {#None})) +(def-1 .private (tupleP itP tokens) + (All (_ a) + (-> (Parser a) (Parser a))) + (case tokens + (pattern (partial_list [_ {#Tuple input}] tokens')) + (do maybe#monad + [it (parsed itP input)] + (in [tokens' it])) -(def' .private (bindingP tokens) - (Parser [Text Code]) - (case tokens - (pattern (partial_list [_ {#Symbol ["" name]}] value &rest)) - {#Some [&rest [name value]]} + _ + {#None})) - _ - {#None})) +(def-1 .private (formP itP tokens) + (All (_ a) + (-> (Parser a) (Parser a))) + (case tokens + (pattern (partial_list [_ {#Form input}] tokens')) + (do maybe#monad + [it (parsed itP input)] + (in [tokens' it])) -(def' .private (endP tokens) - (Parser Any) - (case tokens - (pattern (list)) - {#Some [tokens []]} + _ + {#None})) - _ - {#None})) +(def-1 .private (bindingP tokens) + (Parser [Text Code]) + (case tokens + (pattern (partial_list [_ {#Symbol ["" name]}] value &rest)) + {#Some [&rest [name value]]} + + _ + {#None})) -(def' .private (anyP tokens) - (Parser Code) - (case tokens - (pattern (partial_list code tokens')) - {#Some [tokens' code]} +(def-1 .private (endP tokens) + (Parser Any) + (case tokens + (pattern (list)) + {#Some [tokens []]} - _ - {#None})) + _ + {#None})) -(def' .private (localP tokens) - (-> (List Code) (Maybe [(List Code) Text])) - (case tokens - (pattern (partial_list [_ {#Symbol ["" local]}] tokens')) - {#Some [tokens' local]} +(def-1 .private (anyP tokens) + (Parser Code) + (case tokens + (pattern (partial_list code tokens')) + {#Some [tokens' code]} - _ - {#None})) + _ + {#None})) -(def' .private (symbolP tokens) - (-> (List Code) (Maybe [(List Code) Symbol])) - (case tokens - (pattern (partial_list [_ {#Symbol it}] tokens')) - {#Some [tokens' it]} +(def-1 .private (localP tokens) + (-> (List Code) (Maybe [(List Code) Text])) + (case tokens + (pattern (partial_list [_ {#Symbol ["" local]}] tokens')) + {#Some [tokens' local]} - _ - {#None})) + _ + {#None})) + +(def-1 .private (symbolP tokens) + (-> (List Code) (Maybe [(List Code) Symbol])) + (case tokens + (pattern (partial_list [_ {#Symbol it}] tokens')) + {#Some [tokens' it]} + + _ + {#None})) (with_template [<parser> <item_type> <item_parser>] - [(def' .private (<parser> tokens) - (-> (List Code) (Maybe (List <item_type>))) - (case tokens - {#End} - {#Some {#End}} + [(def-1 .private (<parser> tokens) + (-> (List Code) (Maybe (List <item_type>))) + (case tokens + {#End} + {#Some {#End}} - _ - (do maybe#monad - [% (<item_parser> tokens) - .let' [[tokens head] %] - tail (<parser> tokens)] - (in {#Item head tail}))))] + _ + (do maybe#monad + [% (<item_parser> tokens) + .let' [[tokens head] %] + tail (<parser> tokens)] + (in {#Item head tail}))))] [parametersP Text localP] [enhanced_parametersP Code anyP] ) (with_template [<parser> <parameter_type> <parameters_parser>] - [(def' .private (<parser> tokens) - (Parser [Text (List <parameter_type>)]) - (case tokens - (pattern (partial_list [_ {#Form local_declaration}] tokens')) - (do maybe#monad - [% (localP local_declaration) - .let' [[local_declaration name] %] - parameters (<parameters_parser> local_declaration)] - (in [tokens' [name parameters]])) - - _ - (do maybe#monad - [% (localP tokens) - .let' [[tokens' name] %]] - (in [tokens' [name {#End}]]))))] + [(def-1 .private (<parser> tokens) + (Parser [Text (List <parameter_type>)]) + (case tokens + (pattern (partial_list [_ {#Form local_declaration}] tokens')) + (do maybe#monad + [% (localP local_declaration) + .let' [[local_declaration name] %] + parameters (<parameters_parser> local_declaration)] + (in [tokens' [name parameters]])) + + _ + (do maybe#monad + [% (localP tokens) + .let' [[tokens' name] %]] + (in [tokens' [name {#End}]]))))] [local_declarationP Text parametersP] [enhanced_local_declarationP Code enhanced_parametersP] ) -(def' .private (export_policyP tokens) - (-> (List Code) [(List Code) Code]) - (case tokens - (pattern (partial_list candidate tokens')) - (case candidate - [_ {#Bit it}] - [tokens' candidate] - - [_ {#Symbol ["" _]}] - [tokens (` .private)] - - [_ {#Symbol it}] - [tokens' candidate] +(def-1 .private (export_policyP tokens) + (-> (List Code) [(List Code) Code]) + (case tokens + (pattern (partial_list candidate tokens')) + (case candidate + [_ {#Bit it}] + [tokens' candidate] + + [_ {#Symbol ["" _]}] + [tokens (` .private)] + + [_ {#Symbol it}] + [tokens' candidate] - _ - [tokens (` .private)]) + _ + [tokens (` .private)]) - _ - [tokens (` .private)])) + _ + [tokens (` .private)])) (with_template [<parser> <parameter_type> <local>] - [(def' .private (<parser> tokens) - (-> (List Code) (Maybe [(List Code) [Code Text (List <parameter_type>)]])) - (do maybe#monad - [.let' [[tokens export_policy] (export_policyP tokens)] - % (<local> tokens) - .let' [[tokens [name parameters]] %]] - (in [tokens [export_policy name parameters]])))] + [(def-1 .private (<parser> tokens) + (-> (List Code) (Maybe [(List Code) [Code Text (List <parameter_type>)]])) + (do maybe#monad + [.let' [[tokens export_policy] (export_policyP tokens)] + % (<local> tokens) + .let' [[tokens [name parameters]] %]] + (in [tokens [export_policy name parameters]])))] [declarationP Text local_declarationP] [enhanced_declarationP Code enhanced_local_declarationP] ) -(def' .private (bodyP tokens) - (-> (List Code) (Maybe [(List Code) [(Maybe Code) Code]])) - (case tokens - ... TB - (pattern (partial_list type body tokens')) - {#Some [tokens' [{#Some type} body]]} +(def-1 .private (bodyP tokens) + (-> (List Code) (Maybe [(List Code) [(Maybe Code) Code]])) + (case tokens + ... TB + (pattern (partial_list type body tokens')) + {#Some [tokens' [{#Some type} body]]} - ... B - (pattern (partial_list body tokens')) - {#Some [tokens' [{#None} body]]} + ... B + (pattern (partial_list body tokens')) + {#Some [tokens' [{#None} body]]} - _ - {#None})) - -(def' .private (definitionP tokens) - (-> (List Code) (Maybe [Code Text (List Code) (Maybe Code) Code])) - (do maybe#monad - [% (enhanced_declarationP tokens) - .let' [[tokens [export_policy name parameters]] %] - % (bodyP tokens) - .let' [[tokens [?type body]] %] - _ (endP tokens)] - (in [export_policy name parameters ?type body]))) - -(def'' .public def + _ + {#None})) + +(def-1 .private (definitionP tokens) + (-> (List Code) (Maybe [Code Text (List Code) (Maybe Code) Code])) + (do maybe#monad + [% (enhanced_declarationP tokens) + .let' [[tokens [export_policy name parameters]] %] + % (bodyP tokens) + .let' [[tokens [?type body]] %] + _ (endP tokens)] + (in [export_policy name parameters ?type body]))) + +(def-3 .public def Macro (macro (_ tokens) (case (definitionP tokens) |