From a4847190df926d35f7ece97da50a2a8b1462a24f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 28 Jul 2022 02:44:45 -0400 Subject: Now statically resolving values from globals in pattern-matching. --- stdlib/source/library/lux.lux | 519 ++++++++++++++++++++++-------------------- 1 file changed, 266 insertions(+), 253 deletions(-) (limited to 'stdlib/source/library/lux.lux') diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 6fb5b2a9f..16fb17d92 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -851,21 +851,21 @@ (macro (_ tokens) (meta#in {#End}))) -(def' .private $' +(def' .private $ Macro (macro (_ tokens) ({{#Item x {#End}} (meta#in tokens) {#Item x {#Item y xs}} - (meta#in {#Item (form$ {#Item (symbol$ [..prelude "$'"]) + (meta#in {#Item (form$ {#Item (symbol$ [..prelude "$"]) {#Item (variant$ {#Item (symbol$ [..prelude "#Apply"]) {#Item y {#Item x {#End}}}}) xs}}) {#End}}) _ - (failure "Wrong syntax for $'")} + (failure "Wrong syntax for $")} tokens))) (def' .private (list#mix f init xs) @@ -874,7 +874,7 @@ {#Function {#Parameter 3} {#Parameter 3}}} {#Function {#Parameter 3} - {#Function ($' List {#Parameter 1}) + {#Function ($ List {#Parameter 1}) {#Parameter 3}}}}}} ({{#End} init @@ -885,9 +885,9 @@ (def' .private (list#reversed list) {#UnivQ {#End} - {#Function ($' List {#Parameter 1}) ($' List {#Parameter 1})}} + {#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 {#Parameter 1} {#Function ($ List {#Parameter 1}) ($ List {#Parameter 1})}}} (function'' [head tail] {#Item head tail})) {#End} list)) @@ -896,18 +896,18 @@ {#UnivQ {#End} {#UnivQ {#End} {#Function {#Function {#Parameter 3} {#Parameter 1}} - {#Function ($' List {#Parameter 3}) - ($' List {#Parameter 1})}}}} + {#Function ($ List {#Parameter 3}) + ($ List {#Parameter 1})}}}} (list#mix (function'' [head tail] {#Item (f head) tail}) {#End} (list#reversed xs))) (def' .private Replacement_Environment Type - ($' List {#Product Text Code})) + ($ List {#Product Text Code})) (def' .private (replacement_environment xs ys) - {#Function ($' List Text) {#Function ($' List Code) Replacement_Environment}} + {#Function ($ List Text) {#Function ($ List Code) Replacement_Environment}} ({[{#Item x xs'} {#Item y ys'}] {#Item [x y] (replacement_environment xs' ys')} @@ -920,7 +920,7 @@ ("lux text =" reference sample)) (def' .private (replacement for environment) - {#Function Text {#Function Replacement_Environment ($' Maybe Code)}} + {#Function Text {#Function Replacement_Environment ($ Maybe Code)}} ({{#End} {#None} @@ -962,7 +962,7 @@ (def' .private (list#size list) {#UnivQ {#End} - {#Function ($' List {#Parameter 1}) Nat}} + {#Function ($ List {#Parameter 1}) Nat}} (list#mix (function'' [_ acc] ("lux i64 +" 1 acc)) 0 list)) (def' .private (let$ binding value body) @@ -1276,7 +1276,7 @@ ..Tuple) (def' .private (pairs xs) - (All (_ a) (-> ($' List a) ($' Maybe ($' List (Tuple a a))))) + (All (_ a) (-> ($ List a) ($ Maybe ($ List (Tuple a a))))) ({{#Item x {#Item y xs'}} ({{#Some tail} {#Some {#Item [x y] tail}} @@ -1316,7 +1316,7 @@ (def' .private (any? p xs) (All (_ a) - (-> (-> a Bit) ($' List a) Bit)) + (-> (-> a Bit) ($ List a) Bit)) ({{#End} #0 @@ -1333,7 +1333,7 @@ content)))) (def' .private (untemplated_list tokens) - (-> ($' List Code) Code) + (-> ($ List Code) Code) ({{#End} |#End| @@ -1342,7 +1342,7 @@ tokens)) (def' .private (list#composite xs ys) - (All (_ a) (-> ($' List a) ($' List a) ($' List a))) + (All (_ a) (-> ($ List a) ($ List a) ($ List a))) (list#mix (function' [head tail] {#Item head tail}) ys (list#reversed xs))) @@ -1404,16 +1404,16 @@ {#Named [..prelude "Monad"] (All (_ !) (Tuple (All (_ a) - (-> a ($' ! a))) + (-> a ($ ! a))) (All (_ a b) - (-> (-> a ($' ! b)) - ($' ! a) - ($' ! b)))))} + (-> (-> a ($ ! b)) + ($ ! a) + ($ ! b)))))} ["#in" "#then"] #0) (def' .private maybe#monad - ($' Monad Maybe) + ($ Monad Maybe) [#in (function' [x] {#Some x}) @@ -1424,7 +1424,7 @@ ma))]) (def' .private meta#monad - ($' Monad Meta) + ($ Monad Meta) [#in (function' [x] (function' [state] @@ -1482,10 +1482,10 @@ (def' .private (monad#each m f xs) (All (_ m a b) - (-> ($' Monad m) - (-> a ($' m b)) - ($' List a) - ($' m ($' List b)))) + (-> ($ Monad m) + (-> a ($ m b)) + ($ List a) + ($ m ($ List b)))) (let' [[..#in in ..#then _] m] ({{#End} (in {#End}) @@ -1499,11 +1499,11 @@ (def' .private (monad#mix m f y xs) (All (_ m a b) - (-> ($' Monad m) - (-> a b ($' m b)) + (-> ($ Monad m) + (-> a b ($ m b)) b - ($' List a) - ($' m b))) + ($ List a) + ($ m b))) (let' [[..#in in ..#then _] m] ({{#End} (in y) @@ -1528,11 +1528,11 @@ (def' .private Property_List Type - (All (_ a) ($' List (Tuple Text a)))) + (All (_ a) ($ List (Tuple Text a)))) (def' .private (property#value k property_list) (All (_ a) - (-> Text ($' Property_List a) ($' Maybe a))) + (-> Text ($ Property_List a) ($ Maybe a))) ({{#Item [[k' v] property_list']} (if (text#= k k') {#Some v} @@ -1544,7 +1544,7 @@ (def' .private (property#with k v property_list) (All (_ a) - (-> Text a ($' Property_List a) ($' Property_List a))) + (-> Text a ($ Property_List a) ($ Property_List a))) ({{#Item [k' v'] property_list'} (if (text#= k k') (list#partial [k v] property_list') @@ -1555,7 +1555,7 @@ property_list)) (def' .private (global_symbol full_name state) - (-> Symbol ($' Meta Symbol)) + (-> Symbol ($ Meta Symbol)) (let' [[module name] full_name [..#info info ..#source source ..#current_module _ ..#modules modules ..#scopes scopes ..#type_context types ..#host host @@ -1618,7 +1618,7 @@ (def' .private (list#one f xs) (All (_ a b) - (-> (-> a ($' Maybe b)) ($' List a) ($' Maybe b))) + (-> (-> a ($ Maybe b)) ($ List a) ($ Maybe b))) ({{#End} {#None} @@ -1632,20 +1632,20 @@ xs)) (def' .private (in_env name state) - (-> Text Lux ($' Maybe Type)) + (-> 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)) + (-> 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)) + (-> (Tuple Text (Tuple Type Any)) ($ Maybe Type)) (function' [it] (let' [[bname [type _]] it] (if (text#= name bname) @@ -1655,7 +1655,7 @@ scopes))) (def' .private (available? expected_module current_module exported?) - (-> Text ($' Maybe Text) Bit Bit) + (-> Text ($ Maybe Text) Bit Bit) (if exported? #1 ({{.#None} @@ -1666,7 +1666,7 @@ current_module))) (def' .private (definition_value name state) - (-> Symbol ($' Meta (Tuple Type Any))) + (-> Symbol ($ Meta (Tuple Type Any))) (let' [[expected_module expected_short] name [..#info info ..#source source @@ -1716,7 +1716,7 @@ (property#value expected_module modules)))) (def' .private (global_value global lux) - (-> Symbol ($' Meta ($' Maybe (Tuple Type Any)))) + (-> Symbol ($ Meta ($ Maybe (Tuple Type Any)))) (let' [[module short] global] ({{#Right [lux' type,value]} {#Right [lux' {#Some type,value}]} @@ -1750,12 +1750,12 @@ (def' .private (every? ?) (All (_ a) - (-> (-> a Bit) ($' List a) Bit)) + (-> (-> 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)))) + (-> ($ List a) ($ List b) ($ List (Tuple a b)))) ({{#Item x xs'} ({{#Item y ys'} (list#partial [x y] (zipped_2 xs' ys')) @@ -1830,7 +1830,7 @@ [left right])) (def' .private (one_expansion it) - (-> ($' Meta ($' List Code)) ($' Meta Code)) + (-> ($ Meta ($ List Code)) ($ Meta Code)) (do meta#monad [it it] ({{#Item it {#End}} @@ -1841,7 +1841,7 @@ it))) (def' .private (current_module_name state) - ($' Meta Text) + ($ 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 @@ -1855,7 +1855,7 @@ state)) (def' .private (normal name) - (-> Symbol ($' Meta Symbol)) + (-> Symbol ($ Meta Symbol)) ({["" name] (do meta#monad [module_name ..current_module_name] @@ -1866,11 +1866,11 @@ name)) (def' .private (untemplated_composite tag @composite untemplated replace? subst elements) - (-> Text Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) - ($' Meta Code)) + (-> 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)) + (-> Code Code ($ Meta Code)) (function' [head tail] (do meta#monad [head (untemplated replace? subst head)] @@ -1908,22 +1908,22 @@ (in [@composite output']))) (def' .private untemplated_form - (-> Location (-> Bit Text Code ($' Meta Code)) Bit Text ($' List Code) - ($' Meta Code)) + (-> 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)) + (-> 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)) + (-> 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)) + (-> Bit Text Code ($ Meta Code)) ({[_ [@token {#Bit value}]] (meta#in (with_location ..dummy_location (variant$ (list (symbol$ [..prelude "#Bit"]) (bit$ value))))) @@ -2153,7 +2153,7 @@ (function' [x] (f (g x)))) (def' .private (symbol_name x) - (-> Code ($' Maybe Symbol)) + (-> Code ($ Maybe Symbol)) ({[_ {#Symbol sname}] {#Some sname} @@ -2162,7 +2162,7 @@ x)) (def' .private (symbol_short x) - (-> Code ($' Maybe Text)) + (-> Code ($ Maybe Text)) ({[_ {#Symbol "" sname}] {#Some sname} @@ -2171,7 +2171,7 @@ x)) (def' .private (tuple_list tuple) - (-> Code ($' Maybe ($' List Code))) + (-> Code ($ Maybe ($ List Code))) ({[_ {#Tuple members}] {#Some members} @@ -2203,7 +2203,7 @@ template)) (def' .private (high_bits value) - (-> ($' I64 Any) I64) + (-> ($ I64 Any) I64) ("lux i64 right-shift" 32 value)) (def' .private low_mask @@ -2211,7 +2211,7 @@ (|> 1 ("lux i64 left-shift" 32) ("lux i64 -" 1))) (def' .private (low_bits value) - (-> ($' I64 Any) I64) + (-> ($ I64 Any) I64) ("lux i64 and" low_mask value)) (def' .private (n/< reference sample) @@ -2228,7 +2228,7 @@ (def' .private (list#conjoint xs) (All (_ a) - (-> ($' List ($' List a)) ($' List a))) + (-> ($ List ($ List a)) ($ List a))) (list#mix list#composite {#End} (list#reversed xs))) (def' .public symbol @@ -2246,7 +2246,7 @@ (macro (_ tokens) ({{#Item [[_ {#Tuple bindings}] {#Item [[_ {#Tuple templates}] data]}]} ({[{#Some bindings'} {#Some data'}] - (let' [apply ("lux type check" (-> Replacement_Environment ($' List Code)) + (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)) @@ -2364,9 +2364,9 @@ type)) (def' .private (named_macro' modules current_module module name) - (-> ($' List (Tuple Text Module)) + (-> ($ List (Tuple Text Module)) Text Text Text - ($' Maybe Macro)) + ($ Maybe Macro)) (do maybe#monad [$module (property#value module modules) gdef (let' [[..#module_hash _ ..#module_aliases _ ..#definitions bindings ..#imports _ ..#module_state _] ("lux type check" Module $module)] @@ -2394,7 +2394,7 @@ ("lux type check" Global gdef)))) (def' .private (named_macro full_name) - (-> Symbol ($' Meta ($' Maybe Macro))) + (-> Symbol ($ Meta ($ Maybe Macro))) (do meta#monad [current_module current_module_name] (let' [[module name] full_name] @@ -2408,7 +2408,7 @@ state))))) (def' .private (macro? name) - (-> Symbol ($' Meta Bit)) + (-> Symbol ($ Meta Bit)) (do meta#monad [name (normal name) output (named_macro name)] @@ -2418,7 +2418,7 @@ (def' .private (list#interposed sep xs) (All (_ a) - (-> a ($' List a) ($' List a))) + (-> a ($ List a) ($ List a))) ({{#End} xs @@ -2430,7 +2430,7 @@ xs)) (def' .private (single_expansion token) - (-> Code ($' Meta ($' List Code))) + (-> Code ($ Meta ($ List Code))) ({[_ {#Form {#Item [_ {#Symbol name}] args}}] (do meta#monad [name' (normal name) @@ -2446,8 +2446,8 @@ (meta#in (list token))} token)) -(def' .private (expansion token) - (-> Code ($' Meta ($' List Code))) +(def' .private (complete_expansion token) + (-> Code ($ Meta ($ List Code))) ({[_ {#Form {#Item [_ {#Symbol name}] args}}] (do meta#monad [name' (normal name) @@ -2455,7 +2455,7 @@ ({{#Some macro} (do meta#monad [top_level_expansion (("lux type as" Macro' macro) args) - recursive_expansion (monad#each meta#monad expansion top_level_expansion)] + recursive_expansion (monad#each meta#monad complete_expansion top_level_expansion)] (in (list#conjoint recursive_expansion))) {#None} @@ -2466,26 +2466,26 @@ (meta#in (list token))} token)) -(def' .private (full_expansion' full_expansion @name name args) - (-> (-> Code ($' Meta ($' List Code))) Location Symbol ($' List Code) ($' Meta ($' List Code))) +(def' .private (total_expansion' total_expansion @name name args) + (-> (-> Code ($ Meta ($ List Code))) Location 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)] + expansion' (monad#each meta#monad total_expansion expansion)] (in (list#conjoint expansion'))) {#None} (do meta#monad - [args' (monad#each meta#monad full_expansion args)] + [args' (monad#each meta#monad total_expansion args)] (in (list (form$ {#Item [@name {#Symbol name}] (list#conjoint args')}))))} ?macro))) (def' .private (in_module module meta) (All (_ a) - (-> Text ($' Meta a) ($' Meta a))) + (-> Text ($ Meta a) ($ Meta a))) (function' [lux] ({[..#info info ..#source source ..#current_module current_module ..#modules modules @@ -2522,26 +2522,26 @@ ..#eval eval]))} lux))) -(def' .private (full_expansion syntax) - (-> Code ($' Meta ($' List Code))) +(def' .private (total_expansion syntax) + (-> Code ($ Meta ($ List Code))) ({[_ {#Form {#Item head tail}}] ({[@name {#Symbol name}] - (..full_expansion' full_expansion @name name tail) + (..total_expansion' total_expansion @name name tail) _ (do meta#monad - [members' (monad#each meta#monad full_expansion {#Item head tail})] + [members' (monad#each meta#monad total_expansion {#Item head tail})] (in (list (form$ (list#conjoint members')))))} head) [_ {#Variant members}] (do meta#monad - [members' (monad#each meta#monad full_expansion members)] + [members' (monad#each meta#monad total_expansion members)] (in (list (variant$ (list#conjoint members'))))) [_ {#Tuple members}] (do meta#monad - [members' (monad#each meta#monad full_expansion members)] + [members' (monad#each meta#monad total_expansion members)] (in (list (tuple$ (list#conjoint members'))))) _ @@ -2598,7 +2598,7 @@ code)) (def' .private (normal_type type) - (-> Code ($' Meta Code)) + (-> Code ($ Meta Code)) ({[_ {#Variant {#Item [_ {#Symbol symbol}] parts}}] (do meta#monad [parts (monad#each meta#monad normal_type parts)] @@ -2656,7 +2656,7 @@ type)) (def' .private (with_quantification' body lux) - (-> ($' Meta Code) ($' Meta Code)) + (-> ($ Meta Code) ($ Meta Code)) (let' [[..#info info/pre ..#source source/pre ..#current_module current_module/pre @@ -2729,7 +2729,7 @@ [initialized_quantification? (function' [lux] {#Right [lux (initialized_quantification? lux)]})] (if initialized_quantification? (do meta#monad - [type+ (full_expansion type)] + [type+ (total_expansion type)] ({{#Item type' {#End}} (do meta#monad [type'' (normal_type type')] @@ -2774,7 +2774,7 @@ (def' .private (empty? xs) (All (_ a) - (-> ($' List a) Bit)) + (-> ($ List a) Bit)) ({{#End} #1 _ #0} xs)) @@ -2790,7 +2790,7 @@ [product#right b y]) (def' .private (generated_symbol prefix state) - (-> Text ($' Meta Code)) + (-> Text ($ Meta Code)) ({[..#info info ..#source source ..#current_module _ ..#modules modules ..#scopes scopes ..#type_context types ..#host host ..#seed seed ..#expected expected @@ -2819,6 +2819,172 @@ (failure (..wrong_syntax_error (symbol ..exec)))} (list#reversed tokens)))) +(with_template [ ] + [(def' .private ( type) + (type_literal (-> Type (List Type))) + ({{ left right} + (list#partial left ( right)) + + _ + (list type)} + type))] + + [flat_variant #Sum] + [flat_tuple #Product] + [flat_lambda #Function] + ) + +(def' .private (flat_application type) + (type_literal (-> Type [Type (List Type)])) + ({{#Apply head func'} + (let' [[func tail] (flat_application func')] + [func {#Item head tail}]) + + _ + [type (list)]} + type)) + +(def' .private (type#encoded type) + (-> Type Text) + ({{#Primitive name params} + ({{#End} + name + + _ + (all text#composite "(" name " " (|> params (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) ")")} + params) + + {#Sum _} + (all text#composite "{" (|> (flat_variant type) (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) "}") + + {#Product _} + (all text#composite "[" (|> (flat_tuple type) (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) "]") + + {#Function _} + (all text#composite "(-> " (|> (flat_lambda type) (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) ")") + + {#Parameter id} + (nat#encoded id) + + {#Var id} + (all text#composite "-" (nat#encoded id)) + + {#Ex id} + (all text#composite "+" (nat#encoded id)) + + {#UnivQ env body} + (all text#composite "(All " (type#encoded body) ")") + + {#ExQ env body} + (all text#composite "(Ex " (type#encoded body) ")") + + {#Apply _} + (let' [[func args] (flat_application type)] + (all text#composite + "(" (type#encoded func) " " + (|> args (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) + ")")) + + {#Named name _} + (symbol#encoded name)} + type)) + +(def' .private (meta#try it) + (type_literal (All (_ a) (-> (Meta a) (Meta (Either Text a))))) + (function' [state] + ({{#Left error} + {#Right [state {#Left error}]} + + {#Right [state output]} + {#Right [state {#Right output}]}} + (it state)))) + +(def' .private (anonymous_type it) + (-> Type Type) + ({{#Named _ it} + (anonymous_type it) + + _ + it} + it)) + +(def' .private static' + (type_literal (-> Bit Code (Meta Code))) + (let' [simple_literal (is (-> Symbol (Meta Code)) + (function' [name] + (do meta#monad + [type+value (meta#try (definition_value name))] + ({{#Left error} + (in (symbol$ name)) + + {#Right [type value]} + ({{#Primitive "#Bit" {#End}} + (in (bit$ (as Bit value))) + + {#Primitive "#Frac" {#End}} + (in (frac$ (as Frac value))) + + {#Primitive "#Text" {#End}} + (in (text$ (as Text value))) + + {#Primitive "#I64" {#Item {#Primitive "#Nat" {#End}} {#End}}} + (in (nat$ (as Nat value))) + + {#Primitive "#I64" {#Item {#Primitive "#Int" {#End}} {#End}}} + (in (int$ (as Int value))) + + {#Primitive "#I64" {#Item {#Primitive "#Rev" {#End}} {#End}}} + (in (rev$ (as Rev value))) + + _ + (failure (all text#composite + "Invalid static value: " (symbol#encoded name) + " : " (type#encoded type)))} + (anonymous_type type))} + type+value))))] + (function' literal [only_global? token] + ({[_ {#Symbol [def_module def_name]}] + (if (text#= "" def_module) + (if only_global? + (meta#in (symbol$ [def_module def_name])) + (do meta#monad + [current_module current_module_name] + (simple_literal [current_module def_name]))) + (simple_literal [def_module def_name])) + + [meta {#Form parts}] + (do meta#monad + [=parts (monad#each meta#monad (literal only_global?) parts)] + (in [meta {#Form =parts}])) + + [meta {#Variant parts}] + (do meta#monad + [=parts (monad#each meta#monad (literal only_global?) parts)] + (in [meta {#Variant =parts}])) + + [meta {#Tuple parts}] + (do meta#monad + [=parts (monad#each meta#monad (literal only_global?) parts)] + (in [meta {#Tuple =parts}])) + + _ + ... TODO: Figure out why this doesn't work: + ... (at meta#monad in token) + (meta#in token)} + token)))) + +(def' .public static + Macro + (macro (_ tokens) + ({{#Item pattern {#End}} + (do meta#monad + [pattern' (static' #0 pattern)] + (in (list pattern'))) + + _ + (failure (..wrong_syntax_error (symbol ..static)))} + tokens))) + (def' .public Pattern Type {#Primitive "#Macro/Pattern" {#End}}) @@ -2836,7 +3002,8 @@ Code Code (List Code) (Meta (List Code)))) (do meta#monad - [pattern (one_expansion (full_expansion pattern)) + [pattern (one_expansion (total_expansion pattern)) + pattern (static' #1 pattern) branches (case_expansion branches)] (in (list#partial pattern body branches)))) @@ -2867,11 +3034,11 @@ (meta#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 ""))))} + (failure (all text#composite "'case' expects an even number of tokens: " (|> branches + (list#each code#encoded) + (list#interposed " ") + list#reversed + (list#mix text#composite ""))))} branches)) (def' .public case @@ -3405,31 +3572,6 @@ _ {#None})) -(with_template [ ] - [(def ( type) - (-> Type (List Type)) - (case type - { left right} - (list#partial left ( right)) - - _ - (list type)))] - - [flat_variant #Sum] - [flat_tuple #Product] - [flat_lambda #Function] - ) - -(def (flat_application type) - (-> Type [Type (List Type)]) - (case type - {#Apply head func'} - (let [[func tail] (flat_application func')] - [func {#Item head tail}]) - - _ - [type (list)])) - (def (interface_methods type) (-> Type (Maybe (List Type))) (case type @@ -3542,56 +3684,10 @@ {#None} {#Left "Not expecting any type."})))) -(def (type#encoded type) - (-> Type Text) - (case type - {#Primitive name params} - (case params - {#End} - name - - _ - (all text#composite "(" name " " (|> params (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) ")")) - - {#Sum _} - (all text#composite "{" (|> (flat_variant type) (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) "}") - - {#Product _} - (all text#composite "[" (|> (flat_tuple type) (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) "]") - - {#Function _} - (all text#composite "(-> " (|> (flat_lambda type) (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) ")") - - {#Parameter id} - (nat#encoded id) - - {#Var id} - (all text#composite "-" (nat#encoded id)) - - {#Ex id} - (all text#composite "+" (nat#encoded id)) - - {#UnivQ env body} - (all text#composite "(All " (type#encoded body) ")") - - {#ExQ env body} - (all text#composite "(Ex " (type#encoded body) ")") - - {#Apply _} - (let [[func args] (flat_application type)] - (all text#composite - "(" (type#encoded func) " " - (|> args (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) - ")")) - - {#Named name _} - (symbol#encoded name) - )) - (def .public implementation (macro (_ tokens) (do meta#monad - [tokens' (monad#each meta#monad expansion tokens) + [tokens' (monad#each meta#monad complete_expansion tokens) implementation_type ..expected_type tags+type (record_slots implementation_type) tags (is (Meta (List Symbol)) @@ -4942,78 +5038,6 @@ {#None} (failure (..wrong_syntax_error (symbol ..with_expansions))))))) -(def (flat_alias type) - (-> Type Type) - (case type - (with_template#pattern [] - [{#Named ["library/lux" ] _} - type]) - (["Bit"] - ["Nat"] - ["Int"] - ["Rev"] - ["Frac"] - ["Text"]) - - {#Named _ type'} - (flat_alias type') - - _ - type)) - -(def .public static - (let [simple_literal (is (-> Symbol (Meta Code)) - (function (simple_literal name) - (do meta#monad - [type+value (definition_value name) - .let [[type value] type+value]] - (case (flat_alias type) - (with_template#pattern [ ] - [{#Named ["library/lux" ] _} - (in ( (as value)))]) - (["Bit" Bit bit$] - ["Nat" Nat nat$] - ["Int" Int int$] - ["Rev" Rev rev$] - ["Frac" Frac frac$] - ["Text" Text text$]) - - _ - (failure (text#composite "Cannot anti-quote type: " (symbol#encoded name))))))) - literal (is (-> Code (Meta Code)) - (function (literal token) - (case token - [_ {#Symbol [def_module def_name]}] - (if (text#= "" def_module) - (do meta#monad - [current_module current_module_name] - (simple_literal [current_module def_name])) - (simple_literal [def_module def_name])) - - (with_template#pattern [] - [[meta { parts}] - (do meta#monad - [=parts (monad#each meta#monad literal parts)] - (in [meta { =parts}]))]) - ([#Form] - [#Variant] - [#Tuple]) - - _ - (meta#in token) - ... TODO: Figure out why this doesn't work: - ... (at meta#monad in token) - )))] - (macro (_ tokens) - (case tokens - (list pattern) - (do meta#monad - [pattern' (literal pattern)] - (in (list pattern'))) - - _ - (failure (..wrong_syntax_error (symbol ..static))))))) - (def .public (same? reference sample) (All (_ a) (-> a a Bit)) @@ -5145,9 +5169,8 @@ [symbol (..global_symbol symbol) type+value (..definition_value symbol) .let [[type value] type+value]] - (case (..flat_alias type) - (pattern#or {#Primitive "#Text" {#End}} - {#Named ["library/lux" "Text"] {#Primitive "#Text" {#End}}}) + (case (anonymous_type type) + {#Primitive "#Text" {#End}} (in (as ..Text value)) _ @@ -5280,16 +5303,6 @@ (list#mix list#composite (list))) [<@> { (list#each product#right <*>')}]]))])) -(def (meta#try it) - (All (_ a) (-> (Meta a) (Meta (Either Text a)))) - (function (_ state) - (case (it state) - {#Left error} - {#Right [state {#Left error}]} - - {#Right [state output]} - {#Right [state {#Right output}]}))) - (def (embedded_expansions code) (-> Code (Meta [(List Code) Code])) (case code @@ -5376,7 +5389,7 @@ (def .public Interface (macro (_ tokens) (do meta#monad - [methods' (monad#each meta#monad expansion tokens)] + [methods' (monad#each meta#monad complete_expansion tokens)] (case (everyP methodP (list#conjoint methods')) {#Some methods} (in (list (` (..Tuple (,* (list#each product#right methods)))) @@ -5396,7 +5409,7 @@ (case tokens (list [_ {#Symbol "" name}] body) (do meta#monad - [body' (expansion body) + [body' (complete_expansion body) g!self (generated_symbol "g!self") g!dummy (generated_symbol "g!dummy")] (case body' -- cgit v1.2.3