From d772fe99d5d4990c6774481fb64d12280cdb6aae Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 19 Aug 2021 04:59:06 -0400 Subject: Enabled compile-time code evaluation (i.e. "eval" function). --- stdlib/source/library/lux.lux | 168 ++++++++++++++++++++++++------------------ 1 file changed, 95 insertions(+), 73 deletions(-) (limited to 'stdlib/source/library/lux.lux') diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 6554978c9..6c1335fe9 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -691,33 +691,55 @@ ... #seed Nat ... #scope_type_vars (List Nat) ... #extensions Any +... #eval (-> Type Code (-> Lux (Either Text [Lux Any]))) ... #host Any}) ("lux def type tagged" Lux (#Named ["library/lux" "Lux"] - (#Product ... "lux.info" - Info - (#Product ... "lux.source" - Source - (#Product ... "lux.location" - Location - (#Product ... "lux.current_module" - (#Apply Text Maybe) - (#Product ... "lux.modules" - (#Apply (#Product Text Module) List) - (#Product ... "lux.scopes" - (#Apply Scope List) - (#Product ... "lux.type_context" - Type_Context - (#Product ... "lux.expected" - (#Apply Type Maybe) - (#Product ... "lux.seed" - Nat - (#Product ... scope_type_vars - (#Apply Nat List) - (#Product ... extensions - Any - ... "lux.host" - Any)))))))))))) + ({Lux + (#Apply Nothing + (#UnivQ #End + (#Product + ... info + Info + (#Product + ... source + Source + (#Product + ... location + Location + (#Product + ... current_module + (#Apply Text Maybe) + (#Product + ... modules + (#Apply (#Product Text Module) List) + (#Product + ... scopes + (#Apply Scope List) + (#Product + ... type_context + Type_Context + (#Product + ... expected + (#Apply Type Maybe) + (#Product + ... seed + Nat + (#Product + ... scope_type_vars + (#Apply Nat List) + (#Product + ... extensions + Any + (#Product + ... eval + (#Function Type + (#Function Code + (#Function Lux + (#Sum Text (#Product Lux Any))))) + ... host + Any))))))))))))))} + (#Apply (#Parameter 1) (#Parameter 0)))) (record$ (#Item [(tag$ ["library/lux" "doc"]) (text$ ("lux text concat" ("lux text concat" "Represents the state of the Lux compiler during a run." __paragraph) @@ -725,7 +747,7 @@ ("lux text concat" "It is provided to macros during their invocation, so they can access compiler data." __paragraph) "Caveat emptor: Avoid fiddling with it, unless you know what you're doing.")))] #End)) - ["info" "source" "location" "current_module" "modules" "scopes" "type_context" "expected" "seed" "scope_type_vars" "extensions" "host"] + ["info" "source" "location" "current_module" "modules" "scopes" "type_context" "expected" "seed" "scope_type_vars" "extensions" "eval" "host"] #1) ... (type: .public (Meta a) @@ -1223,7 +1245,7 @@ (failure "Wrong syntax for Ex")} tokens))) -(def:'' .private (list\reverse list) +(def:'' .private (list\reversed list) #End (All [a] (#Function ($' List a) ($' List a))) (list\fold ("lux type check" (All [a] (#Function a (#Function ($' List a) ($' List a)))) @@ -1248,7 +1270,7 @@ _ (failure "Wrong syntax for ->")} - (list\reverse tokens))) + (list\reversed tokens))) (macro:' .public (list xs) (#Item [(tag$ ["library/lux" "doc"]) @@ -1261,7 +1283,7 @@ (#Item (tuple$ (#Item [head (#Item [tail #End])])) #End)))) (tag$ ["library/lux" "End"]) - (list\reverse xs)) + (list\reversed xs)) #End))) (macro:' .public (list& xs) @@ -1281,7 +1303,7 @@ _ (failure "Wrong syntax for list&")} - (list\reverse xs))) + (list\reversed xs))) (macro:' .public (Variant tokens) (#Item [(tag$ ["library/lux" "doc"]) @@ -1300,7 +1322,7 @@ (in_meta (list (list\fold (function'' [left right] (form$ (list (tag$ ["library/lux" "Sum"]) left right))) last prevs)))} - (list\reverse tokens))) + (list\reversed tokens))) (macro:' .public (Tuple tokens) (#Item [(tag$ ["library/lux" "doc"]) @@ -1319,7 +1341,7 @@ (in_meta (list (list\fold (function'' [left right] (form$ (list (tag$ ["library/lux" "Product"]) left right))) last prevs)))} - (list\reverse tokens))) + (list\reversed tokens))) (macro:' .private (function' tokens) (let'' [name tokens'] ({(#Item [[_ (#Identifier ["" name])] tokens']) @@ -1340,7 +1362,7 @@ arg)) body'))) body - (list\reverse targs))))))} + (list\reversed targs))))))} args) _ @@ -1412,7 +1434,7 @@ (form$ (list (record$ (list [label body])) value))} binding))) body - (list\reverse (pairs bindings))))) + (list\reversed (pairs bindings))))) _ (failure "Wrong syntax for let'")} @@ -1512,7 +1534,7 @@ _ (failure "Wrong syntax for $_")} - (list\reverse tokens')) + (list\reversed tokens')) _ (failure "Wrong syntax for $_")} @@ -1588,7 +1610,7 @@ value))} var)))) body - (list\reverse (pairs bindings)))] + (list\reversed (pairs bindings)))] (in_meta (list (form$ (list (record$ (list [(record$ (list [(tag$ ["library/lux" "in"]) g!in] [(tag$ ["library/lux" "bind"]) g!bind])) body'])) monad))))) @@ -1690,7 +1712,7 @@ {#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} state] + #scope_type_vars scope_type_vars #eval _eval} state] ({(#Some {#module_hash _ #module_aliases _ #definitions definitions #imports _ #tags tags #types types #module_annotations _ #module_state _}) ({(#Some constant) ({(#Left real_name) @@ -1749,7 +1771,7 @@ leftI)) lastO inits))} - (list\reverse elems)) + (list\reversed elems)) #0 (do meta_monad [=elems (monad\map meta_monad untemplated elems)] @@ -1874,7 +1896,7 @@ ({{#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} + #scope_type_vars scope_type_vars #eval _eval} ({(#Some module_name) (#Right [state module_name]) @@ -1979,7 +2001,7 @@ _ (failure "Wrong syntax for <|")} - (list\reverse tokens))) + (list\reversed tokens))) (def:''' .private (function\composite f g) (list [(tag$ ["library/lux" "doc"]) @@ -2101,7 +2123,7 @@ #End (All [a] (-> ($' List ($' List a)) ($' List a))) - (list\fold list\compose #End (list\reverse xs))) + (list\fold list\compose #End (list\reversed xs))) (macro:' .public (template tokens) (list [(tag$ ["library/lux" "doc"]) @@ -2298,7 +2320,7 @@ #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope_type_vars scope_type_vars} + #scope_type_vars scope_type_vars #eval _eval} (#Right state (macro' modules current_module module name))} state))))) @@ -2563,12 +2585,12 @@ #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope_type_vars scope_type_vars} + #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} + #scope_type_vars scope_type_vars #eval _eval} (local_identifier$ ($_ text\compose "__gensym__" prefix (nat\encode seed))))} state)) @@ -2607,7 +2629,7 @@ _ (failure "Wrong syntax for exec")} - (list\reverse tokens))) + (list\reversed tokens))) (macro:' .private (def:' tokens) (let' [parts (: (Maybe [Code Code (List Code) (Maybe Code) Code]) @@ -2687,14 +2709,14 @@ ($_ text\compose "(" (|> xs (list\map code\encode) (list\interposed " ") - list\reverse + list\reversed (list\fold text\compose "")) ")") [_ (#Tuple xs)] ($_ text\compose "[" (|> xs (list\map code\encode) (list\interposed " ") - list\reverse + list\reversed (list\fold text\compose "")) "]") [_ (#Record kvs)] @@ -2702,7 +2724,7 @@ (list\map (function' [kv] ({[k v] ($_ text\compose (code\encode k) " " (code\encode v))} kv))) (list\interposed " ") - list\reverse + list\reversed (list\fold text\compose "")) "}")} code)) @@ -2735,7 +2757,7 @@ (failure ($_ text\compose "'lux.case' expects an even number of tokens: " (|> branches (list\map code\encode) (list\interposed " ") - list\reverse + list\reversed (list\fold text\compose ""))))} branches)) @@ -2832,7 +2854,7 @@ (case tokens (^ (list [_ (#Tuple bindings)] body)) (if (multiple? 2 (list\size bindings)) - (|> bindings pairs list\reverse + (|> bindings pairs list\reversed (list\fold (: (-> [Code Code] Code Code) (function' [lr body'] (let' [[l r] lr] @@ -2874,7 +2896,7 @@ (` ([(~ g!name) (~ g!blank)] (.case (~ g!blank) (~ arg) (~ body'))))))))] (in_meta (list (nest (..local_identifier$ g!name) head - (list\fold (nest g!blank) body (list\reverse tail)))))) + (list\fold (nest g!blank) body (list\reversed tail)))))) #None (failure "Wrong syntax for function"))) @@ -3261,7 +3283,7 @@ (template [
] [(macro: .public ( tokens) {#.doc } - (case (list\reverse tokens) + (case (list\reversed tokens) (^ (list& last init)) (in_meta (list (list\fold (: (-> Code Code Code) (function (_ pre post) (` ))) @@ -3458,7 +3480,7 @@ (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} state] + #scope_type_vars scope_type_vars #eval _eval} state] (case (plist\value name modules) (#Some module) (#Right state module) @@ -3515,7 +3537,7 @@ (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} state] + #scope_type_vars scope_type_vars #eval _eval} state] (case expected (#Some type) (#Right state type) @@ -4032,9 +4054,9 @@ jumps ("lux i64 -" 1 relatives)] (if (n/< (list\size parts) jumps) (let [prefix (|> parts - list\reverse + list\reversed (list\after jumps) - list\reverse + list\reversed (text\interposed ..module_separator)) clean ("lux text clip" relatives (|> module "lux text size" ("lux i64 -" relatives)) module) output (case ("lux text size" clean) @@ -4128,7 +4150,7 @@ {#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} + #scope_type_vars scope_type_vars #eval _eval} [current_module modules])] (case (plist\value module modules) (#Some =module) @@ -4196,7 +4218,7 @@ {#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} + #scope_type_vars scope_type_vars #eval _eval} (list\one (: (-> Scope (Maybe Type)) (function (_ env) (case env @@ -4219,7 +4241,7 @@ {#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} state] + #scope_type_vars scope_type_vars #eval _eval} state] (case (plist\value v_module modules) #None #None @@ -4243,7 +4265,7 @@ {#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} state] + #scope_type_vars scope_type_vars #eval _eval} state] (case (plist\value v_module modules) #None (#Left (text\compose "Unknown definition: " (name\encode name))) @@ -4301,7 +4323,7 @@ (let [{#info _ #source _ #current_module _ #modules _ #scopes _ #type_context type_context #host _ #seed _ #expected _ #location _ #extensions extensions - #scope_type_vars _} compiler + #scope_type_vars _ #eval _eval} compiler {#ex_counter _ #var_counter _ #var_bindings var_bindings} type_context] (case (type_variable type_id var_bindings) #None @@ -4337,16 +4359,16 @@ name _ - ($_ text\compose "(" name " " (|> params (list\map type\encode) (list\interposed " ") list\reverse (list\fold text\compose "")) ")")) + ($_ text\compose "(" name " " (|> params (list\map type\encode) (list\interposed " ") list\reversed (list\fold text\compose "")) ")")) (#Sum _) - ($_ text\compose "(Or " (|> (flat_variant type) (list\map type\encode) (list\interposed " ") list\reverse (list\fold text\compose "")) ")") + ($_ text\compose "(Or " (|> (flat_variant type) (list\map type\encode) (list\interposed " ") list\reversed (list\fold text\compose "")) ")") (#Product _) - ($_ text\compose "[" (|> (flat_tuple type) (list\map type\encode) (list\interposed " ") list\reverse (list\fold text\compose "")) "]") + ($_ text\compose "[" (|> (flat_tuple type) (list\map type\encode) (list\interposed " ") list\reversed (list\fold text\compose "")) "]") (#Function _) - ($_ text\compose "(-> " (|> (flat_lambda type) (list\map type\encode) (list\interposed " ") list\reverse (list\fold text\compose "")) ")") + ($_ text\compose "(-> " (|> (flat_lambda type) (list\map type\encode) (list\interposed " ") list\reversed (list\fold text\compose "")) ")") (#Parameter id) (nat\encode id) @@ -4367,7 +4389,7 @@ (let [[func args] (flat_application type)] ($_ text\compose "(" (type\encode func) " " - (|> args (list\map type\encode) (list\interposed " ") list\reverse (list\fold text\compose "")) + (|> args (list\map type\encode) (list\interposed " ") list\reversed (list\fold text\compose "")) ")")) (#Named name _) @@ -4435,7 +4457,7 @@ " ''???'')"))} (if ("lux i64 =" 0 (n/% 2 (list\size tokens))) (failure "cond requires an uneven number of arguments.") - (case (list\reverse tokens) + (case (list\reversed tokens) (^ (list& else branches')) (in_meta (list (list\fold (: (-> [Code Code] Code Code) (function (_ branch else) @@ -4834,14 +4856,14 @@ (function (_ [s b] v) (` (..with@ (~ s) (~ v) (~ b))))) value - (list\reverse pairs)) + (list\reversed pairs)) [_ accesses'] (list\fold (: (-> [Code Code] [Code (List (List Code))] [Code (List (List Code))]) (function (_ [new_slot new_binding] [old_record accesses']) [(` (value@ (~ new_slot) (~ new_binding))) (#Item (list new_binding old_record) accesses')])) [record (: (List (List Code)) #End)] pairs) - accesses (list\joined (list\reverse accesses'))]] + accesses (list\joined (list\reversed accesses'))]] (in (list (` (let [(~+ accesses)] (~ update_expr))))))) @@ -5525,7 +5547,7 @@ (list) (list g!_ (` #.None)))))))) (` (#.Some (~ body))) - (: (List [Code Code]) (list\reverse levels)))] + (: (List [Code Code]) (list\reversed levels)))] (list init_pattern inner_pattern_body))) (macro: .public (^multi tokens) @@ -5608,7 +5630,7 @@ {#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} + #scope_type_vars scope_type_vars #eval _eval} (#Right [state scope_type_vars]))) (macro: .public (:parameter tokens) @@ -5625,7 +5647,7 @@ (^ (list [_ (#Nat idx)])) (do meta_monad [stvs ..scope_type_vars] - (case (..item idx (list\reverse stvs)) + (case (..item idx (list\reversed stvs)) (#Some var_id) (in (list (` (#Ex (~ (nat$ var_id)))))) @@ -5999,11 +6021,11 @@ [(def: ( g!meta untemplated_pattern elems) (-> Code (-> Code (Meta Code)) (-> (List Code) (Meta Code))) - (case (list\reverse elems) + (case (list\reversed elems) (#Item [_ (#Form (#Item [[_ (#Identifier ["" "~+"])] (#Item [spliced #End])]))] inits) (do meta_monad - [=inits (monad\map meta_monad untemplated_pattern (list\reverse inits))] + [=inits (monad\map meta_monad untemplated_pattern (list\reversed inits))] (in (` [(~ g!meta) ( (~ (untemplated_list& spliced =inits)))]))) _ -- cgit v1.2.3