diff options
| author | Eduardo Julian | 2022-06-16 00:48:19 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2022-06-16 00:48:19 -0400 |
| commit | 9e2f1e76f2c8df01ed7687d934c3210fcf676bd6 (patch) | |
| tree | 115fab5bd8a5f53dc0d13ce5453095324a83496f /stdlib/source/library/lux.lux | |
| parent | f92c806ee8da63f04bbefbf558f6249bacdb47ea (diff) | |
De-sigil-ification: suffix : [Part 13]
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/library/lux.lux | 3988 |
1 files changed, 1994 insertions, 1994 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 483362c7d..28507c829 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -823,7 +823,7 @@ {#End}}}))) #0) -("lux def" def:'' +("lux def" def'' ("lux macro" (function'' [tokens] ({{#Item [export_policy @@ -840,7 +840,7 @@ {#End}]}) _ - (failure "Wrong syntax for def:''")} + (failure "Wrong syntax for def''")} tokens))) #0) @@ -856,580 +856,580 @@ tokens))) #1) -(def:'' .public comment - Macro - (macro (_ tokens) - (meta#in {#End}))) +(def'' .public comment + Macro + (macro (_ tokens) + (meta#in {#End}))) -(def:'' .private $' - Macro - (macro (_ tokens) - ({{#Item x {#End}} - (meta#in tokens) +(def'' .private $' + Macro + (macro (_ tokens) + ({{#Item x {#End}} + (meta#in tokens) - {#Item x {#Item y xs}} - (meta#in {#Item (form$ {#Item (symbol$ [..prelude "$'"]) - {#Item (variant$ {#Item (symbol$ [..prelude "#Apply"]) - {#Item y {#Item x {#End}}}}) - xs}}) - {#End}}) + {#Item x {#Item y xs}} + (meta#in {#Item (form$ {#Item (symbol$ [..prelude "$'"]) + {#Item (variant$ {#Item (symbol$ [..prelude "#Apply"]) + {#Item y {#Item x {#End}}}}) + xs}}) + {#End}}) - _ - (failure "Wrong syntax for $'")} - tokens))) - -(def:'' .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} - {#Parameter 3}}} - {#Function {#Parameter 3} - {#Function ($' List {#Parameter 1}) - {#Parameter 3}}}}}} - ({{#End} - init + _ + (failure "Wrong syntax for $'")} + tokens))) + +(def'' .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} + {#Parameter 3}}} + {#Function {#Parameter 3} + {#Function ($' List {#Parameter 1}) + {#Parameter 3}}}}}} + ({{#End} + init + + {#Item x xs'} + (list#mix f (f x init) xs')} + xs)) + +(def'' .private (list#reversed list) + {#UnivQ {#End} + {#Function ($' List {#Parameter 1}) ($' List {#Parameter 1})}} + (list#mix ("lux type check" {#UnivQ {#End} + {#Function {#Parameter 1} {#Function ($' List {#Parameter 1}) ($' List {#Parameter 1})}}} + (function'' [head tail] {#Item head tail})) + {#End} + list)) + +(def'' .private (list#each f xs) + {#UnivQ {#End} + {#UnivQ {#End} + {#Function {#Function {#Parameter 3} {#Parameter 1}} + {#Function ($' List {#Parameter 3}) + ($' List {#Parameter 1})}}}} + (list#mix (function'' [head tail] {#Item (f head) tail}) + {#End} + (list#reversed xs))) + +(def'' .private Replacement_Environment + Type + ($' List {#Product Text Code})) - {#Item x xs'} - (list#mix f (f x init) xs')} - xs)) +(def'' .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')} -(def:'' .private (list#reversed list) - {#UnivQ {#End} - {#Function ($' List {#Parameter 1}) ($' List {#Parameter 1})}} - (list#mix ("lux type check" {#UnivQ {#End} - {#Function {#Parameter 1} {#Function ($' List {#Parameter 1}) ($' List {#Parameter 1})}}} - (function'' [head tail] {#Item head tail})) - {#End} - list)) - -(def:'' .private (list#each f xs) - {#UnivQ {#End} - {#UnivQ {#End} - {#Function {#Function {#Parameter 3} {#Parameter 1}} - {#Function ($' List {#Parameter 3}) - ($' List {#Parameter 1})}}}} - (list#mix (function'' [head tail] {#Item (f head) tail}) - {#End} - (list#reversed xs))) + _ + {#End}} + [xs ys])) -(def:'' .private Replacement_Environment - Type - ($' List {#Product Text Code})) +(def'' .private (text#= reference sample) + {#Function Text {#Function Text Bit}} + ("lux text =" reference sample)) -(def:'' .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')} +(def'' .private (replacement for environment) + {#Function Text {#Function Replacement_Environment ($' Maybe Code)}} + ({{#End} + {#None} - _ - {#End}} - [xs ys])) + {#Item [k v] environment'} + ({[#1] {#Some v} + [#0] (replacement for environment')} + (text#= k for))} + environment)) -(def:'' .private (text#= reference sample) - {#Function Text {#Function Text Bit}} - ("lux text =" reference sample)) +(def'' .private (with_replacements reps syntax) + {#Function Replacement_Environment {#Function Code Code}} + ({[_ {#Symbol "" name}] + ({{#Some replacement} + replacement -(def:'' .private (replacement for environment) - {#Function Text {#Function Replacement_Environment ($' Maybe Code)}} - ({{#End} - {#None} + {#None} + syntax} + (..replacement name reps)) - {#Item [k v] environment'} - ({[#1] {#Some v} - [#0] (replacement for environment')} - (text#= k for))} - environment)) + [meta {#Form parts}] + [meta {#Form (list#each (with_replacements reps) parts)}] -(def:'' .private (with_replacements reps syntax) - {#Function Replacement_Environment {#Function Code Code}} - ({[_ {#Symbol "" name}] - ({{#Some replacement} - replacement + [meta {#Variant members}] + [meta {#Variant (list#each (with_replacements reps) members)}] - {#None} - syntax} - (..replacement name reps)) + [meta {#Tuple members}] + [meta {#Tuple (list#each (with_replacements reps) members)}] + + _ + syntax} + syntax)) + +(def'' .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) + {#UnivQ {#End} + {#Function ($' List {#Parameter 1}) Nat}} + (list#mix (function'' [_ acc] ("lux i64 +" 1 acc)) 0 list)) + +(def'' .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| + Code + (variant$ {#Item (symbol$ [..prelude "#End"]) {#End}})) + +(def'' .private (|#Item| head tail) + {#Function Code {#Function Code Code}} + (variant$ {#Item (symbol$ [..prelude "#Item"]) + {#Item head + {#Item tail + {#End}}}})) + +(def'' .private (UnivQ$ body) + {#Function Code Code} + (variant$ {#Item (symbol$ [..prelude "#UnivQ"]) {#Item ..|#End| {#Item body {#End}}}})) + +(def'' .private (ExQ$ body) + {#Function Code Code} + (variant$ {#Item (symbol$ [..prelude "#ExQ"]) {#Item ..|#End| {#Item body {#End}}}})) + +(def'' .private quantification_level + Text + ("lux text concat" double_quote + ("lux text concat" "quantification_level" + double_quote))) + +(def'' .private quantified + {#Function Code Code} + (let$ (local$ ..quantification_level) (nat$ 0))) + +(def'' .private (quantified_type_parameter idx) + {#Function Nat Code} + (variant$ {#Item (symbol$ [..prelude "#Parameter"]) + {#Item (form$ {#Item (text$ "lux i64 +") + {#Item (local$ ..quantification_level) + {#Item (nat$ idx) + {#End}}}}) + {#End}}})) + +(def'' .private (next_level depth) + {#Function Nat Nat} + ("lux i64 +" 2 depth)) + +(def'' .private (self_id? id) + {#Function Nat Bit} + ("lux i64 =" id ("lux type as" Nat + ("lux i64 *" +2 + ("lux i64 /" +2 + ("lux type as" Int + id)))))) + +(def'' .public (__adjusted_quantified_type__ permission depth type) + {#Function Nat {#Function Nat {#Function Type Type}}} + ({0 + ({... Jackpot! + {#Parameter id} + ({id' + ({[#0] {#Parameter id'} + [#1] {#Parameter ("lux i64 -" 2 id')}} + (self_id? id))} + ("lux i64 -" ("lux i64 -" depth id) 0)) + + ... Recur + {#Primitive name parameters} + {#Primitive name (list#each (__adjusted_quantified_type__ permission depth) + parameters)} + + {#Sum left right} + {#Sum (__adjusted_quantified_type__ permission depth left) + (__adjusted_quantified_type__ permission depth right)} + + {#Product left right} + {#Product (__adjusted_quantified_type__ permission depth left) + (__adjusted_quantified_type__ permission depth right)} + + {#Function input output} + {#Function (__adjusted_quantified_type__ permission depth input) + (__adjusted_quantified_type__ permission depth output)} + + {#UnivQ environment body} + {#UnivQ environment + (__adjusted_quantified_type__ permission (next_level depth) body)} + + {#ExQ environment body} + {#ExQ environment + (__adjusted_quantified_type__ permission (next_level depth) body)} + + {#Apply parameter function} + {#Apply (__adjusted_quantified_type__ permission depth parameter) + (__adjusted_quantified_type__ permission depth function)} - [meta {#Form parts}] - [meta {#Form (list#each (with_replacements reps) parts)}] + ... Leave these alone. + {#Named name anonymous} type + {#Var id} type + {#Ex id} type} + type) - [meta {#Variant members}] - [meta {#Variant (list#each (with_replacements reps) members)}] + _ + type} + permission)) + +(def'' .private (with_correct_quantification body) + {#Function Code Code} + (form$ {#Item (symbol$ [prelude "__adjusted_quantified_type__"]) + {#Item (local$ ..quantification_level) + {#Item (nat$ 0) + {#Item body + {#End}}}}})) + +(def'' .private (with_quantification depth body) + {#Function Nat {#Function Code Code}} + ({g!level + (let$ g!level + (form$ {#Item (text$ "lux i64 +") + {#Item g!level + {#Item (nat$ ("lux type as" Nat + ("lux i64 *" +2 + ("lux type as" Int + depth)))) + {#End}}}}) + body)} + (local$ ..quantification_level))) + +(def'' .private (initialized_quantification? lux) + {#Function Lux Bit} + ({[..#info _ ..#source _ ..#current_module _ ..#modules _ + ..#scopes scopes ..#type_context _ ..#host _ + ..#seed _ ..#expected _ ..#location _ ..#extensions _ + ..#scope_type_vars _ ..#eval _] + (list#mix (function'' [scope verdict] + ({[#1] #1 + _ ({[..#name _ ..#inner _ ..#captured _ + ..#locals [..#counter _ + ..#mappings locals]] + (list#mix (function'' [local verdict] + ({[local _] + ({[#1] #1 + _ ("lux text =" ..quantification_level local)} + verdict)} + local)) + #0 + locals)} + scope)} + verdict)) + #0 + scopes)} + lux)) + +(def'' .public All + Macro + (macro (_ tokens lux) + ({{#Item [_ {#Form {#Item self_name args}}] + {#Item body {#End}}} + {#Right [lux + {#Item ({raw + ({[#1] raw + [#0] (..quantified raw)} + (initialized_quantification? lux))} + ({{#End} + body + + {#Item head tail} + (with_correct_quantification + (let$ self_name (quantified_type_parameter 0) + ({[_ raw] + raw} + (list#mix (function'' [parameter offset,body'] + ({[offset body'] + [("lux i64 +" 2 offset) + (let$ parameter (quantified_type_parameter ("lux i64 +" offset 1)) + (UnivQ$ body'))]} + offset,body')) + [0 (with_quantification (list#size args) + body)] + args))))} + args)) + {#End}}]} + + _ + {#Left "Wrong syntax for All"}} + tokens))) + +(def'' .public Ex + Macro + (macro (_ tokens lux) + ({{#Item [_ {#Form {#Item self_name args}}] + {#Item body {#End}}} + {#Right [lux + {#Item ({raw + ({[#1] raw + [#0] (..quantified raw)} + (initialized_quantification? lux))} + ({{#End} + body + + {#Item head tail} + (with_correct_quantification + (let$ self_name (quantified_type_parameter 0) + ({[_ raw] + raw} + (list#mix (function'' [parameter offset,body'] + ({[offset body'] + [("lux i64 +" 2 offset) + (let$ parameter (quantified_type_parameter ("lux i64 +" offset 1)) + (ExQ$ body'))]} + offset,body')) + [0 (with_quantification (list#size args) + body)] + args))))} + args)) + {#End}}]} + + _ + {#Left "Wrong syntax for Ex"}} + tokens))) + +(def'' .public -> + Macro + (macro (_ tokens) + ({{#Item output inputs} + (meta#in {#Item (list#mix ("lux type check" {#Function Code {#Function Code Code}} + (function'' [i o] (variant$ {#Item (symbol$ [..prelude "#Function"]) {#Item i {#Item o {#End}}}}))) + output + inputs) + {#End}}) + + _ + (failure "Wrong syntax for ->")} + (list#reversed tokens)))) - [meta {#Tuple members}] - [meta {#Tuple (list#each (with_replacements reps) members)}] - - _ - syntax} - syntax)) - -(def:'' .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) - {#UnivQ {#End} - {#Function ($' List {#Parameter 1}) Nat}} - (list#mix (function'' [_ acc] ("lux i64 +" 1 acc)) 0 list)) - -(def:'' .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| - Code - (variant$ {#Item (symbol$ [..prelude "#End"]) {#End}})) - -(def:'' .private (|#Item| head tail) - {#Function Code {#Function Code Code}} - (variant$ {#Item (symbol$ [..prelude "#Item"]) - {#Item head - {#Item tail - {#End}}}})) - -(def:'' .private (UnivQ$ body) - {#Function Code Code} - (variant$ {#Item (symbol$ [..prelude "#UnivQ"]) {#Item ..|#End| {#Item body {#End}}}})) - -(def:'' .private (ExQ$ body) - {#Function Code Code} - (variant$ {#Item (symbol$ [..prelude "#ExQ"]) {#Item ..|#End| {#Item body {#End}}}})) - -(def:'' .private quantification_level - Text - ("lux text concat" double_quote - ("lux text concat" "quantification_level" - double_quote))) - -(def:'' .private quantified - {#Function Code Code} - (let$ (local$ ..quantification_level) (nat$ 0))) - -(def:'' .private (quantified_type_parameter idx) - {#Function Nat Code} - (variant$ {#Item (symbol$ [..prelude "#Parameter"]) - {#Item (form$ {#Item (text$ "lux i64 +") - {#Item (local$ ..quantification_level) - {#Item (nat$ idx) - {#End}}}}) - {#End}}})) - -(def:'' .private (next_level depth) - {#Function Nat Nat} - ("lux i64 +" 2 depth)) - -(def:'' .private (self_id? id) - {#Function Nat Bit} - ("lux i64 =" id ("lux type as" Nat - ("lux i64 *" +2 - ("lux i64 /" +2 - ("lux type as" Int - id)))))) - -(def:'' .public (__adjusted_quantified_type__ permission depth type) - {#Function Nat {#Function Nat {#Function Type Type}}} - ({0 - ({... Jackpot! - {#Parameter id} - ({id' - ({[#0] {#Parameter id'} - [#1] {#Parameter ("lux i64 -" 2 id')}} - (self_id? id))} - ("lux i64 -" ("lux i64 -" depth id) 0)) - - ... Recur - {#Primitive name parameters} - {#Primitive name (list#each (__adjusted_quantified_type__ permission depth) - parameters)} - - {#Sum left right} - {#Sum (__adjusted_quantified_type__ permission depth left) - (__adjusted_quantified_type__ permission depth right)} - - {#Product left right} - {#Product (__adjusted_quantified_type__ permission depth left) - (__adjusted_quantified_type__ permission depth right)} - - {#Function input output} - {#Function (__adjusted_quantified_type__ permission depth input) - (__adjusted_quantified_type__ permission depth output)} - - {#UnivQ environment body} - {#UnivQ environment - (__adjusted_quantified_type__ permission (next_level depth) body)} - - {#ExQ environment body} - {#ExQ environment - (__adjusted_quantified_type__ permission (next_level depth) body)} - - {#Apply parameter function} - {#Apply (__adjusted_quantified_type__ permission depth parameter) - (__adjusted_quantified_type__ permission depth function)} +(def'' .public list + Macro + (macro (_ xs) + (meta#in {#Item (list#mix |#Item| |#End| (list#reversed xs)) + {#End}}))) - ... Leave these alone. - {#Named name anonymous} type - {#Var id} type - {#Ex id} type} - type) +(def'' .private partial_list + Macro + (macro (_ xs) + ({{#Item last init} + (meta#in (list (list#mix |#Item| last init))) - _ - type} - permission)) - -(def:'' .private (with_correct_quantification body) - {#Function Code Code} - (form$ {#Item (symbol$ [prelude "__adjusted_quantified_type__"]) - {#Item (local$ ..quantification_level) - {#Item (nat$ 0) - {#Item body - {#End}}}}})) - -(def:'' .private (with_quantification depth body) - {#Function Nat {#Function Code Code}} - ({g!level - (let$ g!level - (form$ {#Item (text$ "lux i64 +") - {#Item g!level - {#Item (nat$ ("lux type as" Nat - ("lux i64 *" +2 - ("lux type as" Int - depth)))) - {#End}}}}) - body)} - (local$ ..quantification_level))) - -(def:'' .private (initialized_quantification? lux) - {#Function Lux Bit} - ({[..#info _ ..#source _ ..#current_module _ ..#modules _ - ..#scopes scopes ..#type_context _ ..#host _ - ..#seed _ ..#expected _ ..#location _ ..#extensions _ - ..#scope_type_vars _ ..#eval _] - (list#mix (function'' [scope verdict] - ({[#1] #1 - _ ({[..#name _ ..#inner _ ..#captured _ - ..#locals [..#counter _ - ..#mappings locals]] - (list#mix (function'' [local verdict] - ({[local _] - ({[#1] #1 - _ ("lux text =" ..quantification_level local)} - verdict)} - local)) - #0 - locals)} - scope)} - verdict)) - #0 - scopes)} - lux)) - -(def:'' .public All - Macro - (macro (_ tokens lux) - ({{#Item [_ {#Form {#Item self_name args}}] - {#Item body {#End}}} - {#Right [lux - {#Item ({raw - ({[#1] raw - [#0] (..quantified raw)} - (initialized_quantification? lux))} - ({{#End} - body - - {#Item head tail} - (with_correct_quantification - (let$ self_name (quantified_type_parameter 0) - ({[_ raw] - raw} - (list#mix (function'' [parameter offset,body'] - ({[offset body'] - [("lux i64 +" 2 offset) - (let$ parameter (quantified_type_parameter ("lux i64 +" offset 1)) - (UnivQ$ body'))]} - offset,body')) - [0 (with_quantification (list#size args) - body)] - args))))} - args)) - {#End}}]} - - _ - {#Left "Wrong syntax for All"}} - tokens))) + _ + (failure "Wrong syntax for partial_list")} + (list#reversed xs)))) -(def:'' .public Ex - Macro - (macro (_ tokens lux) - ({{#Item [_ {#Form {#Item self_name args}}] - {#Item body {#End}}} - {#Right [lux - {#Item ({raw - ({[#1] raw - [#0] (..quantified raw)} - (initialized_quantification? lux))} - ({{#End} - body - - {#Item head tail} - (with_correct_quantification - (let$ self_name (quantified_type_parameter 0) - ({[_ raw] - raw} - (list#mix (function'' [parameter offset,body'] - ({[offset body'] - [("lux i64 +" 2 offset) - (let$ parameter (quantified_type_parameter ("lux i64 +" offset 1)) - (ExQ$ body'))]} - offset,body')) - [0 (with_quantification (list#size args) - body)] - args))))} - args)) - {#End}}]} - - _ - {#Left "Wrong syntax for Ex"}} - tokens))) +(def'' .public Union + Macro + (macro (_ tokens) + ({{#End} + (meta#in (list (symbol$ [..prelude "Nothing"]))) -(def:'' .public -> - Macro - (macro (_ tokens) - ({{#Item output inputs} - (meta#in {#Item (list#mix ("lux type check" {#Function Code {#Function Code Code}} - (function'' [i o] (variant$ {#Item (symbol$ [..prelude "#Function"]) {#Item i {#Item o {#End}}}}))) - output - inputs) - {#End}}) - - _ - (failure "Wrong syntax for ->")} - (list#reversed tokens)))) + {#Item last prevs} + (meta#in (list (list#mix (function'' [left right] (variant$ (list (symbol$ [..prelude "#Sum"]) left right))) + last + prevs)))} + (list#reversed tokens)))) -(def:'' .public list - Macro - (macro (_ xs) - (meta#in {#Item (list#mix |#Item| |#End| (list#reversed xs)) - {#End}}))) +(def'' .public Tuple + Macro + (macro (_ tokens) + ({{#End} + (meta#in (list (symbol$ [..prelude "Any"]))) -(def:'' .private partial_list - Macro - (macro (_ xs) - ({{#Item last init} - (meta#in (list (list#mix |#Item| last init))) + {#Item last prevs} + (meta#in (list (list#mix (function'' [left right] (variant$ (list (symbol$ [..prelude "#Product"]) left right))) + last + prevs)))} + (list#reversed tokens)))) - _ - (failure "Wrong syntax for partial_list")} - (list#reversed xs)))) +(def'' .private function' + Macro + (macro (_ tokens) + (let'' [name tokens'] ({{#Item [[_ {#Symbol ["" name]}] tokens']} + [name tokens'] -(def:'' .public Union - Macro - (macro (_ tokens) - ({{#End} - (meta#in (list (symbol$ [..prelude "Nothing"]))) + _ + ["" tokens]} + tokens) + ({{#Item [[_ {#Tuple args}] {#Item [body {#End}]}]} + ({{#End} + (failure "function' requires a non-empty arguments tuple.") + + {#Item [harg targs]} + (meta#in (list (form$ (list (tuple$ (list (local$ name) + harg)) + (list#mix (function'' [arg body'] + (form$ (list (tuple$ (list (local$ "") + arg)) + body'))) + body + (list#reversed targs))))))} + args) - {#Item last prevs} - (meta#in (list (list#mix (function'' [left right] (variant$ (list (symbol$ [..prelude "#Sum"]) left right))) - last - prevs)))} - (list#reversed tokens)))) + _ + (failure "Wrong syntax for function'")} + tokens')))) + +(def'' .private def''' + Macro + (macro (_ tokens) + ({{#Item [export_policy + {#Item [[_ {#Form {#Item [name args]}}] + {#Item [type {#Item [body {#End}]}]}]}]} + (meta#in (list (form$ (list (text$ "lux def") + name + (form$ (list (text$ "lux type check") + type + (form$ (list (symbol$ [..prelude "function'"]) + name + (tuple$ args) + body)))) + export_policy)))) + + {#Item [export_policy {#Item [name {#Item [type {#Item [body {#End}]}]}]}]} + (meta#in (list (form$ (list (text$ "lux def") + name + (form$ (list (text$ "lux type check") + type + body)) + export_policy)))) -(def:'' .public Tuple - Macro - (macro (_ tokens) - ({{#End} - (meta#in (list (symbol$ [..prelude "Any"]))) + _ + (failure "Wrong syntax for def'''")} + tokens))) - {#Item last prevs} - (meta#in (list (list#mix (function'' [left right] (variant$ (list (symbol$ [..prelude "#Product"]) left right))) - last - prevs)))} - (list#reversed tokens)))) +(def''' .public Or + Macro + ..Union) -(def:'' .private function' +(def''' .public And Macro - (macro (_ tokens) - (let'' [name tokens'] ({{#Item [[_ {#Symbol ["" name]}] tokens']} - [name tokens'] + ..Tuple) - _ - ["" tokens]} - tokens) - ({{#Item [[_ {#Tuple args}] {#Item [body {#End}]}]} - ({{#End} - (failure "function' requires a non-empty arguments tuple.") - - {#Item [harg targs]} - (meta#in (list (form$ (list (tuple$ (list (local$ name) - harg)) - (list#mix (function'' [arg body'] - (form$ (list (tuple$ (list (local$ "") - arg)) - body'))) - body - (list#reversed targs))))))} - args) +(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')) - _ - (failure "Wrong syntax for function'")} - tokens')))) + {#End} + {#Some {#End}} -(def:'' .private def:''' - Macro - (macro (_ tokens) - ({{#Item [export_policy - {#Item [[_ {#Form {#Item [name args]}}] - {#Item [type {#Item [body {#End}]}]}]}]} - (meta#in (list (form$ (list (text$ "lux def") - name - (form$ (list (text$ "lux type check") - type - (form$ (list (symbol$ [..prelude "function'"]) - name - (tuple$ args) - body)))) - export_policy)))) - - {#Item [export_policy {#Item [name {#Item [type {#Item [body {#End}]}]}]}]} - (meta#in (list (form$ (list (text$ "lux def") - name - (form$ (list (text$ "lux type check") - type - body)) - export_policy)))) + _ + {#None}} + xs)) - _ - (failure "Wrong syntax for def:'''")} - tokens))) - -(def:''' .public Or - Macro - ..Union) - -(def:''' .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}} +(def'' .private let' + Macro + (macro (_ tokens) + ({{#Item [_ {#Tuple bindings}] {#Item body {#End}}} + ({{#Some bindings} + (meta#in (list (list#mix ("lux type check" (-> (Tuple Code Code) Code + Code) + (function' [binding body] + ({[label value] + (form$ (list (variant$ (list label body)) value))} + binding))) + body + (list#reversed bindings)))) {#None} - {#None}} - (pairs xs')) - - {#End} - {#Some {#End}} + (failure "Wrong syntax for let'")} + (pairs bindings)) _ - {#None}} - xs)) - -(def:'' .private let' - Macro - (macro (_ tokens) - ({{#Item [_ {#Tuple bindings}] {#Item body {#End}}} - ({{#Some bindings} - (meta#in (list (list#mix ("lux type check" (-> (Tuple Code Code) Code - Code) - (function' [binding body] - ({[label value] - (form$ (list (variant$ (list label body)) value))} - binding))) - body - (list#reversed bindings)))) - - {#None} - (failure "Wrong syntax for let'")} - (pairs bindings)) + (failure "Wrong syntax for let'")} + tokens))) - _ - (failure "Wrong syntax for let'")} - tokens))) +(def''' .private (any? p xs) + (All (_ a) + (-> (-> a Bit) ($' List a) Bit)) + ({{#End} + #0 -(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)) - {#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 (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| -(def:''' .private (untemplated_list tokens) - (-> ($' List Code) Code) - ({{#End} - |#End| + {#Item token tokens'} + (|#Item| token (untemplated_list tokens'))} + tokens)) - {#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 (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:''' .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''' .private (function#flipped func) + (All (_ a b c) + (-> (-> a b c) (-> b a c))) + (function' [right left] + (func left right))) + +(def'' .public left + Macro + (macro (_ tokens) + ({{#Item op tokens'} + ({{#Item first nexts} + (meta#in (list (list#mix (function#flipped (right_associativity op)) first nexts))) + _ + (failure "Wrong syntax for left")} + tokens') + _ - (form$ (list op a1 a2))} - op)) - -(def:''' .private (function#flipped func) - (All (_ a b c) - (-> (-> a b c) (-> b a c))) - (function' [right left] - (func left right))) + (failure "Wrong syntax for left")} + tokens))) -(def:'' .public left - Macro - (macro (_ tokens) - ({{#Item op tokens'} - ({{#Item first nexts} - (meta#in (list (list#mix (function#flipped (right_associativity op)) first nexts))) - - _ - (failure "Wrong syntax for left")} - tokens') - - _ - (failure "Wrong syntax for left")} - tokens))) +(def'' .public right + Macro + (macro (_ tokens) + ({{#Item op tokens'} + ({{#Item last prevs} + (meta#in (list (list#mix (right_associativity op) last prevs))) -(def:'' .public right - Macro - (macro (_ tokens) - ({{#Item op tokens'} - ({{#Item last prevs} - (meta#in (list (list#mix (right_associativity op) last prevs))) - - _ - (failure "Wrong syntax for right")} - (list#reversed tokens')) - - _ - (failure "Wrong syntax for right")} - tokens))) + _ + (failure "Wrong syntax for right")} + (list#reversed tokens')) + + _ + (failure "Wrong syntax for right")} + tokens))) -(def:''' .public all Macro ..right) +(def''' .public all Macro ..right) ... (type: (Monad m) ... (Interface @@ -1449,1499 +1449,1499 @@ ["#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''' .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} + + {#Right [state' a]} + (f a state')} + (ma state))))]) + +(def'' .private do + Macro + (macro (_ tokens) + ({{#Item monad {#Item [_ {#Tuple bindings}] {#Item body {#End}}}} + ({{#Some bindings} + (let' [g!in (local$ "in") + g!then (local$ " then ") + body' (list#mix ("lux type check" (-> (Tuple Code Code) Code Code) + (function' [binding body'] + (let' [[var value] binding] + ({[_ {#Symbol [module short]}] + ({"" + (form$ (list g!then + (form$ (list (tuple$ (list (local$ "") var)) body')) + value)) + + _ + (form$ (list var value body'))} + module) + + + _ + (form$ (list g!then + (form$ (list (tuple$ (list (local$ "") var)) body')) + value))} + var)))) + body + (list#reversed bindings))] + (meta#in (list (form$ (list (variant$ (list (tuple$ (list g!in g!then)) + body')) + monad))))) + + {#None} + (failure "Wrong syntax for do")} + (pairs bindings)) - {#Right [state' a]} - (f a state')} - (ma state))))]) + _ + (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 + Macro + (macro (_ tokens) + ({{#Item test {#Item then {#Item else {#End}}}} + (meta#in (list (form$ (list (variant$ (list (bit$ #1) then + (bit$ #0) else)) + test)))) -(def:'' .private do - Macro - (macro (_ tokens) - ({{#Item monad {#Item [_ {#Tuple bindings}] {#Item body {#End}}}} - ({{#Some bindings} - (let' [g!in (local$ "in") - g!then (local$ " then ") - body' (list#mix ("lux type check" (-> (Tuple Code Code) Code Code) - (function' [binding body'] - (let' [[var value] binding] - ({[_ {#Symbol [module short]}] - ({"" - (form$ (list g!then - (form$ (list (tuple$ (list (local$ "") var)) body')) - value)) - - _ - (form$ (list var value body'))} - module) - + _ + (failure "Wrong syntax for if")} + tokens))) - _ - (form$ (list g!then - (form$ (list (tuple$ (list (local$ "") var)) body')) - value))} - var)))) - body - (list#reversed bindings))] - (meta#in (list (form$ (list (variant$ (list (tuple$ (list g!in g!then)) - body')) - monad))))) - - {#None} - (failure "Wrong syntax for do")} - (pairs bindings)) +(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) - _ - (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) + {#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''' .private (spliced replace? untemplated elems) + (-> Bit (-> Code ($' Meta Code)) ($' List Code) ($' Meta Code)) + ({[#1] ({{#End} + (meta#in |#End|) - {#Item x xs'} - (do m - [y' (f x y)] - (monad#mix m f y' xs'))} - xs))) + {#Item lastI inits} + (do meta#monad + [lastO ({[_ {#Form {#Item [[_ {#Symbol ["" "~+"]}] {#Item [spliced {#End}]}]}}] + (in (:List<Code> spliced)) -(def:'' .public if - Macro - (macro (_ tokens) - ({{#Item test {#Item then {#Item else {#End}}}} - (meta#in (list (form$ (list (variant$ (list (bit$ #1) then - (bit$ #0) else)) - test)))) + _ + (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)))) + + _ + (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''' .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))))) - _ - (failure "Wrong syntax for if")} - tokens))) + [_ [_ {#Text value}]] + (meta#in (untemplated_text value)) -(def:''' .private PList - Type - (All (_ a) ($' List (Tuple Text a)))) + [#1 [_ {#Symbol [module name]}]] + (do meta#monad + [real_name ({"" + (if (text#= "" subst) + (in [module name]) + (global_symbol [subst name])) -(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')) + _ + (in [module name])} + module) + .let' [[module name] real_name]] + (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Symbol"]) (tuple$ (list (text$ module) (text$ name)))))))) - {#End} - {#None}} - plist)) + [#0 [_ {#Symbol [module name]}]] + (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Symbol"]) (tuple$ (list (text$ module) (text$ name))))))) -(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'))) + [#1 [_ {#Form {#Item [[_ {#Symbol ["" "~"]}] {#Item [unquoted {#End}]}]}}]] + (meta#in (form$ (list (text$ "lux type check") + (symbol$ [..prelude "Code"]) + unquoted))) - {#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:''' .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)) + [#1 [_ {#Form {#Item [[_ {#Symbol ["" "~!"]}] {#Item [dependent {#End}]}]}}]] + (do meta#monad + [independent (untemplated replace? subst dependent)] + (in (with_location (variant$ (list (symbol$ [..prelude "#Form"]) + (untemplated_list (list (untemplated_text "lux in-module") + (untemplated_text subst) + independent))))))) - _ - (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)))) - - _ - (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:''' .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))))) + [#1 [_ {#Form {#Item [[_ {#Symbol ["" "~'"]}] {#Item [keep_quoted {#End}]}]}}]] + (untemplated #0 subst keep_quoted) - [_ [_ {#Text value}]] - (meta#in (untemplated_text value)) + [_ [meta {#Form elems}]] + (do meta#monad + [output (spliced replace? (untemplated replace? subst) elems) + .let' [[_ output'] (with_location (variant$ (list (symbol$ [..prelude "#Form"]) output)))]] + (in [meta output'])) - [#1 [_ {#Symbol [module name]}]] - (do meta#monad - [real_name ({"" - (if (text#= "" subst) - (in [module name]) - (global_symbol [subst name])) + [_ [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'])) - _ - (in [module name])} - module) - .let' [[module name] real_name]] - (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Symbol"]) (tuple$ (list (text$ module) (text$ name)))))))) + [_ [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])) - [#0 [_ {#Symbol [module name]}]] - (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Symbol"]) (tuple$ (list (text$ module) (text$ name))))))) +(def'' .public Primitive + Macro + (macro (_ tokens) + ({{#Item [_ {#Text class_name}] {#End}} + (meta#in (list (variant$ (list (symbol$ [..prelude "#Primitive"]) (text$ class_name) |#End|)))) - [#1 [_ {#Form {#Item [[_ {#Symbol ["" "~"]}] {#Item [unquoted {#End}]}]}}]] - (meta#in (form$ (list (text$ "lux type check") - (symbol$ [..prelude "Code"]) - unquoted))) + {#Item [_ {#Text class_name}] {#Item [_ {#Tuple params}] {#End}}} + (meta#in (list (variant$ (list (symbol$ [..prelude "#Primitive"]) (text$ class_name) (untemplated_list params))))) - [#1 [_ {#Form {#Item [[_ {#Symbol ["" "~!"]}] {#Item [dependent {#End}]}]}}]] + _ + (failure "Wrong syntax for Primitive")} + tokens))) + +(def'' .private (current_module_name state) + ($' Meta Text) + ({[..#info info ..#source source ..#current_module 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] + ({{#Some module_name} + {#Right [state module_name]} + + _ + {#Left "Cannot get the module name without a module!"}} + current_module)} + state)) + +(def'' .public ` + Macro + (macro (_ tokens) + ({{#Item template {#End}} (do meta#monad - [independent (untemplated replace? subst dependent)] - (in (with_location (variant$ (list (symbol$ [..prelude "#Form"]) - (untemplated_list (list (untemplated_text "lux in-module") - (untemplated_text subst) - independent))))))) + [current_module current_module_name + =template (untemplated #1 current_module template)] + (in (list (form$ (list (text$ "lux type check") + (symbol$ [..prelude "Code"]) + =template))))) - [#1 [_ {#Form {#Item [[_ {#Symbol ["" "~'"]}] {#Item [keep_quoted {#End}]}]}}]] - (untemplated #0 subst keep_quoted) + _ + (failure "Wrong syntax for `")} + tokens))) - [_ [meta {#Form elems}]] +(def'' .public `' + Macro + (macro (_ tokens) + ({{#Item template {#End}} (do meta#monad - [output (spliced replace? (untemplated replace? subst) elems) - .let' [[_ output'] (with_location (variant$ (list (symbol$ [..prelude "#Form"]) output)))]] - (in [meta output'])) + [=template (untemplated #1 "" template)] + (in (list (form$ (list (text$ "lux type check") (symbol$ [..prelude "Code"]) =template))))) - [_ [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'])) + _ + (failure "Wrong syntax for `")} + tokens))) - [_ [meta {#Tuple elems}]] +(def'' .public ' + Macro + (macro (_ tokens) + ({{#Item template {#End}} (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])) + [=template (untemplated #0 "" template)] + (in (list (form$ (list (text$ "lux type check") (symbol$ [..prelude "Code"]) =template))))) -(def:'' .public Primitive - Macro - (macro (_ tokens) - ({{#Item [_ {#Text class_name}] {#End}} - (meta#in (list (variant$ (list (symbol$ [..prelude "#Primitive"]) (text$ class_name) |#End|)))) - - {#Item [_ {#Text class_name}] {#Item [_ {#Tuple params}] {#End}}} - (meta#in (list (variant$ (list (symbol$ [..prelude "#Primitive"]) (text$ class_name) (untemplated_list params))))) + _ + (failure "Wrong syntax for '")} + tokens))) - _ - (failure "Wrong syntax for Primitive")} - tokens))) +(def'' .public |> + Macro + (macro (_ tokens) + ({{#Item [init apps]} + (meta#in (list (list#mix ("lux type check" (-> Code Code Code) + (function' [app acc] + ({[_ {#Variant parts}] + (variant$ (list#composite parts (list acc))) -(def:'' .private (current_module_name state) - ($' Meta Text) - ({[..#info info ..#source source ..#current_module 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] - ({{#Some module_name} - {#Right [state module_name]} + [_ {#Tuple parts}] + (tuple$ (list#composite parts (list acc))) - _ - {#Left "Cannot get the module name without a module!"}} - current_module)} - state)) + [_ {#Form parts}] + (form$ (list#composite parts (list acc))) -(def:'' .public ` - Macro - (macro (_ tokens) - ({{#Item template {#End}} - (do meta#monad - [current_module current_module_name - =template (untemplated #1 current_module template)] - (in (list (form$ (list (text$ "lux type check") - (symbol$ [..prelude "Code"]) - =template))))) + _ + (` ((~ app) (~ acc)))} + app))) + init + apps))) - _ - (failure "Wrong syntax for `")} - tokens))) + _ + (failure "Wrong syntax for |>")} + tokens))) -(def:'' .public `' - Macro - (macro (_ tokens) - ({{#Item template {#End}} - (do meta#monad - [=template (untemplated #1 "" template)] - (in (list (form$ (list (text$ "lux type check") (symbol$ [..prelude "Code"]) =template))))) +(def'' .public <| + Macro + (macro (_ tokens) + ({{#Item [init apps]} + (meta#in (list (list#mix ("lux type check" (-> Code Code Code) + (function' [app acc] + ({[_ {#Variant parts}] + (variant$ (list#composite parts (list acc))) - _ - (failure "Wrong syntax for `")} - tokens))) + [_ {#Tuple parts}] + (tuple$ (list#composite parts (list acc))) -(def:'' .public ' - Macro - (macro (_ tokens) - ({{#Item template {#End}} - (do meta#monad - [=template (untemplated #0 "" template)] - (in (list (form$ (list (text$ "lux type check") (symbol$ [..prelude "Code"]) =template))))) + [_ {#Form parts}] + (form$ (list#composite parts (list acc))) - _ - (failure "Wrong syntax for '")} - tokens))) + _ + (` ((~ app) (~ acc)))} + app))) + init + apps))) -(def:'' .public |> - Macro - (macro (_ tokens) - ({{#Item [init apps]} - (meta#in (list (list#mix ("lux type check" (-> Code Code Code) - (function' [app acc] - ({[_ {#Variant parts}] - (variant$ (list#composite parts (list acc))) + _ + (failure "Wrong syntax for <|")} + (list#reversed tokens)))) - [_ {#Tuple parts}] - (tuple$ (list#composite parts (list acc))) +(def''' .private (function#composite f g) + (All (_ a b c) + (-> (-> b c) (-> a b) (-> a c))) + (function' [x] (f (g x)))) - [_ {#Form parts}] - (form$ (list#composite parts (list acc))) +(def''' .private (symbol_name x) + (-> Code ($' Maybe Symbol)) + ({[_ {#Symbol sname}] + {#Some sname} - _ - (` ((~ app) (~ acc)))} - app))) - init - apps))) + _ + {#None}} + x)) - _ - (failure "Wrong syntax for |>")} - tokens))) +(def''' .private (symbol_short x) + (-> Code ($' Maybe Text)) + ({[_ {#Symbol "" sname}] + {#Some sname} -(def:'' .public <| - Macro - (macro (_ tokens) - ({{#Item [init apps]} - (meta#in (list (list#mix ("lux type check" (-> Code Code Code) - (function' [app acc] - ({[_ {#Variant parts}] - (variant$ (list#composite parts (list acc))) + _ + {#None}} + x)) - [_ {#Tuple parts}] - (tuple$ (list#composite parts (list acc))) +(def''' .private (tuple_list tuple) + (-> Code ($' Maybe ($' List Code))) + ({[_ {#Tuple members}] + {#Some members} - [_ {#Form parts}] - (form$ (list#composite parts (list acc))) + _ + {#None}} + tuple)) - _ - (` ((~ app) (~ acc)))} - app))) - init - apps))) +(def''' .private (realized_template env template) + (-> Replacement_Environment Code Code) + ({[_ {#Symbol "" sname}] + ({{#Some subst} + subst _ - (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)))) + template} + (..replacement sname env)) -(def:''' .private (symbol_name x) - (-> Code ($' Maybe Symbol)) - ({[_ {#Symbol sname}] - {#Some sname} + [meta {#Form elems}] + [meta {#Form (list#each (realized_template env) elems)}] - _ - {#None}} - x)) - -(def:''' .private (symbol_short x) - (-> Code ($' Maybe Text)) - ({[_ {#Symbol "" sname}] - {#Some sname} + [meta {#Tuple elems}] + [meta {#Tuple (list#each (realized_template env) elems)}] - _ - {#None}} - x)) + [meta {#Variant elems}] + [meta {#Variant (list#each (realized_template env) elems)}] -(def:''' .private (tuple_list tuple) - (-> Code ($' Maybe ($' List Code))) - ({[_ {#Tuple members}] - {#Some members} - - _ - {#None}} - tuple)) - -(def:''' .private (realized_template env template) - (-> Replacement_Environment Code Code) - ({[_ {#Symbol "" sname}] - ({{#Some subst} - subst + _ + template} + template)) + +(def''' .private (every? p xs) + (All (_ a) + (-> (-> a Bit) ($' List a) Bit)) + (list#mix (function' [_2 _1] (if _1 (p _2) #0)) #1 xs)) + +(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 + Macro + (macro (_ tokens) + ({{#Item [[_ {#Tuple bindings}] {#Item [[_ {#Tuple templates}] data]}]} + ({[{#Some bindings'} {#Some data'}] + (let' [apply ("lux type check" (-> Replacement_Environment ($' List Code)) + (function' [env] (list#each (realized_template env) templates))) + num_bindings (list#size bindings')] + (if (every? (function' [size] ("lux i64 =" num_bindings size)) + (list#each list#size data')) + (|> data' + (list#each (function#composite apply (replacement_environment bindings'))) + list#conjoint + meta#in) + (failure (..wrong_syntax_error [..prelude "with_template"])))) _ - template} - (..replacement sname env)) + (failure (..wrong_syntax_error [..prelude "with_template"]))} + [(monad#each maybe#monad symbol_short bindings) + (monad#each maybe#monad tuple_list data)]) - [meta {#Form elems}] - [meta {#Form (list#each (realized_template env) elems)}] + _ + (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 ""))} + value)) + +(def''' .private (int#abs value) + (-> Int Int) + (if ("lux i64 <" +0 value) + ("lux i64 *" -1 value) + value)) - [meta {#Tuple elems}] - [meta {#Tuple (list#each (realized_template env) elems)}] +(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 - [meta {#Variant elems}] - [meta {#Variant (list#each (realized_template env) elems)}] + _ + #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} - _ - template} - template)) - -(def:''' .private (every? p xs) - (All (_ a) - (-> (-> a Bit) ($' List a) Bit)) - (list#mix (function' [_2 _1] (if _1 (p _2) #0)) #1 xs)) - -(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 - Macro - (macro (_ tokens) - ({{#Item [[_ {#Tuple bindings}] {#Item [[_ {#Tuple templates}] data]}]} - ({[{#Some bindings'} {#Some data'}] - (let' [apply ("lux type check" (-> Replacement_Environment ($' List Code)) - (function' [env] (list#each (realized_template env) templates))) - num_bindings (list#size bindings')] - (if (every? (function' [size] ("lux i64 =" num_bindings size)) - (list#each list#size data')) - (|> data' - (list#each (function#composite apply (replacement_environment bindings'))) - list#conjoint - meta#in) - (failure (..wrong_syntax_error [..prelude "with_template"])))) + {#Tag _} + {#None} - _ - (failure (..wrong_syntax_error [..prelude "with_template"]))} - [(monad#each maybe#monad symbol_short bindings) - (monad#each maybe#monad tuple_list data)]) + {#Slot _} + {#None}} + ("lux type check" Global gdef)))) - _ - (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 ""))} - value)) +(def''' .private (normal name) + (-> Symbol ($' Meta Symbol)) + ({["" name] + (do meta#monad + [module_name ..current_module_name] + (in [module_name name])) -(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 + _ + (meta#in name)} + name)) - _ - #0} - type)) +(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 -(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} + {#Item [x {#End}]} + xs - {#Tag _} - {#None} + {#Item [x xs']} + (partial_list x sep (list#interposed sep xs'))} + xs)) - {#Slot _} - {#None}} - ("lux type check" Global gdef)))) +(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)) -(def:''' .private (normal name) - (-> Symbol ($' Meta Symbol)) - ({["" name] - (do meta#monad - [module_name ..current_module_name] - (in [module_name name])) + _ + (meta#in (list token))} + token)) - _ - (meta#in name)} - name)) - -(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 +(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)) - {#Item [x {#End}]} - xs + _ + (meta#in (list token))} + token)) - {#Item [x xs']} - (partial_list x sep (list#interposed sep xs'))} - xs)) +(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'))))) + + _ + (meta#in (list syntax))} + syntax))) + +(def''' .private (text#encoded original) + (-> Text Text) + (all text#composite ..double_quote original ..double_quote)) + +(def''' .private (code#encoded code) + (-> Code Text) + ({[_ {#Bit value}] + (bit#encoded value) + + [_ {#Nat value}] + (nat#encoded value) + + [_ {#Int value}] + (int#encoded value) + + [_ {#Rev value}] + ("lux io error" "@code#encoded Undefined behavior.") + + [_ {#Frac value}] + (frac#encoded value) -(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)) + [_ {#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)) - _ - (meta#in (list token))} - token)) + _ + type} + type)) -(def:''' .private (expansion token) - (-> Code ($' Meta ($' List Code))) - ({[_ {#Form {#Item [_ {#Symbol name}] args}}] +(def'' .public type + Macro + (macro (_ tokens) + ({{#Item type {#End}} (do meta#monad - [name' (normal name) - ?macro (named_macro name')] - ({{#Some macro} + [initialized_quantification? (function' [lux] {#Right [lux (initialized_quantification? lux)]})] + (if initialized_quantification? (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)) - - _ - (meta#in (list token))} - token)) - -(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')))))) + [type+ (full_expansion #0 type)] + ({{#Item type' {#End}} + (in (list (normal_type type'))) - [_ {#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'))))) - - _ - (meta#in (list syntax))} - syntax))) - -(def:''' .private (text#encoded original) - (-> Text Text) - (all text#composite ..double_quote original ..double_quote)) - -(def:''' .private (code#encoded code) - (-> Code Text) - ({[_ {#Bit value}] - (bit#encoded value) - - [_ {#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:''' .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)) + _ + (failure "The expansion of the type-syntax had to yield a single element.")} + type+)) + (in (list (..quantified (` (..type (~ type)))))))) _ - type} - type)) - -(def:'' .public type - Macro - (macro (_ tokens) - ({{#Item type {#End}} - (do meta#monad - [initialized_quantification? (function' [lux] {#Right [lux (initialized_quantification? lux)]})] - (if initialized_quantification? - (do meta#monad - [type+ (full_expansion #0 type)] - ({{#Item type' {#End}} - (in (list (normal_type type'))) - - _ - (failure "The expansion of the type-syntax had to yield a single element.")} - type+)) - (in (list (..quantified (` (..type (~ type)))))))) - - _ - (failure "Wrong syntax for type")} - tokens))) - -(def:'' .public is - Macro - (macro (_ tokens) - ({{#Item type {#Item value {#End}}} - (meta#in (list (` ("lux type check" - (..type (~ type)) - (~ value))))) + (failure "Wrong syntax for type")} + tokens))) - _ - (failure "Wrong syntax for :")} - tokens))) +(def'' .public is + Macro + (macro (_ tokens) + ({{#Item type {#Item value {#End}}} + (meta#in (list (` ("lux type check" + (..type (~ type)) + (~ value))))) -(def:'' .public as - Macro - (macro (_ tokens) - ({{#Item type {#Item value {#End}}} - (meta#in (list (` ("lux type as" - (..type (~ type)) - (~ value))))) + _ + (failure "Wrong syntax for :")} + tokens))) - _ - (failure "Wrong syntax for as")} - tokens))) +(def'' .public as + Macro + (macro (_ tokens) + ({{#Item type {#Item value {#End}}} + (meta#in (list (` ("lux type as" + (..type (~ type)) + (~ value))))) -(def:''' .private (empty? xs) - (All (_ a) - (-> ($' List a) Bit)) - ({{#End} #1 - _ #0} - xs)) + _ + (failure "Wrong syntax for as")} + tokens))) + +(def''' .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''' .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 - Macro - (macro (_ tokens) - ({{#Item value actions} - (let' [dummy (local$ "")] - (meta#in (list (list#mix ("lux type check" (-> Code Code Code) - (function' [pre post] (` ({(~ dummy) (~ post)} - (~ pre))))) - value - actions)))) - - _ - (failure "Wrong syntax for exec")} - (list#reversed tokens)))) - -(def:'' .private def:' - Macro - (macro (_ tokens) - (let' [parts (is (Maybe [Code Code (List Code) (Maybe Code) Code]) - ({{#Item export_policy {#Item [_ {#Form {#Item name args}}] {#Item type {#Item body {#End}}}}} - {#Some [export_policy name args {#Some type} body]} - - {#Item export_policy {#Item name {#Item type {#Item body {#End}}}}} - {#Some [export_policy name {#End} {#Some type} body]} - - {#Item export_policy {#Item [_ {#Form {#Item name args}}] {#Item body {#End}}}} - {#Some [export_policy name args {#None} body]} - - {#Item export_policy {#Item name {#Item body {#End}}}} - {#Some [export_policy name {#End} {#None} body]} +(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)) - _ - {#None}} - tokens))] - ({{#Some [export_policy name args ?type body]} - (let' [body' ({{#End} - body +(def'' .public exec + Macro + (macro (_ tokens) + ({{#Item value actions} + (let' [dummy (local$ "")] + (meta#in (list (list#mix ("lux type check" (-> Code Code Code) + (function' [pre post] (` ({(~ dummy) (~ post)} + (~ pre))))) + value + actions)))) - _ - (` (function' (~ name) [(~+ args)] (~ body)))} - args) - body'' ({{#Some type} - (` (is (~ type) (~ body'))) - - {#None} - body'} - ?type)] - (meta#in (list (` ("lux def" (~ name) - (~ body'') - (~ export_policy)))))) - - {#None} - (failure "Wrong syntax for def'")} - 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))) - - {#End} - (do meta#monad [] (in (list))) + _ + (failure "Wrong syntax for exec")} + (list#reversed tokens)))) + +(def'' .private def' + Macro + (macro (_ tokens) + (let' [parts (is (Maybe [Code Code (List Code) (Maybe Code) Code]) + ({{#Item export_policy {#Item [_ {#Form {#Item name args}}] {#Item type {#Item body {#End}}}}} + {#Some [export_policy name args {#Some type} body]} + + {#Item export_policy {#Item name {#Item type {#Item body {#End}}}}} + {#Some [export_policy name {#End} {#Some type} body]} + + {#Item export_policy {#Item [_ {#Form {#Item name args}}] {#Item body {#End}}}} + {#Some [export_policy name args {#None} body]} + + {#Item export_policy {#Item name {#Item body {#End}}}} + {#Some [export_policy name {#End} {#None} body]} - _ - (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 - Macro - (macro (_ tokens) - ({{#Item value branches} + _ + {#None}} + tokens))] + ({{#Some [export_policy name args ?type body]} + (let' [body' ({{#End} + body + + _ + (` (function' (~ name) [(~+ args)] (~ body)))} + args) + body'' ({{#Some type} + (` (is (~ type) (~ body'))) + + {#None} + body'} + ?type)] + (meta#in (list (` ("lux def" (~ name) + (~ body'') + (~ export_policy)))))) + + {#None} + (failure "Wrong syntax for def'")} + 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 - [expansion (case_expansion branches)] - (in (list (` ((~ (variant$ expansion)) (~ value)))))) - - _ - (failure "Wrong syntax for case")} - tokens))) - -(def:'' .public pattern - Macro - (macro (_ tokens) - (case tokens - {#Item [_ {#Form {#Item pattern {#End}}}] {#Item body branches}} + [init_expansion (single_expansion (form$ (partial_list (symbol$ name) (form$ args) body branches')))] + (case_expansion init_expansion)) (do meta#monad - [pattern+ (full_expansion #1 pattern)] - (case pattern+ - {#Item pattern' {#End}} - (in (partial_list pattern' body branches)) - - _ - (failure "`pattern` can only expand to 1 pattern."))) - - _ - (failure "Wrong syntax for `pattern` macro")))) + [sub_expansion (case_expansion branches')] + (in (partial_list (form$ (partial_list (symbol$ name) args)) + body + sub_expansion))))) -(def:'' .private pattern#or - Macro - (macro (_ tokens) - (case tokens - (pattern (partial_list [_ {#Form patterns}] body branches)) - (case patterns - {#End} - (failure "pattern#or cannot have 0 patterns") + {#Item pattern {#Item body branches'}} + (do meta#monad + [sub_expansion (case_expansion branches')] + (in (partial_list pattern body sub_expansion))) - _ - (let' [pairs (|> patterns - (list#each (function' [pattern] (list pattern body))) - (list#conjoint))] - (meta#in (list#composite pairs branches)))) - _ - (failure "Wrong syntax for pattern#or")))) + {#End} + (do meta#monad [] (in (list))) -(def:'' .public symbol - Macro - (macro (_ tokens) - (case tokens - (pattern (list [_ {#Symbol [module name]}])) - (meta#in (list (` [(~ (text$ module)) (~ (text$ name))]))) - - _ - (failure (..wrong_syntax_error [..prelude "symbol"]))))) + _ + (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 + Macro + (macro (_ tokens) + ({{#Item value branches} + (do meta#monad + [expansion (case_expansion branches)] + (in (list (` ((~ (variant$ expansion)) (~ value)))))) -(def:' .private (symbol? code) - (-> Code Bit) - (case code - [_ {#Symbol _}] - #1 + _ + (failure "Wrong syntax for case")} + tokens))) + +(def'' .public pattern + Macro + (macro (_ tokens) + (case tokens + {#Item [_ {#Form {#Item pattern {#End}}}] {#Item body branches}} + (do meta#monad + [pattern+ (full_expansion #1 pattern)] + (case pattern+ + {#Item pattern' {#End}} + (in (partial_list pattern' body branches)) + + _ + (failure "`pattern` can only expand to 1 pattern."))) + + _ + (failure "Wrong syntax for `pattern` macro")))) - _ - #0)) +(def'' .private pattern#or + Macro + (macro (_ tokens) + (case tokens + (pattern (partial_list [_ {#Form patterns}] body branches)) + (case patterns + {#End} + (failure "pattern#or cannot have 0 patterns") -(def:'' .public let - Macro - (macro (_ tokens) - (case tokens - (pattern (list [_ {#Tuple bindings}] body)) - (case (..pairs bindings) - {#Some bindings} - (|> bindings - list#reversed - (list#mix (is (-> [Code Code] Code Code) - (function' [lr body'] - (let' [[l r] lr] - (if (symbol? l) - (` ({(~ l) (~ body')} (~ r))) - (` (case (~ r) (~ l) (~ body'))))))) - body) - list - meta#in) + _ + (let' [pairs (|> patterns + (list#each (function' [pattern] (list pattern body))) + (list#conjoint))] + (meta#in (list#composite pairs branches)))) + _ + (failure "Wrong syntax for pattern#or")))) + +(def'' .public symbol + Macro + (macro (_ tokens) + (case tokens + (pattern (list [_ {#Symbol [module name]}])) + (meta#in (list (` [(~ (text$ module)) (~ (text$ name))]))) + + _ + (failure (..wrong_syntax_error [..prelude "symbol"]))))) - {#None} - (failure "let requires an even number of parts")) +(def' .private (symbol? code) + (-> Code Bit) + (case code + [_ {#Symbol _}] + #1 - _ - (failure (..wrong_syntax_error (symbol ..let)))))) + _ + #0)) + +(def'' .public let + Macro + (macro (_ tokens) + (case tokens + (pattern (list [_ {#Tuple bindings}] body)) + (case (..pairs bindings) + {#Some bindings} + (|> bindings + list#reversed + (list#mix (is (-> [Code Code] Code Code) + (function' [lr body'] + (let' [[l r] lr] + (if (symbol? l) + (` ({(~ l) (~ body')} (~ r))) + (` (case (~ r) (~ l) (~ body'))))))) + body) + list + meta#in) -(def:'' .public function - Macro - (macro (_ tokens) - (case (is (Maybe [Text Code (List Code) Code]) - (case tokens - (pattern (list [_ {#Form (partial_list [_ {#Symbol ["" name]}] head tail)}] body)) - {#Some name head tail body} - - _ - {#None})) - {#Some g!name head tail body} - (let [g!blank (local$ "") - nest (is (-> Code (-> Code Code Code)) - (function' [g!name] - (function' [arg body'] - (if (symbol? arg) - (` ([(~ g!name) (~ arg)] (~ body'))) - (` ([(~ g!name) (~ g!blank)] - (.case (~ g!blank) (~ arg) (~ body'))))))))] - (meta#in (list (nest (..local$ g!name) head - (list#mix (nest g!blank) body (list#reversed tail)))))) + {#None} + (failure "let requires an even number of parts")) - {#None} - (failure (..wrong_syntax_error (symbol ..function)))))) + _ + (failure (..wrong_syntax_error (symbol ..let)))))) + +(def'' .public function + Macro + (macro (_ tokens) + (case (is (Maybe [Text Code (List Code) Code]) + (case tokens + (pattern (list [_ {#Form (partial_list [_ {#Symbol ["" name]}] head tail)}] body)) + {#Some name head tail body} + + _ + {#None})) + {#Some g!name head tail body} + (let [g!blank (local$ "") + nest (is (-> Code (-> Code Code Code)) + (function' [g!name] + (function' [arg body'] + (if (symbol? arg) + (` ([(~ g!name) (~ arg)] (~ body'))) + (` ([(~ g!name) (~ g!blank)] + (.case (~ g!blank) (~ arg) (~ body'))))))))] + (meta#in (list (nest (..local$ g!name) head + (list#mix (nest g!blank) body (list#reversed tail)))))) -(def:' .private Parser - Type - {#Named [..prelude "Parser"] - (..type (All (_ a) - (-> (List Code) (Maybe [(List Code) a]))))}) + {#None} + (failure (..wrong_syntax_error (symbol ..function)))))) -(def:' .private (parsed parser tokens) - (All (_ a) (-> (Parser a) (List Code) (Maybe a))) - (case (parser tokens) - (pattern {#Some [(list) it]}) - {#Some it} +(def' .private Parser + Type + {#Named [..prelude "Parser"] + (..type (All (_ a) + (-> (List Code) (Maybe [(List Code) a]))))}) - _ - {#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}]} +(def' .private (parsed parser tokens) + (All (_ a) (-> (Parser a) (List Code) (Maybe a))) + (case (parser tokens) + (pattern {#Some [(list) it]}) + {#Some it} - _ - (case (rightP tokens) - {#Some [tokens right]} - {#Some [tokens {#Right right}]} + _ + {#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}))) - -(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}))) + +(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)])) - {#None} - {#Some [tokens {#None}]})) + {#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}]} -(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 {#None}]})) - _ - {#None})) +(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])) -(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})) - _ - {#None})) +(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])) -(def:' .private (bindingP tokens) - (Parser [Text Code]) - (case tokens - (pattern (partial_list [_ {#Symbol ["" name]}] value &rest)) - {#Some [&rest [name value]]} + _ + {#None})) - _ - {#None})) +(def' .private (bindingP tokens) + (Parser [Text Code]) + (case tokens + (pattern (partial_list [_ {#Symbol ["" name]}] value &rest)) + {#Some [&rest [name value]]} -(def:' .private (endP tokens) - (Parser Any) - (case tokens - (pattern (list)) - {#Some [tokens []]} + _ + {#None})) - _ - {#None})) +(def' .private (endP tokens) + (Parser Any) + (case tokens + (pattern (list)) + {#Some [tokens []]} -(def:' .private (anyP tokens) - (Parser Code) - (case tokens - (pattern (partial_list code tokens')) - {#Some [tokens' code]} + _ + {#None})) - _ - {#None})) +(def' .private (anyP tokens) + (Parser Code) + (case tokens + (pattern (partial_list code tokens')) + {#Some [tokens' code]} -(def:' .private (localP tokens) - (-> (List Code) (Maybe [(List Code) Text])) - (case tokens - (pattern (partial_list [_ {#Symbol ["" local]}] tokens')) - {#Some [tokens' local]} + _ + {#None})) - _ - {#None})) +(def' .private (localP tokens) + (-> (List Code) (Maybe [(List Code) Text])) + (case tokens + (pattern (partial_list [_ {#Symbol ["" local]}] tokens')) + {#Some [tokens' local]} + + _ + {#None})) -(def:' .private (symbolP tokens) - (-> (List Code) (Maybe [(List Code) Symbol])) - (case tokens - (pattern (partial_list [_ {#Symbol it}] tokens')) - {#Some [tokens' it]} +(def' .private (symbolP tokens) + (-> (List Code) (Maybe [(List Code) Symbol])) + (case tokens + (pattern (partial_list [_ {#Symbol it}] tokens')) + {#Some [tokens' it]} - _ - {#None})) + _ + {#None})) (with_template [<parser> <item_type> <item_parser>] - [(def:' .private (<parser> tokens) - (-> (List Code) (Maybe (List <item_type>))) - (case tokens - {#End} - {#Some {#End}} + [(def' .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' .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' .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' .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' .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: - Macro - (macro (_ tokens) - (case (definitionP tokens) - {#Some [export_policy name parameters ?type body]} - (let [body (case parameters - {#End} - 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 + Macro + (macro (_ tokens) + (case (definitionP tokens) + {#Some [export_policy name parameters ?type body]} + (let [body (case parameters + {#End} + body - _ - (` (function ((~ (..local$ name)) (~+ parameters)) - (~ body)))) - body (case ?type - {#Some type} - (` (is (~ type) - (~ body))) - - {#None} - body)] - (meta#in (list (` ("lux def" (~ (..local$ name)) - (~ body) - (~ export_policy)))))) - - {#None} - (failure (..wrong_syntax_error (symbol ..def:)))))) + _ + (` (function ((~ (..local$ name)) (~+ parameters)) + (~ body)))) + body (case ?type + {#Some type} + (` (is (~ type) + (~ body))) + + {#None} + body)] + (meta#in (list (` ("lux def" (~ (..local$ name)) + (~ body) + (~ export_policy)))))) + + {#None} + (failure (..wrong_syntax_error (symbol ..def)))))) -(def: (list#one f xs) +(def (list#one f xs) (All (_ a b) (-> (-> a (Maybe b)) (List a) (Maybe b))) (case xs @@ -2957,7 +2957,7 @@ {#Some y}))) (with_template [<name> <form> <message>] - [(def: .public <name> + [(def .public <name> (macro (_ tokens) (case (list#reversed tokens) (pattern (partial_list last init)) @@ -2972,15 +2972,15 @@ [and (if (~ pre) (~ post) #0) "'and' requires >=1 clauses."] [or (if (~ pre) #1 (~ post)) "'or' requires >=1 clauses."]) -(def: (index part text) +(def (index part text) (-> Text Text (Maybe Nat)) ("lux text index" 0 part text)) -(def: .public (panic! message) +(def .public (panic! message) (-> Text Nothing) ("lux io error" message)) -(def: maybe#else +(def maybe#else (macro (_ tokens state) (case tokens (pattern (list else maybe)) @@ -2996,7 +2996,7 @@ _ {#Left (..wrong_syntax_error (symbol ..maybe#else))}))) -(def: (text#all_split_by splitter input) +(def (text#all_split_by splitter input) (-> Text Text (List Text)) (case (..index splitter input) {#None} @@ -3011,7 +3011,7 @@ ("lux text size" input))] ("lux text clip" after_offset after_length input)))))) -(def: (item idx xs) +(def (item idx xs) (All (_ a) (-> Nat (List a) (Maybe a))) (case xs @@ -3024,7 +3024,7 @@ (item ("lux i64 -" 1 idx) xs')))) ... https://en.wikipedia.org/wiki/Lambda_calculus#%CE%B2-reduction -(def: (reduced env type) +(def (reduced env type) (-> (List Type) Type Type) (case type {#Sum left right} @@ -3070,7 +3070,7 @@ type )) -(def: (applied_type param type_fn) +(def (applied_type param type_fn) (-> Type Type (Maybe Type)) (case type_fn {#UnivQ env body} @@ -3091,7 +3091,7 @@ {#None})) (with_template [<name> <tag>] - [(def: (<name> type) + [(def (<name> type) (-> Type (List Type)) (case type {<tag> left right} @@ -3105,7 +3105,7 @@ [flat_lambda #Function] ) -(def: (flat_application type) +(def (flat_application type) (-> Type [Type (List Type)]) (case type {#Apply head func'} @@ -3115,7 +3115,7 @@ _ [type (list)])) -(def: (interface_methods type) +(def (interface_methods type) (-> Type (Maybe (List Type))) (case type {#Product _} @@ -3141,7 +3141,7 @@ _ {#Some (list type)})) -(def: (module name) +(def (module name) (-> Text (Meta Module)) (function (_ state) (let [[..#info info ..#source source ..#current_module _ ..#modules modules @@ -3155,7 +3155,7 @@ _ {#Left (all text#composite "Unknown module: " name)})))) -(def: (type_slot [module name]) +(def (type_slot [module name]) (-> Symbol (Meta [Nat (List Symbol) Bit Type])) (do meta#monad [=module (..module module) @@ -3176,7 +3176,7 @@ _ (failure (text#composite "Unknown slot: " (symbol#encoded [module name])))))) -(def: (record_slots type) +(def (record_slots type) (-> Type (Meta (Maybe [(List Symbol) (List Type)]))) (case type {#Apply arg func} @@ -3213,7 +3213,7 @@ _ (meta#in {#None}))) -(def: expected_type +(def expected_type (Meta Type) (function (_ state) (let [[..#info info ..#source source ..#current_module _ ..#modules modules @@ -3227,7 +3227,7 @@ {#None} {#Left "Not expecting any type."})))) -(def: (type#encoded type) +(def (type#encoded type) (-> Type Text) (case type {#Primitive name params} @@ -3273,7 +3273,7 @@ (symbol#encoded name) )) -(def: .public implementation +(def .public implementation (macro (_ tokens) (do meta#monad [tokens' (monad#each meta#monad expansion tokens) @@ -3310,7 +3310,7 @@ (list#conjoint tokens'))] (in (list (tuple$ (list#conjoint members))))))) -(def: (text#interposed separator parts) +(def (text#interposed separator parts) (-> Text (List Text) Text) (case parts {#End} @@ -3322,12 +3322,12 @@ head tail))) -(def: (function#identity value) +(def (function#identity value) (All (_ a) (-> a a)) value) -(def: (everyP itP tokens) +(def (everyP itP tokens) (All (_ a) (-> (-> (List Code) (Maybe [(List Code) a])) (-> (List Code) (Maybe (List a))))) @@ -3347,7 +3347,7 @@ {#End} {#Some (list)})) -(def: (caseP tokens) +(def (caseP tokens) (-> (List Code) (Maybe [(List Code) [Text Code]])) (case tokens (pattern (partial_list [_ {#Variant (list [_ {#Symbol ["" niladic]}])}] tokens')) @@ -3359,7 +3359,7 @@ _ {#None})) -(def: .public Variant +(def .public Variant (macro (_ tokens) (case (everyP caseP tokens) {#Some cases} @@ -3371,7 +3371,7 @@ {#None} (failure (..wrong_syntax_error (symbol ..Variant)))))) -(def: (slotP tokens) +(def (slotP tokens) (-> (List Code) (Maybe [(List Code) [Text Code]])) (case tokens (pattern (partial_list [_ {#Symbol ["" slot]}] type tokens')) @@ -3380,7 +3380,7 @@ _ {#None})) -(def: .public Record +(def .public Record (macro (_ tokens) (case tokens (pattern (list [_ {#Tuple record}])) @@ -3397,7 +3397,7 @@ _ (failure (..wrong_syntax_error (symbol ..Record)))))) -(def: (typeP tokens) +(def (typeP tokens) (-> (List Code) (Maybe [Code Text (List Text) Code])) (do maybe#monad [% (declarationP tokens) @@ -3407,7 +3407,7 @@ _ (endP tokens)] (in [export_policy name parameters definition]))) -(def: (textP tokens) +(def (textP tokens) (-> (List Code) (Maybe [(List Code) Text])) (case tokens (pattern (partial_list [_ {#Text it}] tokens')) @@ -3416,7 +3416,7 @@ _ {#None})) -(def: (type_declaration it) +(def (type_declaration it) (-> Code (Meta (Tuple Code (Maybe (Either (List Text) (List Text)))))) ({[_ {#Form {#Item [_ {#Symbol declarer}] parameters}}] (do meta#monad @@ -3448,7 +3448,7 @@ (meta#in [type {#None}])} it)) -(def: .public type: +(def .public type: (macro (_ tokens) (case (typeP tokens) {#Some [export_policy name args type_codes]} @@ -3503,11 +3503,11 @@ #import_alias (Maybe Text) #import_referrals (List Referral)])) -(def: referral_parser +(def referral_parser (Parser Referral) (formP (andP symbolP (someP anyP)))) -(def: (referrals_parser aliased?) +(def (referrals_parser aliased?) (-> Bit (Parser (List Referral))) (all eitherP (manyP referral_parser) @@ -3517,12 +3517,12 @@ (list)))) (inP (list)))) -(def: (text#split_at' at x) +(def (text#split_at' at x) (-> Nat Text [Text Text]) [("lux text clip" 0 at x) ("lux text clip" at (|> x "lux text size" ("lux i64 -" at)) x)]) -(def: (text#split_by token sample) +(def (text#split_by token sample) (-> Text Text (Maybe [Text Text])) (do ..maybe#monad [index (..index token sample) @@ -3530,7 +3530,7 @@ [_ post] (text#split_at' ("lux text size" token) post')]] (in [pre post]))) -(def: (replaced pattern replacement template) +(def (replaced pattern replacement template) (-> Text Text Text Text) ((is (-> Text Text Text) (function (again left right) @@ -3542,11 +3542,11 @@ ("lux text concat" left right)))) "" template)) -(def: (alias_stand_in index) +(def (alias_stand_in index) (-> Nat Text) (all "lux text concat" "[" (nat#encoded index) "]")) -(def: (module_alias context aliased) +(def (module_alias context aliased) (-> (List Text) Text Text) (product#right (list#mix (function (_ replacement [index aliased]) @@ -3555,13 +3555,13 @@ [0 aliased] context))) -(def: .public module_separator +(def .public module_separator "/") -(def: parallel_hierarchy_sigil +(def parallel_hierarchy_sigil "\") -(def: (normal_parallel_path' hierarchy root) +(def (normal_parallel_path' hierarchy root) (-> Text Text Text) (case [(text#split_by ..module_separator hierarchy) (text#split_by ..parallel_hierarchy_sigil root)] @@ -3574,7 +3574,7 @@ "" hierarchy _ (all text#composite root ..module_separator hierarchy)))) -(def: (normal_parallel_path hierarchy root) +(def (normal_parallel_path hierarchy root) (-> Text Text (Maybe Text)) (case (text#split_by ..parallel_hierarchy_sigil root) {#Some ["" root']} @@ -3583,7 +3583,7 @@ _ {#None})) -(def: (relative_ups relatives input) +(def (relative_ups relatives input) (-> Nat Text Nat) (case ("lux text index" relatives ..module_separator input) {#None} @@ -3594,7 +3594,7 @@ (relative_ups ("lux i64 +" 1 relatives) input) relatives))) -(def: (list#after amount list) +(def (list#after amount list) (All (_ a) (-> Nat (List a) (List a))) (case [amount list] (pattern#or [0 _] [_ {#End}]) @@ -3603,7 +3603,7 @@ [_ {#Item _ tail}] (list#after ("lux i64 -" 1 amount) tail))) -(def: (absolute_module_name nested? relative_root module) +(def (absolute_module_name nested? relative_root module) (-> Bit Text Text (Meta Text)) (case (relative_ups 0 module) 0 @@ -3630,7 +3630,7 @@ "Importing module: " module \n " Relative Root: " relative_root \n)))))) -(def: (imports_parser nested? relative_root context imports) +(def (imports_parser nested? relative_root context imports) (-> Bit Text (List Text) (List Code) (Meta (List Importation))) (do meta#monad [imports' (monad#each meta#monad @@ -3701,7 +3701,7 @@ imports)] (in (list#conjoint imports')))) -(def: (exported_definitions module state) +(def (exported_definitions module state) (-> Text (Meta (List Text))) (let [[current_module modules] (case state [..#info info ..#source source ..#current_module current_module ..#modules modules @@ -3753,7 +3753,7 @@ code#encoded))}) )) -(def: (list#only p xs) +(def (list#only p xs) (All (_ a) (-> (-> a Bit) (List a) (List a))) (case xs @@ -3765,7 +3765,7 @@ {#Item x (list#only p xs')} (list#only p xs')))) -(def: (is_member? cases name) +(def (is_member? cases name) (-> (List Text) Text Bit) (let [output (list#mix (function (_ case prev) (or prev @@ -3774,7 +3774,7 @@ cases)] output)) -(def: (test_referrals current_module imported_module all_defs referred_defs) +(def (test_referrals current_module imported_module all_defs referred_defs) (-> Text Text (List Text) (List Text) (Meta (List Any))) (monad#each meta#monad (is (-> Text (Meta Any)) @@ -3784,11 +3784,11 @@ (failure (all text#composite _def " is not defined in module " imported_module " @ " current_module))))) referred_defs)) -(def: (alias_definition imported_module def) +(def (alias_definition imported_module def) (-> Text Text Code) (` ("lux def alias" (~ (local$ def)) (~ (symbol$ [imported_module def]))))) -(def: .public only +(def .public only (macro (_ tokens) (case (..parsed (all ..andP ..textP @@ -3805,21 +3805,21 @@ {.#None} (failure (..wrong_syntax_error (symbol ..only)))))) -(def: .public |>> +(def .public |>> (macro (_ tokens) (do meta#monad [g!_ (..generated_symbol "_") g!arg (..generated_symbol "arg")] (meta#in (list (` (function ((~ g!_) (~ g!arg)) (|> (~ g!arg) (~+ tokens))))))))) -(def: .public <<| +(def .public <<| (macro (_ tokens) (do meta#monad [g!_ (..generated_symbol "_") g!arg (..generated_symbol "arg")] (meta#in (list (` (function ((~ g!_) (~ g!arg)) (<| (~+ tokens) (~ g!arg))))))))) -(def: .public except +(def .public except (macro (_ tokens) (case (..parsed (all ..andP ..textP @@ -3838,7 +3838,7 @@ {.#None} (failure (..wrong_syntax_error (symbol ..except)))))) -(def: (in_env name state) +(def (in_env name state) (-> Text Lux (Maybe Type)) (case state [..#info info ..#source source ..#current_module _ ..#modules modules @@ -3860,7 +3860,7 @@ locals)))) scopes))) -(def: (definition_type name state) +(def (definition_type name state) (-> Symbol Lux (Maybe Type)) (let [[v_module v_name] name [..#info info ..#source source ..#current_module _ ..#modules modules @@ -3897,7 +3897,7 @@ {#Slot _} {#None}))))) -(def: (definition_value name state) +(def (definition_value name state) (-> Symbol (Meta [Type Any])) (let [[v_module v_name] name [..#info info ..#source source ..#current_module _ ..#modules modules @@ -3934,7 +3934,7 @@ {#Slot _} {#Left (text#composite "Unknown definition: " (symbol#encoded name))}))))) -(def: (type_variable idx bindings) +(def (type_variable idx bindings) (-> Nat (List [Nat (Maybe Type)]) (Maybe Type)) (case bindings {#End} @@ -3945,7 +3945,7 @@ bound (type_variable idx bindings')))) -(def: (type_definition full_name) +(def (type_definition full_name) (-> Symbol (Meta Type)) (do meta#monad [.let [[module name] full_name] @@ -3988,7 +3988,7 @@ temp)) ))) -(def: (zipped_2 xs ys) +(def (zipped_2 xs ys) (All (_ a b) (-> (List a) (List b) (List [a b]))) (case xs @@ -4003,7 +4003,7 @@ _ (list))) -(def: .public open +(def .public open (macro (_ tokens) (case tokens (pattern (partial_list [_ {#Form (list [_ {#Text alias}])}] body branches)) @@ -4060,7 +4060,7 @@ _ (failure (..wrong_syntax_error (symbol ..open)))))) -(def: .public cond +(def .public cond (macro (_ tokens) (case (list#reversed tokens) (pattern (partial_list else branches')) @@ -4079,7 +4079,7 @@ _ (failure (..wrong_syntax_error (symbol ..cond)))))) -(def: (enumeration' idx xs) +(def (enumeration' idx xs) (All (_ a) (-> Nat (List a) (List [Nat a]))) (case xs @@ -4089,12 +4089,12 @@ {#End} {#End})) -(def: (enumeration xs) +(def (enumeration xs) (All (_ a) (-> (List a) (List [Nat a]))) (enumeration' 0 xs)) -(def: .public the +(def .public the (macro (_ tokens) (case tokens (pattern (list [_ {#Symbol slot'}] record)) @@ -4136,7 +4136,7 @@ _ (failure (..wrong_syntax_error (symbol ..the)))))) -(def: (open_declaration imported_module alias tags my_tag_index [module short] source type) +(def (open_declaration imported_module alias tags my_tag_index [module short] source type) (-> Text Text (List Symbol) Nat Symbol Code Type (Meta (List Code))) (do meta#monad [output (record_slots type) @@ -4165,7 +4165,7 @@ (~ source+) #0))))))) -(def: (implementation_declarations imported_module alias implementation) +(def (implementation_declarations imported_module alias implementation) (-> Text Text Symbol (Meta (List Code))) (do meta#monad [interface (type_definition implementation) @@ -4185,7 +4185,7 @@ "Can only 'open:' structs: " (symbol#encoded implementation) " : " (type#encoded interface)))))) -(def: (localized module global) +(def (localized module global) (-> Text Symbol Symbol) (case global ["" local] @@ -4194,7 +4194,7 @@ _ global)) -(def: .public open: +(def .public open: (macro (_ tokens) (case (..parsed (all ..andP (..maybeP (all ..andP @@ -4252,14 +4252,14 @@ {.#None} (failure (..wrong_syntax_error (symbol ..open:)))))) -(def: (imported_by? import_name module_name) +(def (imported_by? import_name module_name) (-> Text Text (Meta Bit)) (do meta#monad [module (module module_name) .let [[..#module_hash _ ..#module_aliases _ ..#definitions _ ..#imports imports ..#module_state _] module]] (in (is_member? imports import_name)))) -(def: (referrals module_name extra) +(def (referrals module_name extra) (-> Text (List Code) (Meta (List Referral))) (do meta#monad [extra,referral (case (referrals_parser #0 extra) @@ -4281,7 +4281,7 @@ (list#interposed " ") (list#mix text#composite ""))))))) -(def: refer +(def refer (macro (_ tokens) (case tokens (pattern (partial_list [_ {#Text imported_module}] [_ {#Text alias}] options)) @@ -4299,7 +4299,7 @@ _ (failure (..wrong_syntax_error (symbol ..refer)))))) -(def: .public with +(def .public with (macro (_ tokens) (case (..parsed (..andP ..anyP ..anyP) tokens) @@ -4310,7 +4310,7 @@ {.#None} (failure (..wrong_syntax_error (symbol ..with)))))) -(def: .public at +(def .public at (macro (_ tokens) (case tokens (pattern (list implementation [_ {#Symbol member}])) @@ -4322,7 +4322,7 @@ _ (failure (..wrong_syntax_error (symbol ..at)))))) -(def: .public has +(def .public has (macro (_ tokens) (case tokens (pattern (list [_ {#Symbol slot'}] value record)) @@ -4406,7 +4406,7 @@ _ (failure (..wrong_syntax_error (symbol ..has)))))) -(def: .public revised +(def .public revised (macro (_ tokens) (case tokens (pattern (list [_ {#Symbol slot'}] fun record)) @@ -4476,7 +4476,7 @@ _ (failure (..wrong_syntax_error (symbol ..revised)))))) -(def: .private with_template#pattern +(def .private with_template#pattern (macro (_ tokens) (case tokens (pattern (partial_list [_ {#Form (list [_ {#Tuple bindings}] @@ -4507,7 +4507,7 @@ (failure (..wrong_syntax_error (symbol ..with_template#pattern)))))) (with_template [<name> <extension>] - [(def: .public <name> + [(def .public <name> (All (_ s) (-> (I64 s) (I64 s))) (|>> (<extension> 1)))] @@ -4516,7 +4516,7 @@ [-- "lux i64 -"] ) -(def: (interleaved xs ys) +(def (interleaved xs ys) (All (_ a) (-> (List a) (List a) (List a))) (case xs @@ -4531,7 +4531,7 @@ {#Item y ys'} (partial_list x y (interleaved xs' ys'))))) -(def: (type_code type) +(def (type_code type) (-> Type Code) (case type {#Primitive name params} @@ -4562,7 +4562,7 @@ ... (~ (type_code anonymous))}) (symbol$ [module name]))) -(def: .public loop +(def .public loop (macro (_ tokens) (let [?params (case tokens (pattern (list [_ {#Form (list name [_ {#Tuple bindings}])}] body)) @@ -4605,7 +4605,7 @@ {#None} (failure (..wrong_syntax_error (symbol ..loop))))))) -(def: (with_expansions' label tokens target) +(def (with_expansions' label tokens target) (-> Text (List Code) Code (List Code)) (case target (pattern#or [_ {#Bit _}] [_ {#Nat _}] [_ {#Int _}] [_ {#Rev _}] [_ {#Frac _}] [_ {#Text _}]) @@ -4624,7 +4624,7 @@ [#Variant] [#Tuple]))) -(def: .public with_expansions +(def .public with_expansions (macro (_ tokens) (case (parsed (andP (tupleP (someP bindingP)) (someP anyP)) tokens) {#Some [bindings bodies]} @@ -4657,7 +4657,7 @@ {#None} (failure (..wrong_syntax_error (symbol ..with_expansions)))))) -(def: (flat_alias type) +(def (flat_alias type) (-> Type Type) (case type (with_template#pattern [<name>] @@ -4676,7 +4676,7 @@ _ type)) -(def: (static_simple_literal name) +(def (static_simple_literal name) (-> Symbol (Meta Code)) (do meta#monad [type+value (definition_value name) @@ -4695,7 +4695,7 @@ _ (failure (text#composite "Cannot anti-quote type: " (symbol#encoded name)))))) -(def: (static_literal token) +(def (static_literal token) (-> Code (Meta Code)) (case token [_ {#Symbol [def_module def_name]}] @@ -4720,7 +4720,7 @@ ... (at meta#monad in token) )) -(def: .public static +(def .public static (macro (_ tokens) (case tokens (pattern (list pattern)) @@ -4734,7 +4734,7 @@ (type: Multi_Level_Case [Code (List [Code Code])]) -(def: (case_level^ level) +(def (case_level^ level) (-> Code (Meta [Code Code])) (case level (pattern [_ {#Tuple (list expr binding)}]) @@ -4744,7 +4744,7 @@ (meta#in [level (` #1)]) )) -(def: (multi_level_case^ levels) +(def (multi_level_case^ levels) (-> (List Code) (Meta Multi_Level_Case)) (case levels {#End} @@ -4755,7 +4755,7 @@ [extras' (monad#each meta#monad case_level^ extras)] (in [init extras'])))) -(def: (multi_level_case$ g!_ [[init_pattern levels] body]) +(def (multi_level_case$ g!_ [[init_pattern levels] body]) (-> Code [Multi_Level_Case Code] (List Code)) (let [inner_pattern_body (list#mix (function (_ [calculation pattern] success) (let [bind? (case pattern @@ -4775,7 +4775,7 @@ (is (List [Code Code]) (list#reversed levels)))] (list init_pattern inner_pattern_body))) -(def: pattern#multi +(def pattern#multi (macro (_ tokens) (case tokens (pattern (partial_list [_meta {#Form levels}] body next_branches)) @@ -4807,12 +4807,12 @@ _ (failure (..wrong_syntax_error (symbol ..pattern#multi)))))) -(def: .public (same? reference sample) +(def .public (same? reference sample) (All (_ a) (-> a a Bit)) ("lux is" reference sample)) -(def: .public as_expected +(def .public as_expected (macro (_ tokens) (case tokens (pattern (list expr)) @@ -4823,12 +4823,12 @@ _ (failure (..wrong_syntax_error (symbol ..as_expected)))))) -(def: location +(def location (Meta Location) (function (_ compiler) {#Right [compiler (the #location compiler)]})) -(def: .public undefined +(def .public undefined (macro (_ tokens) (case tokens {#End} @@ -4842,7 +4842,7 @@ _ (failure (..wrong_syntax_error (symbol ..undefined)))))) -(def: .public type_of +(def .public type_of (macro (_ tokens) (case tokens (pattern (list [_ {#Symbol var_name}])) @@ -4859,7 +4859,7 @@ _ (failure (..wrong_syntax_error (symbol ..type_of)))))) -(def: (templateP tokens) +(def (templateP tokens) (-> (List Code) (Maybe [Text (List Text) (List Code)])) (do maybe#monad [% (local_declarationP tokens) @@ -4869,7 +4869,7 @@ _ (endP tokens)] (in [name parameters templates]))) -(def: .public template +(def .public template (macro (_ tokens) (case (templateP tokens) {#Some [name args input_templates]} @@ -4897,7 +4897,7 @@ (failure (..wrong_syntax_error (symbol ..template)))))) (with_template [<name> <to>] - [(def: .public <name> + [(def .public <name> (template (<name> it) [(..|> it (..is (..I64 ..Any)) (..as <to>))]))] @@ -4907,11 +4907,11 @@ [rev ..Rev] ) -(def: .public these +(def .public these (macro (_ tokens compiler) {#Right [compiler tokens]})) -(def: .public char +(def .public char (macro (_ tokens compiler) (case tokens (pattern#multi (pattern (list [_ {#Text input}])) @@ -4923,12 +4923,12 @@ _ {#Left (..wrong_syntax_error (symbol ..char))}))) -(def: target +(def target (Meta Text) (function (_ compiler) {#Right [compiler (the [#info #target] compiler)]})) -(def: (platform_name choice) +(def (platform_name choice) (-> Code (Meta Text)) (case choice [_ {#Text platform}] @@ -4954,7 +4954,7 @@ "Invalid target platform syntax: " (..code#encoded choice) \n "Must be either a text literal or a symbol.")))) -(def: (target_pick target options default) +(def (target_pick target options default) (-> Text (List [Code Code]) (Maybe Code) (Meta (List Code))) (case options {#End} @@ -4972,7 +4972,7 @@ (meta#in (list pick)) (target_pick target options' default))))) -(def: .public for +(def .public for (macro (_ tokens) (case (..parsed (..andP (..someP (..andP ..anyP ..anyP)) (..maybeP ..anyP)) @@ -4986,7 +4986,7 @@ (failure (..wrong_syntax_error (symbol ..for)))))) ... TODO: Delete "scope_type_vars" (including the #scope_type_vars Lux state) and "parameter" ASAP. -(for "{old}" (these (def: (scope_type_vars state) +(for "{old}" (these (def (scope_type_vars state) (Meta (List Nat)) (case state [..#info info ..#source source ..#current_module _ ..#modules modules @@ -4995,7 +4995,7 @@ ..#scope_type_vars scope_type_vars ..#eval _eval] {#Right [state scope_type_vars]})) - (def: .public parameter + (def .public parameter (macro (_ tokens) (case tokens (pattern (list [_ {#Nat idx}])) @@ -5010,9 +5010,9 @@ _ (failure (..wrong_syntax_error (symbol ..$))))))) - (these (def: .public parameter ""))) + (these (def .public parameter ""))) -(def: (refer_code imported_module alias referrals) +(def (refer_code imported_module alias referrals) (-> Text Text (List Referral) Code) (` ((~! ..refer) (~ (text$ imported_module)) @@ -5021,7 +5021,7 @@ (` ((~ (symbol$ macro)) (~+ parameters)))) referrals))))) -(def: .public using +(def .public using (macro (_ _imports) (do meta#monad [current_module ..current_module_name @@ -5048,12 +5048,12 @@ =refers) =refers)})))) -(def: (symbol#= [moduleL shortL] [moduleR shortR]) +(def (symbol#= [moduleL shortL] [moduleR shortR]) (-> Symbol Symbol Bit) (and (text#= moduleL moduleR) (text#= shortL shortR))) -(def: (type#= left right) +(def (type#= left right) (-> Type Type Bit) (case [left right] [{#Primitive nameL parametersL} {#Primitive nameR parametersR}] @@ -5099,15 +5099,15 @@ (type: .public Immediate_UnQuote (Primitive "#Macro/Immediate_UnQuote")) -(def: .public immediate_unquote +(def .public immediate_unquote (-> Macro Immediate_UnQuote) (|>> (as Immediate_UnQuote))) -(def: immediate_unquote_macro +(def immediate_unquote_macro (-> Immediate_UnQuote Macro') (|>> (as Macro'))) -(def: .public ~~ +(def .public ~~ (..immediate_unquote (macro (_ it) (case it @@ -5117,7 +5117,7 @@ _ (failure (wrong_syntax_error (symbol ..~~))))))) -(def: aggregate_embedded_expansions +(def aggregate_embedded_expansions (template (_ embedded_expansions <@> <tag> <*>) [(do meta#monad [<*>' (monad#each meta#monad embedded_expansions <*>)] @@ -5127,7 +5127,7 @@ (list#mix list#composite (list))) [<@> {<tag> (list#each product#right <*>')}]]))])) -(def: (meta#try it) +(def (meta#try it) (All (_ a) (-> (Meta a) (Meta (Either Text a)))) (function (_ state) (case (it state) @@ -5137,7 +5137,7 @@ {#Right [state output]} {#Right [state {#Right output}]}))) -(def: (embedded_expansions code) +(def (embedded_expansions code) (-> Code (Meta [(List Code) Code])) (case code (pattern [@ {#Form (partial_list [@symbol {#Symbol original_symbol}] parameters)}]) @@ -5175,7 +5175,7 @@ _ (meta#in [(list) code]))) -(def: .public `` +(def .public `` (macro (_ tokens) (case tokens (pattern (list raw)) @@ -5188,15 +5188,15 @@ _ (failure (..wrong_syntax_error (symbol ..``)))))) -(def: .public false +(def .public false Bit #0) -(def: .public true +(def .public true Bit #1) -(def: .public try +(def .public try (macro (_ tokens) (case tokens (pattern (list expression)) @@ -5209,7 +5209,7 @@ _ (..failure (..wrong_syntax_error (symbol ..try)))))) -(def: (methodP tokens) +(def (methodP tokens) (-> (List Code) (Maybe [(List Code) [Text Code]])) (case tokens (pattern (partial_list [_ {#Form (list [_ {#Text "lux type check"}] @@ -5221,7 +5221,7 @@ _ {#None})) -(def: .public Interface +(def .public Interface (macro (_ tokens) (do meta#monad [methods' (monad#each meta#monad expansion tokens)] @@ -5233,14 +5233,14 @@ {#None} (failure (..wrong_syntax_error (symbol ..Interface))))))) -(def: (recursive_type g!self g!dummy name body) +(def (recursive_type g!self g!dummy name body) (-> Code Code Text Code Code) (` {.#Apply (..Primitive "") (.All ((~ g!self) (~ g!dummy)) (~ (let$ (local$ name) (` {.#Apply (..Primitive "") (~ g!self)}) body)))})) -(def: .public Rec +(def .public Rec (macro (_ tokens) (case tokens (pattern (list [_ {#Symbol "" name}] body)) |