diff options
Diffstat (limited to 'stdlib/source/library')
| -rw-r--r-- | stdlib/source/library/lux.lux | 4307 | ||||
| -rw-r--r-- | stdlib/source/library/lux/type/unit.lux | 24 | ||||
| -rw-r--r-- | stdlib/source/library/lux/type/unit/scale.lux | 16 |
3 files changed, 2164 insertions, 2183 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 891065652..9b479ce35 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -813,7 +813,7 @@ {#End}}}))) #0) -("lux def" def-3 +("lux def" def' ("lux macro" (function'' [tokens] ({{#Item [export_policy @@ -830,7 +830,7 @@ {#End}]}) _ - (failure "Wrong syntax for def-3")} + (failure "Wrong syntax for def'")} tokens))) #0) @@ -846,580 +846,553 @@ tokens))) #1) -(def-3 .public comment - Macro - (macro (_ tokens) - (meta#in {#End}))) - -(def-3 .private $' - Macro - (macro (_ tokens) - ({{#Item x {#End}} - (meta#in tokens) +(def' .public comment + Macro + (macro (_ tokens) + (meta#in {#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}}) +(def' .private $' + Macro + (macro (_ tokens) + ({{#Item x {#End}} + (meta#in tokens) - _ - (failure "Wrong syntax for $'")} - tokens))) - -(def-3 .private (list#mix f init xs) - ... (All (_ a b) (-> (-> b a a) a (List b) a)) - {#UnivQ {#End} {#UnivQ {#End} {#Function {#Function {#Parameter 1} - {#Function {#Parameter 3} - {#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-3 .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-3 .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-3 .private Replacement_Environment - Type - ($' List {#Product Text Code})) - -(def-3 .private (replacement_environment xs ys) - {#Function ($' List Text) {#Function ($' List Code) Replacement_Environment}} - ({[{#Item x xs'} {#Item y ys'}] - {#Item [x y] (replacement_environment xs' ys')} + {#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}}) - _ - {#End}} - [xs ys])) - -(def-3 .private (text#= reference sample) - {#Function Text {#Function Text Bit}} - ("lux text =" reference sample)) - -(def-3 .private (replacement for environment) - {#Function Text {#Function Replacement_Environment ($' Maybe Code)}} - ({{#End} - {#None} - - {#Item [k v] environment'} - ({[#1] {#Some v} - [#0] (replacement for environment')} - (text#= k for))} - environment)) - -(def-3 .private (with_replacements reps syntax) - {#Function Replacement_Environment {#Function Code Code}} - ({[_ {#Symbol "" name}] - ({{#Some replacement} - replacement - - {#None} - syntax} - (..replacement name reps)) - - [meta {#Form parts}] - [meta {#Form (list#each (with_replacements reps) parts)}] - - [meta {#Variant members}] - [meta {#Variant (list#each (with_replacements reps) members)}] - - [meta {#Tuple members}] - [meta {#Tuple (list#each (with_replacements reps) members)}] - - _ - syntax} - syntax)) - -(def-3 .private (n/* param subject) - {#Function Nat {#Function Nat Nat}} - ("lux type as" Nat - ("lux i64 *" - ("lux type as" Int param) - ("lux type as" Int subject)))) - -(def-3 .private (list#size list) - {#UnivQ {#End} - {#Function ($' List {#Parameter 1}) Nat}} - (list#mix (function'' [_ acc] ("lux i64 +" 1 acc)) 0 list)) - -(def-3 .private (let$ binding value body) - {#Function Code {#Function Code {#Function Code Code}}} - (form$ {#Item (variant$ {#Item binding {#Item body {#End}}}) - {#Item value {#End}}})) - -(def-3 .private |#End| - Code - (variant$ {#Item (symbol$ [..prelude "#End"]) {#End}})) - -(def-3 .private (|#Item| head tail) - {#Function Code {#Function Code Code}} - (variant$ {#Item (symbol$ [..prelude "#Item"]) - {#Item head - {#Item tail - {#End}}}})) - -(def-3 .private (UnivQ$ body) - {#Function Code Code} - (variant$ {#Item (symbol$ [..prelude "#UnivQ"]) {#Item ..|#End| {#Item body {#End}}}})) - -(def-3 .private (ExQ$ body) - {#Function Code Code} - (variant$ {#Item (symbol$ [..prelude "#ExQ"]) {#Item ..|#End| {#Item body {#End}}}})) - -(def-3 .private quantification_level - Text - ("lux text concat" double_quote - ("lux text concat" "quantification_level" - double_quote))) - -(def-3 .private quantified - {#Function Code Code} - (let$ (local$ ..quantification_level) (nat$ 0))) - -(def-3 .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-3 .private (next_level depth) - {#Function Nat Nat} - ("lux i64 +" 2 depth)) - -(def-3 .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-3 .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)} - - ... Leave these alone. - {#Named name anonymous} type - {#Var id} type - {#Ex id} type} - type) + _ + (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))) - _ - type} - permission)) - -(def-3 .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-3 .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-3 .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-3 .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-3 .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' .private Replacement_Environment + Type + ($' List {#Product Text Code})) -(def-3 .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)))) +(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-3 .public list - Macro - (macro (_ xs) - (meta#in {#Item (list#mix |#Item| |#End| (list#reversed xs)) - {#End}}))) + _ + {#End}} + [xs ys])) -(def-3 .private partial_list - Macro - (macro (_ xs) - ({{#Item last init} - (meta#in (list (list#mix |#Item| last init))) +(def' .private (text#= reference sample) + {#Function Text {#Function Text Bit}} + ("lux text =" reference sample)) - _ - (failure "Wrong syntax for partial_list")} - (list#reversed xs)))) +(def' .private (replacement for environment) + {#Function Text {#Function Replacement_Environment ($' Maybe Code)}} + ({{#End} + {#None} -(def-3 .public Union - Macro - (macro (_ tokens) - ({{#End} - (meta#in (list (symbol$ [..prelude "Nothing"]))) + {#Item [k v] environment'} + ({[#1] {#Some v} + [#0] (replacement for environment')} + (text#= k for))} + environment)) - {#Item last prevs} - (meta#in (list (list#mix (function'' [left right] (variant$ (list (symbol$ [..prelude "#Sum"]) left right))) - last - prevs)))} - (list#reversed tokens)))) +(def' .private (with_replacements reps syntax) + {#Function Replacement_Environment {#Function Code Code}} + ({[_ {#Symbol "" name}] + ({{#Some replacement} + replacement -(def-3 .public Tuple - Macro - (macro (_ tokens) - ({{#End} - (meta#in (list (symbol$ [..prelude "Any"]))) + {#None} + syntax} + (..replacement name reps)) - {#Item last prevs} - (meta#in (list (list#mix (function'' [left right] (variant$ (list (symbol$ [..prelude "#Product"]) left right))) - last - prevs)))} - (list#reversed tokens)))) + [meta {#Form parts}] + [meta {#Form (list#each (with_replacements reps) parts)}] -(def-3 .private function' - Macro - (macro (_ tokens) - (let'' [name tokens'] ({{#Item [[_ {#Symbol ["" name]}] tokens']} - [name tokens'] - - _ - ["" 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) + [meta {#Variant members}] + [meta {#Variant (list#each (with_replacements reps) members)}] - _ - (failure "Wrong syntax for function'")} - 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-3 .private def-2 - 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)))) + ... Leave these alone. + {#Named name anonymous} type + {#Var id} type + {#Ex id} type} + type) - _ - (failure "Wrong syntax for def-2")} - tokens))) - -(def-2 .public Or - Macro - ..Union) - -(def-2 .public And - Macro - ..Tuple) - -(def-2 .private (pairs xs) - (All (_ a) (-> ($' List a) ($' Maybe ($' List (Tuple a a))))) - ({{#Item x {#Item y xs'}} - ({{#Some tail} - {#Some {#Item [x y] tail}} - - {#None} - {#None}} - (pairs xs')) + _ + 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)))) - {#End} - {#Some {#End}} +(def' .public list + Macro + (macro (_ xs) + (meta#in {#Item (list#mix |#Item| |#End| (list#reversed xs)) + {#End}}))) - _ - {#None}} - xs)) +(def' .private partial_list + Macro + (macro (_ xs) + ({{#Item last init} + (meta#in (list (list#mix |#Item| last init))) -(def-3 .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 partial_list")} + (list#reversed xs)))) + +(def' .public Union + Macro + (macro (_ tokens) + ({{#End} + (meta#in (list (symbol$ [..prelude "Nothing"]))) + + {#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 Tuple + Macro + (macro (_ tokens) + ({{#End} + (meta#in (list (symbol$ [..prelude "Any"]))) + + {#Item last prevs} + (meta#in (list (list#mix (function'' [left right] (variant$ (list (symbol$ [..prelude "#Product"]) left right))) + last + prevs)))} + (list#reversed tokens)))) + +(def' .private function' + Macro + (macro (_ tokens) + (let'' [name tokens'] ({{#Item [[_ {#Symbol ["" name]}] tokens']} + [name tokens'] - _ - (failure "Wrong syntax for let'")} - tokens))) + _ + ["" 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) + + _ + (failure "Wrong syntax for function'")} + 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}} + + {#None} + {#None}} + (pairs xs')) -(def-2 .private (any? p xs) - (All (_ a) - (-> (-> a Bit) ($' List a) Bit)) - ({{#End} - #0 - - {#Item x xs'} - ({[#1] #1 - [#0] (any? p xs')} - (p x))} - xs)) - -(def-2 .private (with_location content) - (-> Code Code) - (tuple$ (list (tuple$ (list (text$ "") (nat$ 0) (nat$ 0))) - content))) - -(def-2 .private (untemplated_list tokens) - (-> ($' List Code) Code) - ({{#End} - |#End| - - {#Item token tokens'} - (|#Item| token (untemplated_list tokens'))} - tokens)) - -(def-2 .private (list#composite xs ys) - (All (_ a) (-> ($' List a) ($' List a) ($' List a))) - (list#mix (function' [head tail] {#Item head tail}) - ys - (list#reversed xs))) - -(def-2 .private (right_associativity op a1 a2) - (-> Code Code Code Code) - ({[_ {#Form parts}] - (form$ (list#composite parts (list a1 a2))) + {#End} + {#Some {#End}} - _ - (form$ (list op a1 a2))} - op)) + _ + {#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)) -(def-2 .private (function#flipped func) - (All (_ a b c) - (-> (-> a b c) (-> b a c))) - (function' [right left] - (func left right))) + _ + (failure "Wrong syntax for let'")} + tokens))) + +(def' .private (any? p xs) + (All (_ a) + (-> (-> a Bit) ($' List a) Bit)) + ({{#End} + #0 + + {#Item x xs'} + ({[#1] #1 + [#0] (any? p xs')} + (p x))} + xs)) + +(def' .private (with_location location content) + (-> Location Code Code) + (let' [[module line column] location] + (tuple$ (list (tuple$ (list (text$ module) (nat$ line) (nat$ column))) + content)))) + +(def' .private (untemplated_list tokens) + (-> ($' List Code) Code) + ({{#End} + |#End| + + {#Item token tokens'} + (|#Item| token (untemplated_list tokens'))} + tokens)) + +(def' .private (list#composite xs ys) + (All (_ a) (-> ($' List a) ($' List a) ($' List a))) + (list#mix (function' [head tail] {#Item head tail}) + ys + (list#reversed xs))) + +(def' .private (right_associativity op a1 a2) + (-> Code Code Code Code) + ({[_ {#Form parts}] + (form$ (list#composite parts (list a1 a2))) -(def-3 .public left - Macro - (macro (_ tokens) - ({{#Item op tokens'} - ({{#Item first nexts} - (meta#in (list (list#mix (function#flipped (right_associativity op)) first nexts))) + _ + (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') - - _ - (failure "Wrong syntax for left")} - tokens))) + _ + (failure "Wrong syntax for left")} + tokens') + + _ + (failure "Wrong syntax for left")} + tokens))) -(def-3 .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-2 .public all Macro ..right) +(def' .public all Macro ..right) ... (type (Monad m) ... (Interface @@ -1439,1786 +1412,1795 @@ ["#in" "#then"] #0) -(def-2 .private maybe#monad - ($' Monad Maybe) - [#in - (function' [x] {#Some x}) - - #then - (function' [f ma] - ({{#None} {#None} - {#Some a} (f a)} - ma))]) - -(def-2 .private meta#monad - ($' Monad Meta) - [#in - (function' [x] - (function' [state] - {#Right state x})) +(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)) + + _ + (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)))) + + _ + (failure "Wrong syntax for if")} + tokens))) + +(def' .private PList + Type + (All (_ a) ($' List (Tuple Text a)))) + +(def' .private (plist#value k plist) + (All (_ a) + (-> Text ($' PList a) ($' Maybe a))) + ({{#Item [[k' v] plist']} + (if (text#= k k') + {#Some v} + (plist#value k plist')) + + {#End} + {#None}} + plist)) + +(def' .private (plist#with k v plist) + (All (_ a) + (-> Text a ($' PList a) ($' PList a))) + ({{#Item [k' v'] plist'} + (if (text#= k k') + (partial_list [k v] plist') + (partial_list [k' v'] (plist#with k v plist'))) + + {#End} + (list [k v])} + plist)) + +(def' .private (global_symbol full_name state) + (-> Symbol ($' Meta Symbol)) + (let' [[module name] full_name + [..#info info ..#source source ..#current_module _ ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed seed ..#expected expected ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] state] + ({{#Some [..#module_hash _ ..#module_aliases _ ..#definitions definitions ..#imports _ ..#module_state _]} + ({{#Some constant} + ({{#Definition _} {#Right [state full_name]} + {#Tag _} {#Right [state full_name]} + {#Slot _} {#Right [state full_name]} + {#Type _} {#Right [state full_name]} + + {#Alias real_name} + {#Right [state real_name]}} + constant) + + {#None} + {#Left (all text#composite "Unknown definition: " (symbol#encoded full_name))}} + (plist#value name definitions)) + + {#None} + {#Left (all text#composite "Unknown module: " module " @ " (symbol#encoded full_name))}} + (plist#value module modules)))) + +(def' .private (|List<Code>| expression) + (-> Code Code) + (let' [type (variant$ (list (symbol$ [..prelude "#Apply"]) + (symbol$ [..prelude "Code"]) + (symbol$ [..prelude "List"])))] + (form$ (list (text$ "lux type check") type expression)))) + +(def' .private (untemplated_text location value) + (-> Location Text Code) + (with_location location (variant$ (list (symbol$ [..prelude "#Text"]) (text$ value))))) + +(def' .public UnQuote + Type + {#Primitive "#Macro/UnQuote" {#End}}) + +(def' .public (unquote it) + (-> Macro UnQuote) + ("lux type as" UnQuote it)) + +(def' .public (unquote_macro it) + (-> UnQuote Macro') + ("lux type as" Macro' it)) + +(def' .public Spliced_UnQuote + Type + {#Primitive "#Macro/Spliced_UnQuote" {#End}}) + +(def' .public (spliced_unquote it) + (-> Macro Spliced_UnQuote) + ("lux type as" Spliced_UnQuote it)) + +(def' .public (spliced_unquote_macro it) + (-> Spliced_UnQuote Macro') + ("lux type as" Macro' it)) + +(def' .private (list#one f xs) + (All (_ a b) + (-> (-> a ($' Maybe b)) ($' List a) ($' Maybe b))) + ({{#End} + {#None} + + {#Item x xs'} + ({{#None} + (list#one f xs') + + {#Some y} + {#Some y}} + (f x))} + xs)) + +(def' .private (in_env name state) + (-> Text Lux ($' Maybe Type)) + (let' [[..#info info ..#source source ..#current_module _ ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed seed ..#expected expected ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] state] + (list#one ("lux type check" + (-> Scope ($' Maybe Type)) + (function' [env] + (let' [[..#name _ + ..#inner _ + ..#locals [..#counter _ ..#mappings locals] + ..#captured _] env] + (list#one ("lux type check" + (-> (Tuple Text (Tuple Type Any)) ($' Maybe Type)) + (function' [it] + (let' [[bname [type _]] it] + (if (text#= name bname) + {#Some type} + {#None})))) + locals)))) + scopes))) + +(def' .private (available? expected_module current_module exported?) + (-> Text ($' Maybe Text) Bit Bit) + (if exported? + #1 + ({{.#None} + #0 + + {.#Some current_module} + (text#= expected_module current_module)} + current_module))) + +(def' .private (definition_value name state) + (-> Symbol ($' Meta (Tuple Type Any))) + (let' [[expected_module expected_short] name + [..#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] state] + ({{#None} + {#Left (text#composite "Unknown definition: " (symbol#encoded name))} + + {#Some [..#definitions definitions + ..#module_hash _ + ..#module_aliases _ + ..#imports _ + ..#module_state _]} + ({{#None} + {#Left (text#composite "Unknown definition: " (symbol#encoded name))} + + {#Some definition} + ({{#Alias real_name} + (definition_value real_name state) + + {#Definition [exported? def_type def_value]} + (if (available? expected_module current_module exported?) + {#Right [state [def_type def_value]]} + {#Left (text#composite "Unavailable definition: " (symbol#encoded name))}) + + {#Type [exported? type labels]} + (if (available? expected_module current_module exported?) + {#Right [state [..Type type]]} + {#Left (text#composite "Unavailable definition: " (symbol#encoded name))}) + + {#Tag _} + {#Left (text#composite "Unknown definition: " (symbol#encoded name))} + + {#Slot _} + {#Left (text#composite "Unknown definition: " (symbol#encoded name))}} + definition)} + (plist#value expected_short definitions))} + (plist#value expected_module modules)))) + +(def' .private (global_value global lux) + (-> Symbol ($' Meta ($' Maybe (Tuple Type Any)))) + (let' [[module short] global] + ({{#Right [lux' type,value]} + {#Right [lux' {#Some type,value}]} + + {#Left error} + {#Right [lux {#None}]}} + ({"" ({{#None} + (definition_value global lux) + + {#Some _} + {#Left (text#composite "Not a global value: " (symbol#encoded global))}} + (in_env short lux)) + + _ + (definition_value global lux)} + module)))) + +(def' .private (bit#and left right) + (-> Bit Bit Bit) + (if left + right + #0)) + +(def' .private (symbol#= left right) + (-> Symbol Symbol Bit) + (let' [[moduleL shortL] left + [moduleR shortR] right] + (all bit#and + (text#= moduleL moduleR) + (text#= shortL shortR)))) + +(def' .private (every? ?) + (All (_ a) + (-> (-> a Bit) ($' List a) Bit)) + (list#mix (function' [_2 _1] (if _1 (? _2) #0)) #1)) + +(def' .private (zipped_2 xs ys) + (All (_ a b) + (-> ($' List a) ($' List b) ($' List (Tuple a b)))) + ({{#Item x xs'} + ({{#Item y ys'} + (partial_list [x y] (zipped_2 xs' ys')) + + _ + (list)} + ys) - #then - (function' [f ma] - (function' [state] - ({{#Left msg} - {#Left msg} - - {#Right [state' a]} - (f a state')} - (ma state))))]) - -(def-3 .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)) + _ + (list)} + xs)) + +(def' .private (type#= left right) + (-> Type Type Bit) + ({[{#Primitive nameL parametersL} {#Primitive nameR parametersR}] + (all bit#and + (text#= nameL nameR) + ("lux i64 =" (list#size parametersL) (list#size parametersR)) + (every? (function' [l,r] (let' [[itL itR] l,r] (type#= itL itR))) + (zipped_2 parametersL parametersR))) + + [{#Sum leftL rightL} {#Sum leftR rightR}] + (all bit#and + (type#= leftL leftR) + (type#= rightL rightR)) + + [{#Product leftL rightL} {#Product leftR rightR}] + (all bit#and + (type#= leftL leftR) + (type#= rightL rightR)) + + [{#Function leftL rightL} {#Function leftR rightR}] + (all bit#and + (type#= leftL leftR) + (type#= rightL rightR)) + + [{#Apply leftL rightL} {#Apply leftR rightR}] + (all bit#and + (type#= leftL leftR) + (type#= rightL rightR)) + + [{#Parameter idL} {#Parameter idR}] + ("lux i64 =" idL idR) + + [{#Var idL} {#Var idR}] + ("lux i64 =" idL idR) + + [{#Ex idL} {#Ex idR}] + ("lux i64 =" idL idR) + + [{#UnivQ envL bodyL} {#UnivQ envR bodyR}] + (all bit#and + ("lux i64 =" (list#size envL) (list#size envR)) + (every? (function' [l,r] (let' [[itL itR] l,r] (type#= itL itR))) + (zipped_2 envL envR)) + (type#= bodyL bodyR)) + + [{#ExQ envL bodyL} {#ExQ envR bodyR}] + (all bit#and + ("lux i64 =" (list#size envL) (list#size envR)) + (every? (function' [l,r] (let' [[itL itR] l,r] (type#= itL itR))) + (zipped_2 envL envR)) + (type#= bodyL bodyR)) + + [{#Named nameL anonL} {#Named nameR anonR}] + (all bit#and + (symbol#= nameL nameR) + (type#= anonL anonR)) - _ - (failure "Wrong syntax for do")} - tokens))) - -(def-2 .private (monad#each m f xs) - (All (_ m a b) - (-> ($' Monad m) - (-> a ($' m b)) - ($' List a) - ($' m ($' List b)))) - (let' [[..#in in ..#then _] m] - ({{#End} - (in {#End}) - - {#Item x xs'} - (do m - [y (f x) - ys (monad#each m f xs')] - (in {#Item y ys}))} - xs))) - -(def-2 .private (monad#mix m f y xs) - (All (_ m a b) - (-> ($' Monad m) - (-> a b ($' m b)) - b - ($' List a) - ($' m b))) - (let' [[..#in in ..#then _] m] - ({{#End} - (in y) - - {#Item x xs'} - (do m - [y' (f x y)] - (monad#mix m f y' xs'))} - xs))) - -(def-3 .public if - Macro - (macro (_ tokens) - ({{#Item test {#Item then {#Item else {#End}}}} - (meta#in (list (form$ (list (variant$ (list (bit$ #1) then - (bit$ #0) else)) - test)))) + _ + #0} + [left right])) - _ - (failure "Wrong syntax for if")} - tokens))) +(def' .private (one_expansion it) + (-> ($' Meta ($' List Code)) ($' Meta Code)) + (do meta#monad + [it it] + ({{#Item it {#End}} + (in it) -(def-2 .private PList - Type - (All (_ a) ($' List (Tuple Text a)))) + _ + (failure "Must expand to 1 element.")} + it))) -(def-2 .private (plist#value k plist) - (All (_ a) - (-> Text ($' PList a) ($' Maybe a))) - ({{#Item [[k' v] plist']} - (if (text#= k k') - {#Some v} - (plist#value k plist')) +(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]} - {#End} - {#None}} - plist)) + _ + {#Left "Cannot get the module name without a module!"}} + current_module)} + state)) -(def-2 .private (plist#with k v plist) - (All (_ a) - (-> Text a ($' PList a) ($' PList a))) - ({{#Item [k' v'] plist'} - (if (text#= k k') - (partial_list [k v] plist') - (partial_list [k' v'] (plist#with k v plist'))) - - {#End} - (list [k v])} - plist)) - -(def-2 .private (global_symbol full_name state) - (-> Symbol ($' Meta Symbol)) - (let' [[module name] full_name - [..#info info ..#source source ..#current_module _ ..#modules modules - ..#scopes scopes ..#type_context types ..#host host - ..#seed seed ..#expected expected ..#location location ..#extensions extensions - ..#scope_type_vars scope_type_vars ..#eval _eval] state] - ({{#Some [..#module_hash _ ..#module_aliases _ ..#definitions definitions ..#imports _ ..#module_state _]} - ({{#Some constant} - ({{#Definition _} {#Right [state full_name]} - {#Tag _} {#Right [state full_name]} - {#Slot _} {#Right [state full_name]} - {#Type _} {#Right [state full_name]} - - {#Alias real_name} - {#Right [state real_name]}} - constant) - - {#None} - {#Left (all text#composite "Unknown definition: " (symbol#encoded full_name))}} - (plist#value name definitions)) - - {#None} - {#Left (all text#composite "Unknown module: " module " @ " (symbol#encoded full_name))}} - (plist#value module modules)))) - -(def-2 .private (|List<Code>| expression) - (-> Code Code) - (let' [type (variant$ (list (symbol$ [..prelude "#Apply"]) - (symbol$ [..prelude "Code"]) - (symbol$ [..prelude "List"])))] - (form$ (list (text$ "lux type check") type expression)))) - -(def-2 .private (untemplated_text value) - (-> Text Code) - (with_location (variant$ (list (symbol$ [..prelude "#Text"]) (text$ value))))) - -(def-3 .public UnQuote - Type - {#Primitive "#Macro/UnQuote" {#End}}) - -(def-3 .public (unquote it) - (-> Macro UnQuote) - ("lux type as" UnQuote it)) - -(def-3 .public (unquote_macro it) - (-> UnQuote Macro') - ("lux type as" Macro' it)) - -(def-3 .public Spliced_UnQuote - Type - {#Primitive "#Macro/Spliced_UnQuote" {#End}}) - -(def-3 .public (spliced_unquote it) - (-> Macro Spliced_UnQuote) - ("lux type as" Spliced_UnQuote it)) - -(def-3 .public (spliced_unquote_macro it) - (-> Spliced_UnQuote Macro') - ("lux type as" Macro' it)) - -(def-3 .private (list#one f xs) - (All (_ a b) - (-> (-> a ($' Maybe b)) ($' List a) ($' Maybe b))) - ({{#End} - {#None} - - {#Item x xs'} - ({{#None} - (list#one f xs') - - {#Some y} - {#Some y}} - (f x))} - xs)) - -(def-3 .private (in_env name state) - (-> Text Lux ($' Maybe Type)) - (let' [[..#info info ..#source source ..#current_module _ ..#modules modules - ..#scopes scopes ..#type_context types ..#host host - ..#seed seed ..#expected expected ..#location location ..#extensions extensions - ..#scope_type_vars scope_type_vars ..#eval _eval] state] - (list#one ("lux type check" - (-> Scope ($' Maybe Type)) - (function' [env] - (let' [[..#name _ - ..#inner _ - ..#locals [..#counter _ ..#mappings locals] - ..#captured _] env] - (list#one ("lux type check" - (-> (Tuple Text (Tuple Type Any)) ($' Maybe Type)) - (function' [it] - (let' [[bname [type _]] it] - (if (text#= name bname) - {#Some type} - {#None})))) - locals)))) - scopes))) - -(def-3 .private (definition_value name state) - (-> Symbol ($' Meta (Tuple Type Any))) - (let' [[v_module v_name] name - [..#info info ..#source source ..#current_module _ ..#modules modules - ..#scopes scopes ..#type_context types ..#host host - ..#seed seed ..#expected expected ..#location location ..#extensions extensions - ..#scope_type_vars scope_type_vars ..#eval _eval] state] - ({{#None} - {#Left (text#composite "Unknown definition: " (symbol#encoded name))} - - {#Some [..#definitions definitions - ..#module_hash _ - ..#module_aliases _ - ..#imports _ - ..#module_state _]} - ({{#None} - {#Left (text#composite "Unknown definition: " (symbol#encoded name))} - - {#Some definition} - ({{#Alias real_name} - (definition_value real_name state) - - {#Definition [exported? def_type def_value]} - {#Right [state [def_type def_value]]} - - {#Type [exported? type labels]} - {#Right [state [..Type type]]} - - {#Tag _} - {#Left (text#composite "Unknown definition: " (symbol#encoded name))} - - {#Slot _} - {#Left (text#composite "Unknown definition: " (symbol#encoded name))}} - definition)} - (plist#value v_name definitions))} - (plist#value v_module modules)))) - -(def-3 .private (global_value global lux) - (-> Symbol ($' Meta ($' Maybe (Tuple Type Any)))) - (let' [[module short] global] - ({{#Right [lux' type,value]} - {#Right [lux' {#Some type,value}]} - - {#Left error} - {#Right [lux {#None}]}} - ({"" ({{#None} - (definition_value global lux) - - {#Some _} - {#Left (text#composite "Not a global value: " (symbol#encoded global))}} - (in_env short lux)) +(def' .private (normal name) + (-> Symbol ($' Meta Symbol)) + ({["" name] + (do meta#monad + [module_name ..current_module_name] + (in [module_name name])) - _ - (definition_value global lux)} - module)))) - -(def-3 .private (bit#and left right) - (-> Bit Bit Bit) - (if left - right - #0)) - -(def-3 .private (symbol#= left right) - (-> Symbol Symbol Bit) - (let' [[moduleL shortL] left - [moduleR shortR] right] - (all bit#and - (text#= moduleL moduleR) - (text#= shortL shortR)))) - -(def-3 .private (every? ?) - (All (_ a) - (-> (-> a Bit) ($' List a) Bit)) - (list#mix (function' [_2 _1] (if _1 (? _2) #0)) #1)) + _ + (meta#in name)} + name)) -(def-3 .private (zipped_2 xs ys) - (All (_ a b) - (-> ($' List a) ($' List b) ($' List (Tuple a b)))) - ({{#Item x xs'} - ({{#Item y ys'} - (partial_list [x y] (zipped_2 xs' ys')) +(def' .private (untemplated_composite tag @composite untemplated replace? subst elements) + (-> Text Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) + ($' Meta Code)) + (do meta#monad + [.let' [cons ("lux type check" + (-> Code Code ($' Meta Code)) + (function' [head tail] + (do meta#monad + [head (untemplated replace? subst head)] + (in (|#Item| head tail)))))] + output (if replace? + (monad#mix meta#monad + (function' [head tail] + ({[@composite {#Form {#Item [@symbol {#Symbol global}] parameters}}] + (do meta#monad + [|global| (..normal global) + ?type,value (global_value |global|)] + ({{#Some [type value]} + (if (type#= Spliced_UnQuote type) + (do meta#monad + [.let' [it (spliced_unquote_macro ("lux type as" Spliced_UnQuote value))] + output (one_expansion (it {#Item tail parameters})) + .let' [[_ output] output]] + (in [@composite output])) + (cons head tail)) + + {#None} + (cons head tail)} + ?type,value)) - _ - (list)} - ys) - - _ - (list)} - xs)) - -(def-3 .private (type#= left right) - (-> Type Type Bit) - ({[{#Primitive nameL parametersL} {#Primitive nameR parametersR}] - (all bit#and - (text#= nameL nameR) - ("lux i64 =" (list#size parametersL) (list#size parametersR)) - (every? (function' [l,r] (let' [[itL itR] l,r] (type#= itL itR))) - (zipped_2 parametersL parametersR))) - - [{#Sum leftL rightL} {#Sum leftR rightR}] - (all bit#and - (type#= leftL leftR) - (type#= rightL rightR)) - - [{#Product leftL rightL} {#Product leftR rightR}] - (all bit#and - (type#= leftL leftR) - (type#= rightL rightR)) - - [{#Function leftL rightL} {#Function leftR rightR}] - (all bit#and - (type#= leftL leftR) - (type#= rightL rightR)) - - [{#Apply leftL rightL} {#Apply leftR rightR}] - (all bit#and - (type#= leftL leftR) - (type#= rightL rightR)) - - [{#Parameter idL} {#Parameter idR}] - ("lux i64 =" idL idR) - - [{#Var idL} {#Var idR}] - ("lux i64 =" idL idR) - - [{#Ex idL} {#Ex idR}] - ("lux i64 =" idL idR) - - [{#UnivQ envL bodyL} {#UnivQ envR bodyR}] - (all bit#and - ("lux i64 =" (list#size envL) (list#size envR)) - (every? (function' [l,r] (let' [[itL itR] l,r] (type#= itL itR))) - (zipped_2 envL envR)) - (type#= bodyL bodyR)) - - [{#ExQ envL bodyL} {#ExQ envR bodyR}] - (all bit#and - ("lux i64 =" (list#size envL) (list#size envR)) - (every? (function' [l,r] (let' [[itL itR] l,r] (type#= itL itR))) - (zipped_2 envL envR)) - (type#= bodyL bodyR)) - - [{#Named nameL anonL} {#Named nameR anonR}] - (all bit#and - (symbol#= nameL nameR) - (type#= anonL anonR)) + _ + (cons head tail)} + head)) + |#End| + (list#reversed elements)) + (do meta#monad + [=elements (monad#each meta#monad (untemplated replace? subst) elements)] + (in (untemplated_list =elements)))) + .let' [[_ output'] (with_location @composite (variant$ (list (symbol$ [..prelude tag]) output)))]] + (in [@composite output']))) + +(def' .private untemplated_form + (-> Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) + ($' Meta Code)) + (untemplated_composite "#Form")) + +(def' .private untemplated_variant + (-> Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) + ($' Meta Code)) + (untemplated_composite "#Variant")) + +(def' .private untemplated_tuple + (-> Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) + ($' Meta Code)) + (untemplated_composite "#Tuple")) + +(def' .private (untemplated replace? subst token) + (-> Bit Text Code ($' Meta Code)) + ({[_ [@token {#Bit value}]] + (meta#in (with_location @token (variant$ (list (symbol$ [..prelude "#Bit"]) (bit$ value))))) + + [_ [@token {#Nat value}]] + (meta#in (with_location @token (variant$ (list (symbol$ [..prelude "#Nat"]) (nat$ value))))) + + [_ [@token {#Int value}]] + (meta#in (with_location @token (variant$ (list (symbol$ [..prelude "#Int"]) (int$ value))))) + + [_ [@token {#Rev value}]] + (meta#in (with_location @token (variant$ (list (symbol$ [..prelude "#Rev"]) (rev$ value))))) + + [_ [@token {#Frac value}]] + (meta#in (with_location @token (variant$ (list (symbol$ [..prelude "#Frac"]) (frac$ value))))) - _ - #0} - [left right])) + [_ [@token {#Text value}]] + (meta#in (untemplated_text @token value)) -(def-2 .private (one_expansion it) - (-> ($' Meta ($' List Code)) ($' Meta Code)) - (do meta#monad - [it it] - ({{#Item it {#End}} - (in it) + [#1 [@token {#Symbol [module name]}]] + (do meta#monad + [real_name ({"" + (if (text#= "" subst) + (in [module name]) + (global_symbol [subst name])) - _ - (failure "Must expand to 1 element.")} - it))) - -(def-3 .private (current_module_name state) - ($' Meta Text) - ({[..#info info ..#source source ..#current_module current_module ..#modules modules - ..#scopes scopes ..#type_context types ..#host host - ..#seed seed ..#expected expected ..#location location ..#extensions extensions - ..#scope_type_vars scope_type_vars ..#eval _eval] - ({{#Some module_name} - {#Right [state module_name]} + _ + (in [module name])} + module) + .let' [[module name] real_name]] + (meta#in (with_location @token (variant$ (list (symbol$ [..prelude "#Symbol"]) (tuple$ (list (text$ module) (text$ name)))))))) - _ - {#Left "Cannot get the module name without a module!"}} - current_module)} - state)) + [#0 [@token {#Symbol [module name]}]] + (meta#in (with_location @token (variant$ (list (symbol$ [..prelude "#Symbol"]) (tuple$ (list (text$ module) (text$ name))))))) -(def-2 .private (normal name) - (-> Symbol ($' Meta Symbol)) - ({["" name] - (do meta#monad - [module_name ..current_module_name] - (in [module_name name])) + [#1 [@composite {#Form {#Item [@symbol {#Symbol global}] parameters}}]] + (do meta#monad + [|global| (..normal global) + ?type,value (global_value |global|)] + ({{#Some [type value]} + (if (type#= UnQuote type) + (do meta#monad + [.let' [it (unquote_macro ("lux type as" UnQuote value))] + output (one_expansion (it parameters)) + .let' [[_ output] output]] + (in [@composite output])) + (untemplated_form @composite untemplated replace? subst {#Item [@symbol {#Symbol global}] parameters})) + + {#None} + (untemplated_form @composite untemplated replace? subst {#Item [@symbol {#Symbol global}] parameters})} + ?type,value)) - _ - (meta#in name)} - name)) + [_ [@composite {#Form elements}]] + (untemplated_form @composite untemplated replace? subst elements) -(def-2 .private (untemplated_composite tag @form untemplated replace? subst elements) - (-> Text Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) - ($' Meta Code)) - (do meta#monad - [.let' [cons ("lux type check" - (-> Code Code ($' Meta Code)) - (function' [head tail] - (do meta#monad - [head (untemplated replace? subst head)] - (in (|#Item| head tail)))))] - output (if replace? - (monad#mix meta#monad - (function' [head tail] - ({[@composite {#Form {#Item [@symbol {#Symbol global}] parameters}}] - (do meta#monad - [|global| (..normal global) - ?type,value (global_value |global|)] - ({{#Some [type value]} - (if (type#= Spliced_UnQuote type) - (do meta#monad - [.let' [it (spliced_unquote_macro ("lux type as" Spliced_UnQuote value))] - output (one_expansion (it {#Item tail parameters})) - .let' [[_ output] output]] - (in [@composite output])) - (cons head tail)) - - {#None} - (cons head tail)} - ?type,value)) - - _ - (cons head tail)} - head)) - |#End| - (list#reversed elements)) - (do meta#monad - [=elements (monad#each meta#monad (untemplated replace? subst) elements)] - (in (untemplated_list =elements)))) - .let' [[_ output'] (with_location (variant$ (list (symbol$ [..prelude tag]) output)))]] - (in [@form output']))) - -(def-2 .private untemplated_form - (-> Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) - ($' Meta Code)) - (untemplated_composite "#Form")) - -(def-2 .private untemplated_variant - (-> Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) - ($' Meta Code)) - (untemplated_composite "#Variant")) - -(def-2 .private untemplated_tuple - (-> Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) - ($' Meta Code)) - (untemplated_composite "#Tuple")) - -(def-2 .private (untemplated replace? subst token) - (-> Bit Text Code ($' Meta Code)) - ({[_ [_ {#Bit value}]] - (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Bit"]) (bit$ value))))) - - [_ [_ {#Nat value}]] - (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Nat"]) (nat$ value))))) - - [_ [_ {#Int value}]] - (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Int"]) (int$ value))))) - - [_ [_ {#Rev value}]] - (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Rev"]) (rev$ value))))) - - [_ [_ {#Frac value}]] - (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Frac"]) (frac$ value))))) - - [_ [_ {#Text value}]] - (meta#in (untemplated_text value)) - - [#1 [_ {#Symbol [module name]}]] - (do meta#monad - [real_name ({"" - (if (text#= "" subst) - (in [module name]) - (global_symbol [subst name])) - - _ - (in [module name])} - module) - .let' [[module name] real_name]] - (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Symbol"]) (tuple$ (list (text$ module) (text$ name)))))))) - - [#0 [_ {#Symbol [module name]}]] - (meta#in (with_location (variant$ (list (symbol$ [..prelude "#Symbol"]) (tuple$ (list (text$ module) (text$ name))))))) - - [#1 [@composite {#Form {#Item [@symbol {#Symbol global}] parameters}}]] - (do meta#monad - [|global| (..normal global) - ?type,value (global_value |global|)] - ({{#Some [type value]} - (if (type#= UnQuote type) - (do meta#monad - [.let' [it (unquote_macro ("lux type as" UnQuote value))] - output (one_expansion (it parameters)) - .let' [[_ output] output]] - (in [@composite output])) - (untemplated_form @composite untemplated replace? subst {#Item [@symbol {#Symbol global}] parameters})) - - {#None} - (untemplated_form @composite untemplated replace? subst {#Item [@symbol {#Symbol global}] parameters})} - ?type,value)) - - [_ [@composite {#Form elements}]] - (untemplated_form @composite untemplated replace? subst elements) - - [_ [@composite {#Variant elements}]] - (untemplated_variant @composite untemplated replace? subst elements) - - [_ [@composite {#Tuple elements}]] - (untemplated_tuple @composite untemplated replace? subst elements)} - [replace? token])) - -(def-3 .public Primitive - Macro - (macro (_ tokens) - ({{#Item [_ {#Text class_name}] {#End}} - (meta#in (list (variant$ (list (symbol$ [..prelude "#Primitive"]) (text$ class_name) |#End|)))) + [_ [@composite {#Variant elements}]] + (untemplated_variant @composite untemplated replace? subst elements) - {#Item [_ {#Text class_name}] {#Item [_ {#Tuple params}] {#End}}} - (meta#in (list (variant$ (list (symbol$ [..prelude "#Primitive"]) (text$ class_name) (untemplated_list params))))) + [_ [@composite {#Tuple elements}]] + (untemplated_tuple @composite untemplated replace? subst elements)} + [replace? token])) - _ - (failure "Wrong syntax for Primitive")} - tokens))) +(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))))) -(def-3 .public ` - Macro + _ + (failure (wrong_syntax_error [..prelude "Primitive"]))} + tokens))) + +(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))))) + + _ + (failure (wrong_syntax_error [..prelude "`"]))} + 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))))) + + _ + (failure (wrong_syntax_error [..prelude "`'"]))} + tokens))) + +(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))))) + + _ + (failure (wrong_syntax_error [..prelude "'"]))} + tokens))) + +(def' .public ~ + UnQuote + (..unquote (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))))) + ({{#Item it {#End}} + (meta#in (list (form$ (list (text$ "lux type check") + (symbol$ [..prelude "Code"]) + it)))) _ - (failure "Wrong syntax for `")} - tokens))) + (failure (wrong_syntax_error [..prelude "~"]))} + tokens)))) -(def-3 .public `' - Macro +(def' .public ~! + UnQuote + (..unquote (macro (_ tokens) - ({{#Item template {#End}} + ({{#Item [@token dependent] {#End}} (do meta#monad - [=template (untemplated #1 "" template)] - (in (list (form$ (list (text$ "lux type check") (symbol$ [..prelude "Code"]) =template))))) + [current_module ..current_module_name + independent (untemplated #1 current_module [@token dependent])] + (in (list (with_location @token (variant$ (list (symbol$ [..prelude "#Form"]) + (untemplated_list (list (untemplated_text dummy_location "lux in-module") + (untemplated_text dummy_location current_module) + independent)))))))) _ - (failure "Wrong syntax for `'")} - tokens))) + (failure (wrong_syntax_error [..prelude "~!"]))} + tokens)))) -(def-3 .public ' - Macro +(def' .public ~' + UnQuote + (..unquote (macro (_ tokens) - ({{#Item template {#End}} + ({{#Item it {#End}} (do meta#monad - [=template (untemplated #0 "" template)] - (in (list (form$ (list (text$ "lux type check") (symbol$ [..prelude "Code"]) =template))))) + [current_module ..current_module_name + it (untemplated #0 current_module it)] + (in (list it))) _ - (failure "Wrong syntax for '")} - tokens))) - -(def-3 .public ~ - UnQuote - (..unquote - (macro (_ tokens) - ({{#Item it {#End}} - (meta#in (list (form$ (list (text$ "lux type check") - (symbol$ [..prelude "Code"]) - it)))) + (failure (wrong_syntax_error [..prelude "~'"]))} + tokens)))) + +(def' .public ~+ + Spliced_UnQuote + (let' [g!list#composite (form$ (list (text$ "lux in-module") + (text$ ..prelude) + (symbol$ [..prelude "list#composite"])))] + (..spliced_unquote + (macro (_ tokens) + ({{#Item tail {#Item it {#End}}} + (meta#in (list (form$ (list g!list#composite (|List<Code>| it) tail)))) + + _ + (failure (wrong_syntax_error [..prelude "~+"]))} + tokens))))) + +(def' .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))) + + [_ {#Tuple parts}] + (tuple$ (list#composite parts (list acc))) + + [_ {#Form parts}] + (form$ (list#composite parts (list acc))) + + _ + (` ((~ app) (~ acc)))} + app))) + init + apps))) - _ - (failure (wrong_syntax_error [..prelude "~"]))} - tokens)))) - -(def-3 .public ~! - UnQuote - (..unquote - (macro (_ tokens) - ({{#Item dependent {#End}} - (do meta#monad - [current_module ..current_module_name - independent (untemplated #1 current_module dependent)] - (in (list (with_location (variant$ (list (symbol$ [..prelude "#Form"]) - (untemplated_list (list (untemplated_text "lux in-module") - (untemplated_text current_module) - independent)))))))) - - _ - (failure (wrong_syntax_error [..prelude "~!"]))} - tokens)))) - -(def-3 .public ~' - UnQuote - (..unquote - (macro (_ tokens) - ({{#Item it {#End}} - (do meta#monad - [current_module ..current_module_name - it (untemplated #0 current_module it)] - (in (list it))) - - _ - (failure (wrong_syntax_error [..prelude "~'"]))} - tokens)))) - -(def-3 .public ~+ - Spliced_UnQuote - (let' [g!list#composite (form$ (list (text$ "lux in-module") - (text$ ..prelude) - (symbol$ [..prelude "list#composite"])))] - (..spliced_unquote - (macro (_ tokens) - ({{#Item tail {#Item it {#End}}} - (meta#in (list (form$ (list g!list#composite (|List<Code>| it) tail)))) - - _ - (failure (wrong_syntax_error [..prelude "~+"]))} - tokens))))) - -(def-3 .public |> - Macro - (macro (_ tokens) - ({{#Item [init apps]} - (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_error [..prelude "|>"]))} + 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))) + + [_ {#Tuple parts}] + (tuple$ (list#composite parts (list acc))) + + [_ {#Form parts}] + (form$ (list#composite parts (list acc))) + + _ + (` ((~ app) (~ acc)))} + app))) + init + apps))) - [_ {#Tuple parts}] - (tuple$ (list#composite parts (list acc))) + _ + (failure (wrong_syntax_error [..prelude "<|"]))} + (list#reversed tokens)))) - [_ {#Form parts}] - (form$ (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)))) - _ - (` ((~ app) (~ acc)))} - app))) - init - apps))) +(def' .private (symbol_name x) + (-> Code ($' Maybe Symbol)) + ({[_ {#Symbol sname}] + {#Some sname} - _ - (failure "Wrong syntax for |>")} - tokens))) + _ + {#None}} + x)) -(def-3 .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 (symbol_short x) + (-> Code ($' Maybe Text)) + ({[_ {#Symbol "" sname}] + {#Some sname} - [_ {#Tuple parts}] - (tuple$ (list#composite parts (list acc))) + _ + {#None}} + x)) - [_ {#Form parts}] - (form$ (list#composite parts (list acc))) +(def' .private (tuple_list tuple) + (-> Code ($' Maybe ($' List Code))) + ({[_ {#Tuple members}] + {#Some members} - _ - (` ((~ app) (~ acc)))} - app))) - init - apps))) + _ + {#None}} + tuple)) - _ - (failure "Wrong syntax for <|")} - (list#reversed tokens)))) +(def' .private (realized_template env template) + (-> Replacement_Environment Code Code) + ({[_ {#Symbol "" sname}] + ({{#Some subst} + subst -(def-2 .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-2 .private (symbol_name x) - (-> Code ($' Maybe Symbol)) - ({[_ {#Symbol sname}] - {#Some sname} + [meta {#Form elems}] + [meta {#Form (list#each (realized_template env) elems)}] - _ - {#None}} - x)) + [meta {#Tuple elems}] + [meta {#Tuple (list#each (realized_template env) elems)}] -(def-2 .private (symbol_short x) - (-> Code ($' Maybe Text)) - ({[_ {#Symbol "" sname}] - {#Some sname} + [meta {#Variant elems}] + [meta {#Variant (list#each (realized_template env) elems)}] - _ - {#None}} - x)) + _ + template} + template)) + +(def' .private (high_bits value) + (-> ($' I64 Any) I64) + ("lux i64 right-shift" 32 value)) + +(def' .private low_mask + I64 + (|> 1 ("lux i64 left-shift" 32) ("lux i64 -" 1))) + +(def' .private (low_bits value) + (-> ($' I64 Any) I64) + ("lux i64 and" low_mask value)) + +(def' .private (n/< reference sample) + (-> Nat Nat Bit) + (let' [referenceH (high_bits reference) + sampleH (high_bits sample)] + (if ("lux i64 <" referenceH sampleH) + #1 + (if ("lux i64 =" referenceH sampleH) + ("lux i64 <" + (low_bits reference) + (low_bits sample)) + #0)))) + +(def' .private (list#conjoint xs) + (All (_ a) + (-> ($' List ($' List a)) ($' List a))) + (list#mix list#composite {#End} (list#reversed xs))) + +(def' .public with_template + 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"])))) -(def-2 .private (tuple_list tuple) - (-> Code ($' Maybe ($' List Code))) - ({[_ {#Tuple members}] - {#Some members} + _ + (failure (..wrong_syntax_error [..prelude "with_template"]))} + [(monad#each maybe#monad symbol_short bindings) + (monad#each maybe#monad tuple_list data)]) - _ - {#None}} - tuple)) + _ + (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)) -(def-2 .private (realized_template env template) - (-> Replacement_Environment Code Code) - ({[_ {#Symbol "" sname}] - ({{#Some subst} - subst +(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 - _ - template} - (..replacement sname env)) + _ + #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) - [meta {#Form elems}] - [meta {#Form (list#each (realized_template env) elems)}] + {#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}) - [meta {#Tuple elems}] - [meta {#Tuple (list#each (realized_template env) elems)}] + {#Type [exported? type labels]} + {#None} - [meta {#Variant elems}] - [meta {#Variant (list#each (realized_template env) elems)}] + {#Tag _} + {#None} - _ - template} - template)) - -(def-2 .private (high_bits value) - (-> ($' I64 Any) I64) - ("lux i64 right-shift" 32 value)) - -(def-2 .private low_mask - I64 - (|> 1 ("lux i64 left-shift" 32) ("lux i64 -" 1))) - -(def-2 .private (low_bits value) - (-> ($' I64 Any) I64) - ("lux i64 and" low_mask value)) - -(def-2 .private (n/< reference sample) - (-> Nat Nat Bit) - (let' [referenceH (high_bits reference) - sampleH (high_bits sample)] - (if ("lux i64 <" referenceH sampleH) - #1 - (if ("lux i64 =" referenceH sampleH) - ("lux i64 <" - (low_bits reference) - (low_bits sample)) - #0)))) - -(def-2 .private (list#conjoint xs) - (All (_ a) - (-> ($' List ($' List a)) ($' List a))) - (list#mix list#composite {#End} (list#reversed xs))) + {#Slot _} + {#None}} + ("lux type check" Global gdef)))) -(def-3 .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"])))) - - _ - (failure (..wrong_syntax_error [..prelude "with_template"]))} - [(monad#each maybe#monad symbol_short bindings) - (monad#each maybe#monad tuple_list data)]) +(def' .private (named_macro full_name) + (-> Symbol ($' Meta ($' Maybe Macro))) + (do meta#monad + [current_module current_module_name] + (let' [[module name] full_name] + (function' [state] + ({[..#info info ..#source source ..#current_module _ ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed seed ..#expected expected + ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] + {#Right state (named_macro' modules current_module module name)}} + state))))) + +(def' .private (macro? name) + (-> Symbol ($' Meta Bit)) + (do meta#monad + [name (normal name) + output (named_macro name)] + (in ({{#Some _} #1 + {#None} #0} + output)))) + +(def' .private (list#interposed sep xs) + (All (_ a) + (-> a ($' List a) ($' List a))) + ({{#End} + xs + + {#Item [x {#End}]} + xs + + {#Item [x xs']} + (partial_list x sep (list#interposed sep xs'))} + xs)) + +(def' .private (single_expansion token) + (-> Code ($' Meta ($' List Code))) + ({[_ {#Form {#Item [_ {#Symbol name}] args}}] + (do meta#monad + [name' (normal name) + ?macro (named_macro name')] + ({{#Some macro} + (("lux type as" Macro' macro) args) + + {#None} + (in (list token))} + ?macro)) - _ - (failure (..wrong_syntax_error [..prelude "with_template"]))} - tokens))) - -(def-2 .private (n// param subject) - (-> Nat Nat Nat) - (if ("lux i64 <" +0 ("lux type as" Int param)) - (if (n/< param subject) - 0 - 1) - (let' [quotient (|> subject - ("lux i64 right-shift" 1) - ("lux i64 /" ("lux type as" Int param)) - ("lux i64 left-shift" 1)) - flat ("lux i64 *" - ("lux type as" Int param) - ("lux type as" Int quotient)) - remainder ("lux i64 -" flat subject)] - (if (n/< param remainder) - quotient - ("lux i64 +" 1 quotient))))) - -(def-2 .private (n/% param subject) - (-> Nat Nat Nat) - (let' [flat ("lux i64 *" - ("lux type as" Int param) - ("lux type as" Int (n// param subject)))] - ("lux i64 -" flat subject))) - -(def-2 .private (n/min left right) - (-> Nat Nat Nat) - (if (n/< right left) - left - right)) - -(def-2 .private (bit#encoded x) - (-> Bit Text) - (if x "#1" "#0")) - -(def-2 .private (digit::format digit) - (-> Nat Text) - ({[0] "0" - [1] "1" [2] "2" [3] "3" - [4] "4" [5] "5" [6] "6" - [7] "7" [8] "8" [9] "9" - _ ("lux io error" "@digit::format Undefined behavior.")} - digit)) - -(def-2 .private (nat#encoded value) - (-> Nat Text) - ({[0] "0" - _ (let' [loop ("lux type check" (-> Nat Text Text) - (function' again [input output] - (if ("lux i64 =" 0 input) - output - (again (n// 10 input) - (text#composite (|> input (n/% 10) digit::format) - output)))))] - (loop value ""))} - value)) + _ + (meta#in (list token))} + token)) -(def-2 .private (int#abs value) - (-> Int Int) - (if ("lux i64 <" +0 value) - ("lux i64 *" -1 value) - value)) - -(def-2 .private (int#encoded value) - (-> Int Text) - (if ("lux i64 =" +0 value) - "+0" - (let' [sign (if ("lux i64 <" value +0) - "+" - "-")] - (("lux type check" (-> Int Text Text) - (function' again [input output] - (if ("lux i64 =" +0 input) - (text#composite sign output) - (again ("lux i64 /" +10 input) - (text#composite (|> input ("lux i64 %" +10) ("lux type as" Nat) digit::format) - output))))) - (|> value ("lux i64 /" +10) int#abs) - (|> value ("lux i64 %" +10) int#abs ("lux type as" Nat) digit::format))))) - -(def-2 .private (frac#encoded x) - (-> Frac Text) - ("lux f64 encode" x)) - -(def-2 .public (not x) - (-> Bit Bit) - (if x #0 #1)) - -(def-2 .private (macro_type? type) - (-> Type Bit) - ({{#Named ["library/lux" "Macro"] {#Primitive "#Macro" {#End}}} - #1 +(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)) - _ - #0} - type)) - -(def-2 .private (named_macro' modules current_module module name) - (-> ($' List (Tuple Text Module)) - Text Text Text - ($' Maybe Macro)) - (do maybe#monad - [$module (plist#value module modules) - gdef (let' [[..#module_hash _ ..#module_aliases _ ..#definitions bindings ..#imports _ ..#module_state _] ("lux type check" Module $module)] - (plist#value name bindings))] - ({{#Alias [r_module r_name]} - (named_macro' modules current_module r_module r_name) - - {#Definition [exported? def_type def_value]} - (if (macro_type? def_type) - (if exported? - {#Some ("lux type as" Macro def_value)} - (if (text#= module current_module) - {#Some ("lux type as" Macro def_value)} - {#None})) - {#None}) - - {#Type [exported? type labels]} - {#None} + _ + (meta#in (list token))} + token)) - {#Tag _} - {#None} +(def' .private (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) - {#Slot _} - {#None}} - ("lux type check" Global gdef)))) + _ + (do meta#monad + [members' (monad#each meta#monad again {#Item head tail})] + (in (list (form$ (list#conjoint members')))))} + head) -(def-2 .private (named_macro full_name) - (-> Symbol ($' Meta ($' Maybe Macro))) - (do meta#monad - [current_module current_module_name] - (let' [[module name] full_name] - (function' [state] - ({[..#info info ..#source source ..#current_module _ ..#modules modules - ..#scopes scopes ..#type_context types ..#host host - ..#seed seed ..#expected expected - ..#location location ..#extensions extensions - ..#scope_type_vars scope_type_vars ..#eval _eval] - {#Right state (named_macro' modules current_module module name)}} - state))))) - -(def-2 .private (macro? name) - (-> Symbol ($' Meta Bit)) - (do meta#monad - [name (normal name) - output (named_macro name)] - (in ({{#Some _} #1 - {#None} #0} - output)))) + [_ {#Variant members}] + (do meta#monad + [members' (monad#each meta#monad again members)] + (in (list (variant$ (list#conjoint members'))))) -(def-2 .private (list#interposed sep xs) - (All (_ a) - (-> a ($' List a) ($' List a))) - ({{#End} - xs - - {#Item [x {#End}]} - xs - - {#Item [x xs']} - (partial_list x sep (list#interposed sep xs'))} - xs)) - -(def-2 .private (single_expansion token) - (-> Code ($' Meta ($' List Code))) - ({[_ {#Form {#Item [_ {#Symbol name}] args}}] - (do meta#monad - [name' (normal name) - ?macro (named_macro name')] - ({{#Some macro} - (("lux type as" Macro' macro) args) - - {#None} - (in (list token))} - ?macro)) + [_ {#Tuple members}] + (do meta#monad + [members' (monad#each meta#monad again members)] + (in (list (tuple$ (list#conjoint members'))))) - _ - (meta#in (list token))} - token)) - -(def-2 .private (expansion token) - (-> Code ($' Meta ($' List Code))) - ({[_ {#Form {#Item [_ {#Symbol name}] args}}] - (do meta#monad - [name' (normal name) - ?macro (named_macro name')] - ({{#Some macro} - (do meta#monad - [top_level_expansion (("lux type as" Macro' macro) args) - recursive_expansion (monad#each meta#monad expansion top_level_expansion)] - (in (list#conjoint recursive_expansion))) - - {#None} - (in (list token))} - ?macro)) + _ + (meta#in (list syntax))} + syntax))) - _ - (meta#in (list token))} - token)) +(def' .private (text#encoded original) + (-> Text Text) + (all text#composite ..double_quote original ..double_quote)) -(def-2 .private (full_expansion' full_expansion name args) - (-> (-> Code ($' Meta ($' List Code))) Symbol ($' List Code) ($' Meta ($' List Code))) - (do meta#monad - [name' (normal name) - ?macro (named_macro name')] - ({{#Some macro} - (do meta#monad - [expansion (("lux type as" Macro' macro) args) - expansion' (monad#each meta#monad full_expansion expansion)] - (in (list#conjoint expansion'))) - - {#None} - (do meta#monad - [args' (monad#each meta#monad full_expansion args)] - (in (list (form$ {#Item (symbol$ name) (list#conjoint args')}))))} - ?macro))) +(def' .private (code#encoded code) + (-> Code Text) + ({[_ {#Bit value}] + (bit#encoded value) -(def-2 .private (in_module module meta) - (All (_ a) - (-> Text ($' Meta a) ($' Meta a))) - (function' [lux] - ({[..#info info ..#source source - ..#current_module current_module ..#modules modules - ..#scopes scopes ..#type_context type_context - ..#host host ..#seed seed - ..#expected expected ..#location location - ..#extensions extensions ..#scope_type_vars scope_type_vars - ..#eval eval] - ({{#Left error} - {#Left error} - - {#Right [[..#info info' ..#source source' - ..#current_module _ ..#modules modules' - ..#scopes scopes' ..#type_context type_context' - ..#host host' ..#seed seed' - ..#expected expected' ..#location location' - ..#extensions extensions' ..#scope_type_vars scope_type_vars' - ..#eval eval'] - output]} - {#Right [[..#info info' ..#source source' - ..#current_module current_module ..#modules modules' - ..#scopes scopes' ..#type_context type_context' - ..#host host' ..#seed seed' - ..#expected expected' ..#location location' - ..#extensions extensions' ..#scope_type_vars scope_type_vars' - ..#eval eval'] - output]}} - (meta [..#info info ..#source source - ..#current_module {.#Some module} ..#modules modules - ..#scopes scopes ..#type_context type_context - ..#host host ..#seed seed - ..#expected expected ..#location location - ..#extensions extensions ..#scope_type_vars scope_type_vars - ..#eval eval]))} - lux))) - -(def-2 .private (full_expansion expand_in_module?) - (-> Bit Code ($' Meta ($' List Code))) - (function' again [syntax] - ({[_ {#Form {#Item head tail}}] - ({[_ {#Form {#Item [_ {#Text "lux in-module"}] - {#Item [_ {#Text module}] - {#Item [_ {#Symbol name}] - {#End}}}}}] - (if expand_in_module? - (..in_module module (..full_expansion' again name tail)) - (do meta#monad - [members' (monad#each meta#monad again {#Item head tail})] - (in (list (form$ (list#conjoint members')))))) - - [_ {#Symbol name}] - (..full_expansion' again name tail) - - _ - (do meta#monad - [members' (monad#each meta#monad again {#Item head tail})] - (in (list (form$ (list#conjoint members')))))} - head) - - [_ {#Variant members}] - (do meta#monad - [members' (monad#each meta#monad again members)] - (in (list (variant$ (list#conjoint members'))))) - - [_ {#Tuple members}] - (do meta#monad - [members' (monad#each meta#monad again members)] - (in (list (tuple$ (list#conjoint members'))))) + [_ {#Nat value}] + (nat#encoded value) - _ - (meta#in (list syntax))} - syntax))) + [_ {#Int value}] + (int#encoded value) -(def-2 .private (text#encoded original) - (-> Text Text) - (all text#composite ..double_quote original ..double_quote)) + [_ {#Rev value}] + ("lux io error" "@code#encoded Undefined behavior.") + + [_ {#Frac value}] + (frac#encoded value) -(def-2 .private (code#encoded code) - (-> Code Text) - ({[_ {#Bit value}] - (bit#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 ($' Meta Code)) + ({[_ {#Variant {#Item [_ {#Symbol symbol}] parts}}] + (do meta#monad + [parts (monad#each meta#monad normal_type parts)] + (in (` {(~ (symbol$ symbol)) (~+ parts)}))) - [_ {#Nat value}] - (nat#encoded value) + [_ {#Tuple members}] + (do meta#monad + [members (monad#each meta#monad normal_type members)] + (in (` (Tuple (~+ members))))) - [_ {#Int value}] - (int#encoded value) + [_ {#Form {#Item [_ {#Text "lux in-module"}] + {#Item [_ {#Text module}] + {#Item type' + {#End}}}}}] + (do meta#monad + [type' (normal_type type')] + (in (` ("lux in-module" (~ (text$ module)) (~ type'))))) - [_ {#Rev value}] - ("lux io error" "@code#encoded Undefined behavior.") - - [_ {#Frac value}] - (frac#encoded value) + [_ {#Form {#Item [_ {#Symbol ["" "~"]}] {#Item expression {#End}}}}] + (meta#in expression) - [_ {#Text value}] - (text#encoded value) - - [_ {#Symbol [module name]}] - (symbol#encoded [module name]) - - [_ {#Form xs}] - (all text#composite "(" (|> xs - (list#each code#encoded) - (list#interposed " ") - list#reversed - (list#mix text#composite "")) ")") - - [_ {#Tuple xs}] - (all text#composite "[" (|> xs - (list#each code#encoded) - (list#interposed " ") - list#reversed - (list#mix text#composite "")) "]") - - [_ {#Variant xs}] - (all text#composite "{" (|> xs - (list#each code#encoded) - (list#interposed " ") - list#reversed - (list#mix text#composite "")) "}")} - code)) - -(def-2 .private (normal_type type) - (-> Code Code) - ({[_ {#Variant {#Item [_ {#Symbol symbol}] parts}}] - (` {(~ (symbol$ symbol)) (~+ (list#each normal_type parts))}) - - [_ {#Tuple members}] - (` (Tuple (~+ (list#each normal_type members)))) - - [_ {#Form {#Item [_ {#Text "lux in-module"}] - {#Item [_ {#Text module}] - {#Item type' - {#End}}}}}] - (` ("lux in-module" (~ (text$ module)) (~ (normal_type type')))) - - [_ {#Form {#Item [_ {#Symbol ["" "~"]}] {#Item expression {#End}}}}] - expression - - [_0 {#Form {#Item [_1 {#Variant {#Item binding {#Item body {#End}}}}] - {#Item value - {#End}}}}] - [_0 {#Form {#Item [_1 {#Variant {#Item binding {#Item (normal_type body) {#End}}}}] - {#Item value - {#End}}}}] - - [_0 {#Form {#Item [_1 {#Symbol ["library/lux" "__adjusted_quantified_type__"]}] - {#Item _permission - {#Item _level - {#Item body - {#End}}}}}}] - [_0 {#Form {#Item [_1 {#Symbol [..prelude "__adjusted_quantified_type__"]}] - {#Item _permission - {#Item _level - {#Item (normal_type body) - {#End}}}}}}] - - [_ {#Form {#Item type_fn args}}] - (list#mix ("lux type check" (-> Code Code Code) - (function' [arg type_fn] (` {.#Apply (~ arg) (~ type_fn)}))) - (normal_type type_fn) - (list#each normal_type args)) + [_0 {#Form {#Item [_1 {#Variant {#Item binding {#Item body {#End}}}}] + {#Item value + {#End}}}}] + (do meta#monad + [body (normal_type body)] + (in [_0 {#Form {#Item [_1 {#Variant {#Item binding {#Item body {#End}}}}] + {#Item value + {#End}}}}])) + + [_0 {#Form {#Item [_1 {#Symbol ["library/lux" "__adjusted_quantified_type__"]}] + {#Item _permission + {#Item _level + {#Item body + {#End}}}}}}] + (do meta#monad + [body (normal_type body)] + (in [_0 {#Form {#Item [_1 {#Symbol [..prelude "__adjusted_quantified_type__"]}] + {#Item _permission + {#Item _level + {#Item body + {#End}}}}}}])) + + [_ {#Form {#Item type_fn args}}] + (do meta#monad + [type_fn (normal_type type_fn) + args (monad#each meta#monad normal_type args)] + (in (list#mix ("lux type check" (-> Code Code Code) + (function' [arg type_fn] (` {.#Apply (~ arg) (~ type_fn)}))) + type_fn + args))) - _ - type} - type)) + _ + (meta#in type)} + type)) -(def-3 .public type_literal - 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'))) +(def' .public type_literal + 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}} + (do meta#monad + [type'' (normal_type type')] + (in (list type''))) - _ - (failure "The expansion of the type-syntax had to yield a single element.")} - type+)) - (in (list (..quantified (` (..type_literal (~ type)))))))) + _ + (failure "The expansion of the type-syntax had to yield a single element.")} + type+)) + (in (list (..quantified (` (..type_literal (~ type)))))))) - _ - (failure "Wrong syntax for type")} - tokens))) + _ + (failure (wrong_syntax_error [..prelude "type"]))} + tokens))) -(def-3 .public is - Macro - (macro (_ tokens) - ({{#Item type {#Item value {#End}}} - (meta#in (list (` ("lux type check" - (..type_literal (~ type)) - (~ value))))) +(def' .public is + Macro + (macro (_ tokens) + ({{#Item type {#Item value {#End}}} + (meta#in (list (` ("lux type check" + (..type_literal (~ type)) + (~ value))))) - _ - (failure "Wrong syntax for :")} - tokens))) + _ + (failure (wrong_syntax_error [..prelude "is"]))} + tokens))) -(def-3 .public as - Macro - (macro (_ tokens) - ({{#Item type {#Item value {#End}}} - (meta#in (list (` ("lux type as" - (..type_literal (~ type)) - (~ value))))) +(def' .public as + Macro + (macro (_ tokens) + ({{#Item type {#Item value {#End}}} + (meta#in (list (` ("lux type as" + (..type_literal (~ type)) + (~ value))))) - _ - (failure "Wrong syntax for as")} - tokens))) + _ + (failure (wrong_syntax_error [..prelude "as"]))} + tokens))) -(def-2 .private (empty? xs) - (All (_ a) - (-> ($' List a) Bit)) - ({{#End} #1 - _ #0} - xs)) +(def' .private (empty? xs) + (All (_ a) + (-> ($' List a) Bit)) + ({{#End} #1 + _ #0} + xs)) (with_template [<name> <type> <value>] - [(def-2 .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-2 .private (generated_symbol prefix state) - (-> Text ($' Meta Code)) - ({[..#info info ..#source source ..#current_module _ ..#modules modules - ..#scopes scopes ..#type_context types ..#host host - ..#seed seed ..#expected expected - ..#location location ..#extensions extensions - ..#scope_type_vars scope_type_vars ..#eval _eval] - {#Right [..#info info ..#source source ..#current_module _ ..#modules modules - ..#scopes scopes ..#type_context types ..#host host - ..#seed ("lux i64 +" 1 seed) ..#expected expected - ..#location location ..#extensions extensions - ..#scope_type_vars scope_type_vars ..#eval _eval] - (local$ (all text#composite "__gensym__" prefix (nat#encoded seed)))}} - state)) - -(def-3 .public exec - Macro - (macro (_ tokens) - ({{#Item value actions} - (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-3 .private def-1 - 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)) + +(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)))) - _ - {#None}} - tokens))] - ({{#Some [export_policy name args ?type body]} - (let' [body' ({{#End} + _ + (failure "Wrong syntax for exec")} + (list#reversed tokens)))) + +(def' .private (case_expansion branches) + (type_literal (-> (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))))) - _ - (` (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-1")} - parts)))) - -(def-1 .private (case_expansion branches) - (-> (List Code) (Meta (List Code))) - ({{#Item [_ {#Form {#Item [_ {#Symbol name}] args}}] - {#Item body - branches'}} - (do meta#monad - [??? (macro? name)] - (if ??? - (do meta#monad - [init_expansion (single_expansion (form$ (partial_list (symbol$ name) (form$ args) body branches')))] - (case_expansion init_expansion)) - (do meta#monad - [sub_expansion (case_expansion branches')] - (in (partial_list (form$ (partial_list (symbol$ name) args)) - body - sub_expansion))))) - - {#Item pattern {#Item body branches'}} - (do meta#monad - [sub_expansion (case_expansion branches')] - (in (partial_list pattern body sub_expansion))) - - {#End} - (do meta#monad [] (in (list))) - - _ - (failure (all text#composite "'lux.case' expects an even number of tokens: " (|> branches - (list#each code#encoded) - (list#interposed " ") - list#reversed - (list#mix text#composite ""))))} - branches)) - -(def-3 .public case - Macro - (macro (_ tokens) - ({{#Item value branches} - (do meta#monad - [expansion (case_expansion branches)] - (in (list (` ((~ (variant$ expansion)) (~ value)))))) - - _ - (failure "Wrong syntax for case")} - tokens))) - -(def-3 .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")))) + {#Item pattern {#Item body branches'}} + (do meta#monad + [sub_expansion (case_expansion branches')] + (in (partial_list pattern body sub_expansion))) -(def-3 .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") - - _ - (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-3 .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-1 .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")))) + +(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") - _ - #0)) + _ + (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"]))))) -(def-3 .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) - - {#None} - (failure "let requires an even number of parts")) +(def' .private (symbol? code) + (type_literal (-> 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) + + {#None} + (failure "let requires an even number of parts")) -(def-3 .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)))))) + _ + (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)))))) - {#None} - (failure (..wrong_syntax_error (symbol ..function)))))) + {#None} + (failure (..wrong_syntax_error (symbol ..function)))))) -(def-1 .private Parser - Type - {#Named [..prelude "Parser"] - (..type_literal (All (_ a) - (-> (List Code) (Maybe [(List Code) a]))))}) +(def' .private Parser + Type + {#Named [..prelude "Parser"] + (..type_literal (All (_ a) + (-> (List Code) (Maybe [(List Code) a]))))}) -(def-1 .private (parsed parser tokens) - (All (_ a) (-> (Parser a) (List Code) (Maybe a))) - (case (parser tokens) - (pattern {#Some [(list) it]}) - {#Some it} +(def' .private (parsed parser tokens) + (type_literal (All (_ a) (-> (Parser a) (List Code) (Maybe a)))) + (case (parser tokens) + (pattern {#Some [(list) it]}) + {#Some it} - _ - {#None})) + _ + {#None})) -(def-1 .private (inP it tokens) +(def' .private (inP it tokens) + (type_literal (All (_ a) - (-> a (Parser a))) - {#Some [tokens it]}) + (-> a (Parser a)))) + {#Some [tokens it]}) -(def-1 .private (orP leftP rightP tokens) +(def' .private (orP leftP rightP tokens) + (type_literal (All (_ l r) (-> (Parser l) (Parser r) - (Parser (Or l r)))) - (case (leftP tokens) - {#Some [tokens left]} - {#Some [tokens {#Left left}]} + (Parser (Or l r))))) + (case (leftP tokens) + {#Some [tokens left]} + {#Some [tokens {#Left left}]} - _ - (case (rightP tokens) - {#Some [tokens right]} - {#Some [tokens {#Right right}]} + _ + (case (rightP tokens) + {#Some [tokens right]} + {#Some [tokens {#Right right}]} - _ - {#None}))) + _ + {#None}))) -(def-1 .private (eitherP leftP rightP tokens) +(def' .private (eitherP leftP rightP tokens) + (type_literal (All (_ a) (-> (Parser a) (Parser a) - (Parser a))) - (case (leftP tokens) - {#None} - (rightP tokens) + (Parser a)))) + (case (leftP tokens) + {#None} + (rightP tokens) - it - it)) + it + it)) -(def-1 .private (andP leftP rightP tokens) +(def' .private (andP leftP rightP tokens) + (type_literal (All (_ l r) (-> (Parser l) (Parser r) - (Parser [l r]))) - (do maybe#monad - [left (leftP tokens) - .let [[tokens left] left] - right (rightP tokens) - .let [[tokens right] right]] - (in [tokens [left right]]))) - -(def-1 .private (afterP leftP rightP tokens) + (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) + (type_literal (All (_ l r) (-> (Parser l) (Parser r) - (Parser r))) - (do maybe#monad - [left (leftP tokens) - .let [[tokens left] left]] - (rightP tokens))) - -(def-1 .private (someP itP tokens) + (Parser r)))) + (do maybe#monad + [left (leftP tokens) + .let [[tokens left] left]] + (rightP tokens))) + +(def' .private (someP itP tokens) + (type_literal (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)])) + (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 (list)]})) + {#None} + {#Some [tokens (list)]})) -(def-1 .private (manyP itP tokens) +(def' .private (manyP itP tokens) + (type_literal (All (_ a) (-> (Parser a) - (Parser (List a)))) - (do maybe#monad - [it (itP tokens) - .let [[tokens head] it] - it (someP itP tokens) - .let [[tokens tail] it]] - (in [tokens (partial_list head tail)]))) - -(def-1 .private (maybeP itP tokens) + (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) + (type_literal (All (_ a) (-> (Parser a) - (Parser (Maybe a)))) - (case (itP tokens) - {#Some [tokens it]} - {#Some [tokens {#Some it}]} + (Parser (Maybe a))))) + (case (itP tokens) + {#Some [tokens it]} + {#Some [tokens {#Some it}]} - {#None} - {#Some [tokens {#None}]})) + {#None} + {#Some [tokens {#None}]})) -(def-1 .private (tupleP itP tokens) +(def' .private (tupleP itP tokens) + (type_literal (All (_ a) - (-> (Parser a) (Parser a))) - (case tokens - (pattern (partial_list [_ {#Tuple input}] tokens')) - (do maybe#monad - [it (parsed itP input)] - (in [tokens' it])) + (-> (Parser a) (Parser a)))) + (case tokens + (pattern (partial_list [_ {#Tuple input}] tokens')) + (do maybe#monad + [it (parsed itP input)] + (in [tokens' it])) - _ - {#None})) + _ + {#None})) -(def-1 .private (formP itP tokens) +(def' .private (formP itP tokens) + (type_literal (All (_ a) - (-> (Parser a) (Parser a))) - (case tokens - (pattern (partial_list [_ {#Form input}] tokens')) - (do maybe#monad - [it (parsed itP input)] - (in [tokens' it])) + (-> (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-1 .private (bindingP tokens) - (Parser [Text Code]) - (case tokens - (pattern (partial_list [_ {#Symbol ["" name]}] value &rest)) - {#Some [&rest [name value]]} +(def' .private (bindingP tokens) + (type_literal (Parser [Text Code])) + (case tokens + (pattern (partial_list [_ {#Symbol ["" name]}] value &rest)) + {#Some [&rest [name value]]} - _ - {#None})) + _ + {#None})) -(def-1 .private (endP tokens) - (Parser Any) - (case tokens - (pattern (list)) - {#Some [tokens []]} +(def' .private (endP tokens) + (type_literal (Parser Any)) + (case tokens + (pattern (list)) + {#Some [tokens []]} - _ - {#None})) + _ + {#None})) -(def-1 .private (anyP tokens) - (Parser Code) - (case tokens - (pattern (partial_list code tokens')) - {#Some [tokens' code]} +(def' .private (anyP tokens) + (type_literal (Parser Code)) + (case tokens + (pattern (partial_list code tokens')) + {#Some [tokens' code]} - _ - {#None})) + _ + {#None})) -(def-1 .private (localP tokens) - (-> (List Code) (Maybe [(List Code) Text])) - (case tokens - (pattern (partial_list [_ {#Symbol ["" local]}] tokens')) - {#Some [tokens' local]} +(def' .private (localP tokens) + (type_literal (-> (List Code) (Maybe [(List Code) Text]))) + (case tokens + (pattern (partial_list [_ {#Symbol ["" local]}] tokens')) + {#Some [tokens' local]} - _ - {#None})) + _ + {#None})) -(def-1 .private (symbolP tokens) - (-> (List Code) (Maybe [(List Code) Symbol])) - (case tokens - (pattern (partial_list [_ {#Symbol it}] tokens')) - {#Some [tokens' it]} +(def' .private (symbolP tokens) + (type_literal (-> (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-1 .private (<parser> tokens) - (-> (List Code) (Maybe (List <item_type>))) - (case tokens - {#End} - {#Some {#End}} + [(def' .private (<parser> tokens) + (type_literal (-> (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-1 .private (<parser> tokens) - (Parser [Text (List <parameter_type>)]) - (case tokens - (pattern (partial_list [_ {#Form local_declaration}] tokens')) - (do maybe#monad - [% (localP local_declaration) - .let' [[local_declaration name] %] - parameters (<parameters_parser> local_declaration)] - (in [tokens' [name parameters]])) - - _ - (do maybe#monad - [% (localP tokens) - .let' [[tokens' name] %]] - (in [tokens' [name {#End}]]))))] + [(def' .private (<parser> tokens) + (type_literal (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-1 .private (export_policyP tokens) - (-> (List Code) [(List Code) Code]) - (case tokens - (pattern (partial_list candidate tokens')) - (case candidate - [_ {#Bit it}] - [tokens' candidate] - - [_ {#Symbol ["" _]}] - [tokens (` .private)] - - [_ {#Symbol it}] - [tokens' candidate] +(def' .private (export_policyP tokens) + (type_literal (-> (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-1 .private (<parser> tokens) - (-> (List Code) (Maybe [(List Code) [Code Text (List <parameter_type>)]])) - (do maybe#monad - [.let' [[tokens export_policy] (export_policyP tokens)] - % (<local> tokens) - .let' [[tokens [name parameters]] %]] - (in [tokens [export_policy name parameters]])))] + [(def' .private (<parser> tokens) + (type_literal (-> (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-1 .private (bodyP tokens) - (-> (List Code) (Maybe [(List Code) [(Maybe Code) Code]])) - (case tokens - ... TB - (pattern (partial_list type body tokens')) - {#Some [tokens' [{#Some type} body]]} +(def' .private (bodyP tokens) + (type_literal (-> (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-1 .private (definitionP tokens) - (-> (List Code) (Maybe [Code Text (List Code) (Maybe Code) Code])) - (do maybe#monad - [% (enhanced_declarationP tokens) - .let' [[tokens [export_policy name parameters]] %] - % (bodyP tokens) - .let' [[tokens [?type body]] %] - _ (endP tokens)] - (in [export_policy name parameters ?type body]))) - -(def-3 .public def - Macro - (macro (_ tokens) - (case (definitionP tokens) - {#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)))))) + _ + {#None})) + +(def' .private (definitionP tokens) + (type_literal (-> (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)))))) (with_template [<name> <form> <message>] [(def .public <name> @@ -4104,12 +4086,12 @@ (def (definition_type name state) (-> Symbol Lux (Maybe Type)) - (let [[v_module v_name] name + (let [[expected_module expected_short] 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] - (case (plist#value v_module modules) + (case (plist#value expected_module modules) {#None} {#None} @@ -4118,7 +4100,7 @@ ..#module_aliases _ ..#imports _ ..#module_state _]} - (case (plist#value v_name definitions) + (case (plist#value expected_short definitions) {#None} {#None} @@ -5330,13 +5312,12 @@ _ (failure (..wrong_syntax_error (symbol ..``)))))) -(def .public false - Bit - #0) +(with_template [<bit> <name>] + [(def .public <name> Bit <bit>)] -(def .public true - Bit - #1) + [#0 false] + [#1 true] + ) (def .public try (macro (_ tokens) diff --git a/stdlib/source/library/lux/type/unit.lux b/stdlib/source/library/lux/type/unit.lux index e7327e551..994e7ad11 100644 --- a/stdlib/source/library/lux/type/unit.lux +++ b/stdlib/source/library/lux/type/unit.lux @@ -15,25 +15,25 @@ ["[0]" // (.only) [primitive (.except)]]) -(primitive .public (Qty scale unit) +(primitive .public (Measure scale unit) Int - (def .public quantity - (All (_ scale unit) (-> Int (Qty scale unit))) + (def .public measure + (All (_ scale unit) (-> Int (Measure scale unit))) (|>> abstraction)) (def .public number - (All (_ scale unit) (-> (Qty scale unit) Int)) + (All (_ scale unit) (-> (Measure scale unit) Int)) (|>> representation)) (def .public equivalence - (All (_ scale unit) (Equivalence (Qty scale unit))) + (All (_ scale unit) (Equivalence (Measure scale unit))) (implementation (def (= reference sample) (i.= (representation reference) (representation sample))))) (def .public order - (All (_ scale unit) (Order (Qty scale unit))) + (All (_ scale unit) (Order (Measure scale unit))) (implementation (def equivalence ..equivalence) @@ -41,7 +41,7 @@ (i.< (representation reference) (representation sample))))) (def .public enum - (All (_ scale unit) (Enum (Qty scale unit))) + (All (_ scale unit) (Enum (Measure scale unit))) (implementation (def order ..order) (def succ (|>> representation ++ abstraction)) @@ -49,7 +49,7 @@ (with_template [<name> <op>] [(def .public (<name> param subject) - (All (_ scale unit) (-> (Qty scale unit) (Qty scale unit) (Qty scale unit))) + (All (_ scale unit) (-> (Measure scale unit) (Measure scale unit) (Measure scale unit))) (abstraction (<op> (representation param) (representation subject))))] @@ -59,7 +59,7 @@ (with_template [<name> <op> <p> <s> <p*s>] [(def .public (<name> param subject) - (All (_ scale p s) (-> (Qty scale <p>) (Qty scale <s>) (Qty scale <p*s>))) + (All (_ scale p s) (-> (Measure scale <p>) (Measure scale <s>) (Measure scale <p*s>))) (abstraction (<op> (representation param) (representation subject))))] @@ -69,15 +69,15 @@ (.type .public (Unit a) (Interface - (is (-> Int (Qty Any a)) + (is (-> Int (Measure Any a)) in) - (is (-> (Qty Any a) Int) + (is (-> (Measure Any a) Int) out))) (def .public (unit _) (Ex (_ a) (-> Any (Unit a))) (implementation - (def in ..quantity) + (def in ..measure) (def out ..number))) ) diff --git a/stdlib/source/library/lux/type/unit/scale.lux b/stdlib/source/library/lux/type/unit/scale.lux index e88ee83e8..b7f598d13 100644 --- a/stdlib/source/library/lux/type/unit/scale.lux +++ b/stdlib/source/library/lux/type/unit/scale.lux @@ -15,9 +15,9 @@ (.type .public (Scale s) (Interface - (is (All (_ u) (-> (//.Qty Any u) (//.Qty s u))) + (is (All (_ u) (-> (//.Measure Any u) (//.Measure s u))) up) - (is (All (_ u) (-> (//.Qty s u) (//.Qty Any u))) + (is (All (_ u) (-> (//.Measure s u) (//.Measure Any u))) down) (is Ratio ratio))) @@ -30,24 +30,24 @@ (|>> //.number (i.* (.int /#numerator)) (i./ (.int /#denominator)) - //.quantity)) + //.measure)) (def down (|>> //.number (i.* (.int /#denominator)) (i./ (.int /#numerator)) - //.quantity)) + //.measure)) (def ratio ratio)))) -(def .public (re_scaled from to quantity) - (All (_ si so u) (-> (Scale si) (Scale so) (//.Qty si u) (//.Qty so u))) +(def .public (re_scaled from to measure) + (All (_ si so u) (-> (Scale si) (Scale so) (//.Measure si u) (//.Measure so u))) (let [(open "/[0]") (ratio./ (at from ratio) (at to ratio))] - (|> quantity + (|> measure //.number (i.* (.int /#numerator)) (i./ (.int /#denominator)) - //.quantity))) + //.measure))) (def .public type (syntax (_ [it <code>.any]) |