diff options
| author | Eduardo Julian | 2021-08-07 02:20:09 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2021-08-07 02:20:09 -0400 |
| commit | 17e7566be51df5e428a6b10e6469201a8a9468da (patch) | |
| tree | 0d4ed80c9c9d846784b5bf460f6e6f5fc5b96663 /stdlib/source/library/lux.lux | |
| parent | eff4c59794868b89d60fdc411f9b544a270b817e (diff) | |
Made the be/de macros for (co)monadic expression extensible.
Diffstat (limited to 'stdlib/source/library/lux.lux')
| -rw-r--r-- | stdlib/source/library/lux.lux | 1043 |
1 files changed, 514 insertions, 529 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index c342863e7..e9b0278e5 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -735,7 +735,7 @@ #1) ## Base functions & macros -("lux def" return +("lux def" in_meta ("lux type check" (#UnivQ #End (#Function (#Parameter 1) @@ -767,8 +767,8 @@ ("lux macro" ([_ tokens] ({(#Item lhs (#Item rhs (#Item body #End))) - (return (#Item (form$ (#Item (record$ (#Item [lhs body] #End)) (#Item rhs #End))) - #End)) + (in_meta (#Item (form$ (#Item (record$ (#Item [lhs body] #End)) (#Item rhs #End))) + #End)) _ (failure "Wrong syntax for let''")} @@ -780,32 +780,32 @@ ("lux macro" ([_ tokens] ({(#Item [_ (#Tuple (#Item arg args'))] (#Item body #End)) - (return (#Item (_ann (#Form (#Item (_ann (#Tuple (#Item (_ann (#Identifier ["" ""])) - (#Item arg #End)))) - (#Item ({#End - body + (in_meta (#Item (_ann (#Form (#Item (_ann (#Tuple (#Item (_ann (#Identifier ["" ""])) + (#Item arg #End)))) + (#Item ({#End + body - _ - (_ann (#Form (#Item (_ann (#Identifier ["library/lux" "function''"])) - (#Item (_ann (#Tuple args')) - (#Item body #End)))))} - args') - #End)))) - #End)) + _ + (_ann (#Form (#Item (_ann (#Identifier ["library/lux" "function''"])) + (#Item (_ann (#Tuple args')) + (#Item body #End)))))} + args') + #End)))) + #End)) (#Item [_ (#Identifier ["" self])] (#Item [_ (#Tuple (#Item arg args'))] (#Item body #End))) - (return (#Item (_ann (#Form (#Item (_ann (#Tuple (#Item (_ann (#Identifier ["" self])) - (#Item arg #End)))) - (#Item ({#End - body + (in_meta (#Item (_ann (#Form (#Item (_ann (#Tuple (#Item (_ann (#Identifier ["" self])) + (#Item arg #End)))) + (#Item ({#End + body - _ - (_ann (#Form (#Item (_ann (#Identifier ["library/lux" "function''"])) - (#Item (_ann (#Tuple args')) - (#Item body #End)))))} - args') - #End)))) - #End)) + _ + (_ann (#Form (#Item (_ann (#Identifier ["library/lux" "function''"])) + (#Item (_ann (#Tuple args')) + (#Item body #End)))))} + args') + #End)))) + #End)) _ (failure "Wrong syntax for function''")} @@ -838,12 +838,6 @@ (record$ #End) #0) -("lux def" doc_meta - ("lux type check" (#Function Text (#Product Code Code)) - (function'' [doc] [(tag$ ["library/lux" "doc"]) (text$ doc)])) - (record$ #End) - #0) - ("lux def" as_def ("lux type check" (#Function Code (#Function Code (#Function Code (#Function Bit Code)))) (function'' [name value annotations exported?] @@ -883,37 +877,37 @@ ({(#Item [[_ (#Tag ["" "export"])] (#Item [[_ (#Form (#Item [name args]))] (#Item [meta (#Item [type (#Item [body #End])])])])]) - (return (#Item [(as_def name (as_checked type (as_function name args body)) - (form$ (#Item (identifier$ ["library/lux" "record$"]) - (#Item meta - #End))) - #1) - #End])) + (in_meta (#Item [(as_def name (as_checked type (as_function name args body)) + (form$ (#Item (identifier$ ["library/lux" "record$"]) + (#Item meta + #End))) + #1) + #End])) (#Item [[_ (#Tag ["" "export"])] (#Item [name (#Item [meta (#Item [type (#Item [body #End])])])])]) - (return (#Item [(as_def name (as_checked type body) - (form$ (#Item (identifier$ ["library/lux" "record$"]) - (#Item meta - #End))) - #1) - #End])) + (in_meta (#Item [(as_def name (as_checked type body) + (form$ (#Item (identifier$ ["library/lux" "record$"]) + (#Item meta + #End))) + #1) + #End])) (#Item [[_ (#Form (#Item [name args]))] (#Item [meta (#Item [type (#Item [body #End])])])]) - (return (#Item [(as_def name (as_checked type (as_function name args body)) - (form$ (#Item (identifier$ ["library/lux" "record$"]) - (#Item meta - #End))) - #0) - #End])) + (in_meta (#Item [(as_def name (as_checked type (as_function name args body)) + (form$ (#Item (identifier$ ["library/lux" "record$"]) + (#Item meta + #End))) + #0) + #End])) (#Item [name (#Item [meta (#Item [type (#Item [body #End])])])]) - (return (#Item [(as_def name (as_checked type body) - (form$ (#Item (identifier$ ["library/lux" "record$"]) - (#Item meta - #End))) - #0) - #End])) + (in_meta (#Item [(as_def name (as_checked type body) + (form$ (#Item (identifier$ ["library/lux" "record$"]) + (#Item meta + #End))) + #0) + #End])) _ (failure "Wrong syntax for def''")} @@ -925,28 +919,28 @@ ("lux macro" (function'' [tokens] ({(#Item [_ (#Form (#Item name args))] (#Item body #End)) - (return (#Item (as_def name (as_macro (as_function name args body)) - (form$ (#Item (identifier$ ["library/lux" "record$"]) - (#Item (tag$ ["library/lux" "End"]) - #End))) - #0) - #End)) + (in_meta (#Item (as_def name (as_macro (as_function name args body)) + (form$ (#Item (identifier$ ["library/lux" "record$"]) + (#Item (tag$ ["library/lux" "End"]) + #End))) + #0) + #End)) (#Item [_ (#Tag ["" "export"])] (#Item [_ (#Form (#Item name args))] (#Item body #End))) - (return (#Item (as_def name (as_macro (as_function name args body)) - (form$ (#Item (identifier$ ["library/lux" "record$"]) - (#Item (tag$ ["library/lux" "End"]) - #End))) - #1) - #End)) + (in_meta (#Item (as_def name (as_macro (as_function name args body)) + (form$ (#Item (identifier$ ["library/lux" "record$"]) + (#Item (tag$ ["library/lux" "End"]) + #End))) + #1) + #End)) (#Item [_ (#Tag ["" "export"])] (#Item [_ (#Form (#Item name args))] (#Item meta_data (#Item body #End)))) - (return (#Item (as_def name (as_macro (as_function name args body)) - (form$ (#Item (identifier$ ["library/lux" "record$"]) - (#Item meta_data - #End))) - #1) - #End)) + (in_meta (#Item (as_def name (as_macro (as_function name args body)) + (form$ (#Item (identifier$ ["library/lux" "record$"]) + (#Item meta_data + #End))) + #1) + #End)) _ (failure "Wrong syntax for macro:'")} @@ -962,18 +956,18 @@ ("lux text concat" "## Great for commenting-out code, while retaining syntax high-lighting and formatting in your text editor." __paragraph) "(comment +1 +2 +3 +4)")))] #End) - (return #End)) + (in_meta #End)) (macro:' ($' tokens) ({(#Item x #End) - (return tokens) + (in_meta tokens) (#Item x (#Item y xs)) - (return (#Item (form$ (#Item (identifier$ ["library/lux" "$'"]) - (#Item (form$ (#Item (tag$ ["library/lux" "Apply"]) - (#Item y (#Item x #End)))) - xs))) - #End)) + (in_meta (#Item (form$ (#Item (identifier$ ["library/lux" "$'"]) + (#Item (form$ (#Item (tag$ ["library/lux" "Apply"]) + (#Item y (#Item x #End)))) + xs))) + #End)) _ (failure "Wrong syntax for $'")} @@ -1058,7 +1052,7 @@ syntax)) (def:'' (n/* param subject) - (#.Item (doc_meta "Nat(ural) multiplication.") #.End) + #.End (#Function Nat (#Function Nat Nat)) ("lux type as" Nat ("lux i64 *" @@ -1160,18 +1154,18 @@ #End)))))) body names) - (return (#Item ({[#1 _] - body' - - [_ #End] - body' - - [#0 _] - (with_replacements (#Item [self_name (type_parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] - #End) - body')} - [(text\= "" self_name) names]) - #End))))) + (in_meta (#Item ({[#1 _] + body' + + [_ #End] + body' + + [#0 _] + (with_replacements (#Item [self_name (type_parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] + #End) + body')} + [(text\= "" self_name) names]) + #End))))) _ (failure "Wrong syntax for All")} @@ -1205,18 +1199,18 @@ #End)))))) body names) - (return (#Item ({[#1 _] - body' - - [_ #End] - body' - - [#0 _] - (with_replacements (#Item [self_name (type_parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] - #End) - body')} - [(text\= "" self_name) names]) - #End))))) + (in_meta (#Item ({[#1 _] + body' + + [_ #End] + body' + + [#0 _] + (with_replacements (#Item [self_name (type_parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] + #End) + body')} + [(text\= "" self_name) names]) + #End))))) _ (failure "Wrong syntax for Ex")} @@ -1239,11 +1233,11 @@ "## This is the type of a function that takes 2 Ints and returns an Int.")))] #End) ({(#Item output inputs) - (return (#Item (list\fold ("lux type check" (#Function Code (#Function Code Code)) - (function'' [i o] (form$ (#Item (tag$ ["library/lux" "Function"]) (#Item i (#Item o #End)))))) - output - inputs) - #End)) + (in_meta (#Item (list\fold ("lux type check" (#Function Code (#Function Code Code)) + (function'' [i o] (form$ (#Item (tag$ ["library/lux" "Function"]) (#Item i (#Item o #End)))))) + output + inputs) + #End)) _ (failure "Wrong syntax for ->")} @@ -1255,13 +1249,13 @@ ("lux text concat" "## List-construction macro." __paragraph) "(list +1 +2 +3)"))] #End) - (return (#Item (list\fold (function'' [head tail] - (form$ (#Item (tag$ ["library/lux" "Item"]) - (#Item (tuple$ (#Item [head (#Item [tail #End])])) - #End)))) - (tag$ ["library/lux" "End"]) - (list\reverse xs)) - #End))) + (in_meta (#Item (list\fold (function'' [head tail] + (form$ (#Item (tag$ ["library/lux" "Item"]) + (#Item (tuple$ (#Item [head (#Item [tail #End])])) + #End)))) + (tag$ ["library/lux" "End"]) + (list\reverse xs)) + #End))) (macro:' #export (list& xs) (#Item [(tag$ ["library/lux" "doc"]) @@ -1272,11 +1266,11 @@ "(list& +1 +2 +3 (list +4 +5 +6))")))] #End) ({(#Item last init) - (return (list (list\fold (function'' [head tail] - (form$ (list (tag$ ["library/lux" "Item"]) - (tuple$ (list head tail))))) - last - init))) + (in_meta (list (list\fold (function'' [head tail] + (form$ (list (tag$ ["library/lux" "Item"]) + (tuple$ (list head tail))))) + last + init))) _ (failure "Wrong syntax for list&")} @@ -1293,12 +1287,12 @@ "(&)"))))] #End) ({#End - (return (list (identifier$ ["library/lux" "Any"]))) + (in_meta (list (identifier$ ["library/lux" "Any"]))) (#Item last prevs) - (return (list (list\fold (function'' [left right] (form$ (list (tag$ ["library/lux" "Product"]) left right))) - last - prevs)))} + (in_meta (list (list\fold (function'' [left right] (form$ (list (tag$ ["library/lux" "Product"]) left right))) + last + prevs)))} (list\reverse tokens))) (macro:' #export (Variant tokens) @@ -1312,12 +1306,12 @@ "(Variant)"))))] #End) ({#End - (return (list (identifier$ ["library/lux" "Nothing"]))) + (in_meta (list (identifier$ ["library/lux" "Nothing"]))) (#Item last prevs) - (return (list (list\fold (function'' [left right] (form$ (list (tag$ ["library/lux" "Sum"]) left right))) - last - prevs)))} + (in_meta (list (list\fold (function'' [left right] (form$ (list (tag$ ["library/lux" "Sum"]) left right))) + last + prevs)))} (list\reverse tokens))) (macro:' (function' tokens) @@ -1332,14 +1326,14 @@ (failure "function' requires a non-empty arguments tuple.") (#Item [harg targs]) - (return (list (form$ (list (tuple$ (list (local_identifier$ name) - harg)) - (list\fold (function'' [arg body'] - (form$ (list (tuple$ (list (local_identifier$ "") - arg)) - body'))) - body - (list\reverse targs))))))} + (in_meta (list (form$ (list (tuple$ (list (local_identifier$ name) + harg)) + (list\fold (function'' [arg body'] + (form$ (list (tuple$ (list (local_identifier$ "") + arg)) + body'))) + body + (list\reverse targs))))))} args) _ @@ -1350,53 +1344,53 @@ ({(#Item [[_ (#Tag ["" "export"])] (#Item [[_ (#Form (#Item [name args]))] (#Item [meta (#Item [type (#Item [body #End])])])])]) - (return (list (form$ (list (text$ "lux def") - name - (form$ (list (text$ "lux type check") - type - (form$ (list (identifier$ ["library/lux" "function'"]) - name - (tuple$ args) - body)))) - (form$ (#Item (identifier$ ["library/lux" "record$"]) - (#Item meta - #End))) - (bit$ #1))))) + (in_meta (list (form$ (list (text$ "lux def") + name + (form$ (list (text$ "lux type check") + type + (form$ (list (identifier$ ["library/lux" "function'"]) + name + (tuple$ args) + body)))) + (form$ (#Item (identifier$ ["library/lux" "record$"]) + (#Item meta + #End))) + (bit$ #1))))) (#Item [[_ (#Tag ["" "export"])] (#Item [name (#Item [meta (#Item [type (#Item [body #End])])])])]) - (return (list (form$ (list (text$ "lux def") - name - (form$ (list (text$ "lux type check") - type - body)) - (form$ (#Item (identifier$ ["library/lux" "record$"]) - (#Item meta - #End))) - (bit$ #1))))) + (in_meta (list (form$ (list (text$ "lux def") + name + (form$ (list (text$ "lux type check") + type + body)) + (form$ (#Item (identifier$ ["library/lux" "record$"]) + (#Item meta + #End))) + (bit$ #1))))) (#Item [[_ (#Form (#Item [name args]))] (#Item [meta (#Item [type (#Item [body #End])])])]) - (return (list (form$ (list (text$ "lux def") - name - (form$ (list (text$ "lux type check") - type - (form$ (list (identifier$ ["library/lux" "function'"]) - name - (tuple$ args) - body)))) - (form$ (#Item (identifier$ ["library/lux" "record$"]) - (#Item meta - #End))) - (bit$ #0))))) + (in_meta (list (form$ (list (text$ "lux def") + name + (form$ (list (text$ "lux type check") + type + (form$ (list (identifier$ ["library/lux" "function'"]) + name + (tuple$ args) + body)))) + (form$ (#Item (identifier$ ["library/lux" "record$"]) + (#Item meta + #End))) + (bit$ #0))))) (#Item [name (#Item [meta (#Item [type (#Item [body #End])])])]) - (return (list (form$ (list (text$ "lux def") - name - (form$ (list (text$ "lux type check") type body)) - (form$ (#Item (identifier$ ["library/lux" "record$"]) - (#Item meta - #End))) - (bit$ #0))))) + (in_meta (list (form$ (list (text$ "lux def") + name + (form$ (list (text$ "lux type check") type body)) + (form$ (#Item (identifier$ ["library/lux" "record$"]) + (#Item meta + #End))) + (bit$ #0))))) _ (failure "Wrong syntax for def:'''")} @@ -1424,14 +1418,14 @@ (macro:' (let' tokens) ({(#Item [[_ (#Tuple bindings)] (#Item [body #End])]) - (return (list (list\fold ("lux type check" (-> (Tuple Code Code) Code - Code) - (function' [binding body] - ({[label value] - (form$ (list (record$ (list [label body])) value))} - binding))) - body - (list\reverse (pairs bindings))))) + (in_meta (list (list\fold ("lux type check" (-> (Tuple Code Code) Code + Code) + (function' [binding body] + ({[label value] + (form$ (list (record$ (list [label body])) value))} + binding))) + body + (list\reverse (pairs bindings))))) _ (failure "Wrong syntax for let'")} @@ -1450,7 +1444,7 @@ (p x))} xs)) -(def:''' (wrap_meta content) +(def:''' (with_location content) #End (-> Code Code) (tuple$ (list (tuple$ (list (text$ "") (nat$ 0) (nat$ 0))) @@ -1505,7 +1499,7 @@ #End) ({(#Item op tokens') ({(#Item first nexts) - (return (list (list\fold (function\flip (right_associativity op)) first nexts))) + (in_meta (list (list\fold (function\flip (right_associativity op)) first nexts))) _ (failure "Wrong syntax for _$")} @@ -1527,7 +1521,7 @@ #End) ({(#Item op tokens') ({(#Item last prevs) - (return (list (list\fold (right_associativity op) last prevs))) + (in_meta (list (list\fold (right_associativity op) last prevs))) _ (failure "Wrong syntax for $_")} @@ -1590,8 +1584,16 @@ body' (list\fold ("lux type check" (-> (Tuple Code Code) Code Code) (function' [binding body'] (let' [[var value] binding] - ({[_ (#Tag "" "let")] - (form$ (list (identifier$ ["library/lux" "let'"]) value body')) + ({[_ (#Identifier [module short])] + ({"" + (form$ (list g!bind + (form$ (list (tuple$ (list (local_identifier$ "") var)) body')) + value)) + + _ + (form$ (list var value body'))} + module) + _ (form$ (list g!bind @@ -1600,9 +1602,9 @@ var)))) body (list\reverse (pairs bindings)))] - (return (list (form$ (list (record$ (list [(record$ (list [(tag$ ["library/lux" "in"]) g!in] [(tag$ ["library/lux" "bind"]) g!bind])) - body'])) - monad))))) + (in_meta (list (form$ (list (record$ (list [(record$ (list [(tag$ ["library/lux" "in"]) g!in] [(tag$ ["library/lux" "bind"]) g!bind])) + body'])) + monad))))) _ (failure "Wrong syntax for do")} @@ -1655,9 +1657,9 @@ "(if #1 ''Oh, yeah!'' ''Aw hell naw!'')" __paragraph "=> ''Oh, yeah!''"))]) ({(#Item test (#Item then (#Item else #End))) - (return (list (form$ (list (record$ (list [(bit$ #1) then] - [(bit$ #0) else])) - test)))) + (in_meta (list (form$ (list (record$ (list [(bit$ #1) then] + [(bit$ #0) else])) + test)))) _ (failure "Wrong syntax for if")} @@ -1772,7 +1774,7 @@ (-> Bit (-> Code ($' Meta Code)) ($' List Code) ($' Meta Code)) ({#1 ({#End - (return (tag$ ["library/lux" "End"])) + (in_meta (tag$ ["library/lux" "End"])) (#Item lastI inits) (do meta_monad @@ -1810,31 +1812,31 @@ (def:''' (untemplated_text value) #End (-> Text Code) - (wrap_meta (form$ (list (tag$ ["library/lux" "Text"]) (text$ value))))) + (with_location (form$ (list (tag$ ["library/lux" "Text"]) (text$ value))))) (def:''' (untemplate replace? subst token) #End (-> Bit Text Code ($' Meta Code)) ({[_ [_ (#Bit value)]] - (return (wrap_meta (form$ (list (tag$ ["library/lux" "Bit"]) (bit$ value))))) + (in_meta (with_location (form$ (list (tag$ ["library/lux" "Bit"]) (bit$ value))))) [_ [_ (#Nat value)]] - (return (wrap_meta (form$ (list (tag$ ["library/lux" "Nat"]) (nat$ value))))) + (in_meta (with_location (form$ (list (tag$ ["library/lux" "Nat"]) (nat$ value))))) [_ [_ (#Int value)]] - (return (wrap_meta (form$ (list (tag$ ["library/lux" "Int"]) (int$ value))))) + (in_meta (with_location (form$ (list (tag$ ["library/lux" "Int"]) (int$ value))))) [_ [_ (#Rev value)]] - (return (wrap_meta (form$ (list (tag$ ["library/lux" "Rev"]) (rev$ value))))) + (in_meta (with_location (form$ (list (tag$ ["library/lux" "Rev"]) (rev$ value))))) [_ [_ (#Frac value)]] - (return (wrap_meta (form$ (list (tag$ ["library/lux" "Frac"]) (frac$ value))))) + (in_meta (with_location (form$ (list (tag$ ["library/lux" "Frac"]) (frac$ value))))) [_ [_ (#Text value)]] - (return (untemplated_text value)) + (in_meta (untemplated_text value)) [#0 [_ (#Tag [module name])]] - (return (wrap_meta (form$ (list (tag$ ["library/lux" "Tag"]) (tuple$ (list (text$ module) (text$ name))))))) + (in_meta (with_location (form$ (list (tag$ ["library/lux" "Tag"]) (tuple$ (list (text$ module) (text$ name))))))) [#1 [_ (#Tag [module name])]] (let' [module' ({"" @@ -1843,7 +1845,7 @@ _ module} module)] - (return (wrap_meta (form$ (list (tag$ ["library/lux" "Tag"]) (tuple$ (list (text$ module') (text$ name)))))))) + (in_meta (with_location (form$ (list (tag$ ["library/lux" "Tag"]) (tuple$ (list (text$ module') (text$ name)))))))) [#1 [_ (#Identifier [module name])]] (do meta_monad @@ -1855,24 +1857,24 @@ _ (in [module name])} module) - #let [[module name] real_name]] - (return (wrap_meta (form$ (list (tag$ ["library/lux" "Identifier"]) (tuple$ (list (text$ module) (text$ name)))))))) + .let' [[module name] real_name]] + (in_meta (with_location (form$ (list (tag$ ["library/lux" "Identifier"]) (tuple$ (list (text$ module) (text$ name)))))))) [#0 [_ (#Identifier [module name])]] - (return (wrap_meta (form$ (list (tag$ ["library/lux" "Identifier"]) (tuple$ (list (text$ module) (text$ name))))))) + (in_meta (with_location (form$ (list (tag$ ["library/lux" "Identifier"]) (tuple$ (list (text$ module) (text$ name))))))) [#1 [_ (#Form (#Item [[_ (#Identifier ["" "~"])] (#Item [unquoted #End])]))]] - (return (form$ (list (text$ "lux type check") - (identifier$ ["library/lux" "Code"]) - unquoted))) + (in_meta (form$ (list (text$ "lux type check") + (identifier$ ["library/lux" "Code"]) + unquoted))) [#1 [_ (#Form (#Item [[_ (#Identifier ["" "~!"])] (#Item [dependent #End])]))]] (do meta_monad [independent (untemplate replace? subst dependent)] - (in (wrap_meta (form$ (list (tag$ ["library/lux" "Form"]) - (untemplated_list (list (untemplated_text "lux in-module") - (untemplated_text subst) - independent))))))) + (in (with_location (form$ (list (tag$ ["library/lux" "Form"]) + (untemplated_list (list (untemplated_text "lux in-module") + (untemplated_text subst) + independent))))))) [#1 [_ (#Form (#Item [[_ (#Identifier ["" "~'"])] (#Item [keep_quoted #End])]))]] (untemplate #0 subst keep_quoted) @@ -1880,13 +1882,13 @@ [_ [meta (#Form elems)]] (do meta_monad [output (spliced replace? (untemplate replace? subst) elems) - #let [[_ output'] (wrap_meta (form$ (list (tag$ ["library/lux" "Form"]) output)))]] + .let' [[_ output'] (with_location (form$ (list (tag$ ["library/lux" "Form"]) output)))]] (in [meta output'])) [_ [meta (#Tuple elems)]] (do meta_monad [output (spliced replace? (untemplate replace? subst) elems) - #let [[_ output'] (wrap_meta (form$ (list (tag$ ["library/lux" "Tuple"]) output)))]] + .let' [[_ output'] (with_location (form$ (list (tag$ ["library/lux" "Tuple"]) output)))]] (in [meta output'])) [_ [_ (#Record fields)]] @@ -1900,7 +1902,7 @@ =v (untemplate replace? subst v)] (in (tuple$ (list =k =v))))))) fields)] - (in (wrap_meta (form$ (list (tag$ ["library/lux" "Record"]) (untemplated_list =fields))))))} + (in (with_location (form$ (list (tag$ ["library/lux" "Record"]) (untemplated_list =fields))))))} [replace? token])) (macro:' #export (primitive tokens) @@ -1910,10 +1912,10 @@ "(primitive ''java.lang.Object'')" __paragraph "(primitive ''java.util.List'' [(primitive ''java.lang.Long'')])"))]) ({(#Item [_ (#Text class_name)] #End) - (return (list (form$ (list (tag$ ["library/lux" "Primitive"]) (text$ class_name) (tag$ ["library/lux" "End"]))))) + (in_meta (list (form$ (list (tag$ ["library/lux" "Primitive"]) (text$ class_name) (tag$ ["library/lux" "End"]))))) (#Item [_ (#Text class_name)] (#Item [_ (#Tuple params)] #End)) - (return (list (form$ (list (tag$ ["library/lux" "Primitive"]) (text$ class_name) (untemplated_list params))))) + (in_meta (list (form$ (list (tag$ ["library/lux" "Primitive"]) (text$ class_name) (untemplated_list params))))) _ (failure "Wrong syntax for primitive")} @@ -1988,19 +1990,19 @@ "## =>" __paragraph "(fold text\compose '''' (interpose '' '' (list\map int\encode elems)))"))]) ({(#Item [init apps]) - (return (list (list\fold ("lux type check" (-> Code Code Code) - (function' [app acc] - ({[_ (#Tuple parts)] - (tuple$ (list\compose parts (list acc))) + (in_meta (list (list\fold ("lux type check" (-> Code Code Code) + (function' [app acc] + ({[_ (#Tuple parts)] + (tuple$ (list\compose parts (list acc))) - [_ (#Form parts)] - (form$ (list\compose parts (list acc))) + [_ (#Form parts)] + (form$ (list\compose parts (list acc))) - _ - (` ((~ app) (~ acc)))} - app))) - init - apps))) + _ + (` ((~ app) (~ acc)))} + app))) + init + apps))) _ (failure "Wrong syntax for |>")} @@ -2014,19 +2016,19 @@ "## =>" __paragraph "(fold text\compose '''' (interpose '' '' (list\map int\encode elems)))"))]) ({(#Item [init apps]) - (return (list (list\fold ("lux type check" (-> Code Code Code) - (function' [app acc] - ({[_ (#Tuple parts)] - (tuple$ (list\compose parts (list acc))) + (in_meta (list (list\fold ("lux type check" (-> Code Code Code) + (function' [app acc] + ({[_ (#Tuple parts)] + (tuple$ (list\compose parts (list acc))) - [_ (#Form parts)] - (form$ (list\compose parts (list acc))) + [_ (#Form parts)] + (form$ (list\compose parts (list acc))) - _ - (` ((~ app) (~ acc)))} - app))) - init - apps))) + _ + (` ((~ app) (~ acc)))} + app))) + init + apps))) _ (failure "Wrong syntax for <|")} @@ -2172,7 +2174,7 @@ (|> data' (list\map (compose apply (replacement_environment bindings'))) list\join - return) + in_meta) (failure "Irregular arguments tuples for template."))) _ @@ -2335,7 +2337,7 @@ (in [module_name name])) _ - (return name)} + (in_meta name)} name)) (def:''' (macro full_name) @@ -2388,11 +2390,11 @@ (("lux type as" Macro' macro) args) #None - (return (list token))} + (in_meta (list token))} ?macro)) _ - (return (list token))} + (in_meta (list token))} token)) (def:''' (expansion token) @@ -2409,11 +2411,11 @@ (in (list\join recursive_expansion))) #None - (return (list token))} + (in_meta (list token))} ?macro)) _ - (return (list token))} + (in_meta (list token))} token)) (def:''' (full_expansion syntax) @@ -2453,7 +2455,7 @@ (do meta_monad [val' (full_expansion val)] ({(#Item val'' #End) - (return [key val'']) + (in_meta [key val'']) _ (failure "The value-part of a KV-pair in a record must macro-expand to a single Code.")} @@ -2462,7 +2464,7 @@ (in (list (record$ pairs')))) _ - (return (list syntax))} + (in_meta (list syntax))} syntax)) (def:''' (normal_type type) @@ -2496,7 +2498,7 @@ (macro:' #export (type tokens) (list [(tag$ ["library/lux" "doc"]) (text$ ($_ "lux text concat" - "## Takes a type expression and returns it's representation as data-structure." __paragraph + "## Takes a type expression and returns its representation as data-structure." __paragraph "(type (All [a] (Maybe (List a))))"))]) ({(#Item type #End) (do meta_monad @@ -2518,7 +2520,7 @@ "## The type-annotation macro." __paragraph "(: (List Int) (list +1 +2 +3))"))]) ({(#Item type (#Item value #End)) - (return (list (` ("lux type check" (type (~ type)) (~ value))))) + (in_meta (list (` ("lux type check" (type (~ type)) (~ value))))) _ (failure "Wrong syntax for :")} @@ -2530,7 +2532,7 @@ "## The type-coercion macro." __paragraph "(:as Dinosaur (list +1 +2 +3))"))]) ({(#Item type (#Item value #End)) - (return (list (` ("lux type as" (type (~ type)) (~ value))))) + (in_meta (list (` ("lux type as" (type (~ type)) (~ value))))) _ (failure "Wrong syntax for :as")} @@ -2561,24 +2563,24 @@ (: (-> [Code Code] (Meta [Text Code])) (function' [pair] ({[[_ (#Tag "" member_name)] member_type] - (return [member_name member_type]) + (in_meta [member_name member_type]) _ (failure "Wrong syntax for variant case.")} pair))) pairs)] - (return [(` (Tuple (~+ (list\map second members)))) - (#Some (list\map first members))])) + (in_meta [(` (Tuple (~+ (list\map second members)))) + (#Some (list\map first members))])) (#Item type #End) ({[_ (#Tag "" member_name)] - (return [(` .Any) (#Some (list member_name))]) + (in_meta [(` .Any) (#Some (list member_name))]) [_ (#Form (#Item [_ (#Tag "" member_name)] member_types))] - (return [(` (Tuple (~+ member_types))) (#Some (list member_name))]) + (in_meta [(` (Tuple (~+ member_types))) (#Some (list member_name))]) _ - (return [type #None])} + (in_meta [type #None])} type) (#Item case cases) @@ -2587,20 +2589,20 @@ (: (-> Code (Meta [Text Code])) (function' [case] ({[_ (#Tag "" member_name)] - (return [member_name (` .Any)]) + (in_meta [member_name (` .Any)]) [_ (#Form (#Item [_ (#Tag "" member_name)] (#Item member_type #End)))] - (return [member_name member_type]) + (in_meta [member_name member_type]) [_ (#Form (#Item [_ (#Tag "" member_name)] member_types))] - (return [member_name (` (Tuple (~+ member_types)))]) + (in_meta [member_name (` (Tuple (~+ member_types)))]) _ (failure "Wrong syntax for variant case.")} case))) (list& case cases))] - (return [(` (..Variant (~+ (list\map second members)))) - (#Some (list\map first members))])) + (in_meta [(` (..Variant (~+ (list\map second members)))) + (#Some (list\map first members))])) _ (failure "Improper type-definition syntax")} @@ -2632,7 +2634,7 @@ (let' [body' (|> body nested_quantification (with_replacements (list [name (` (#.Apply (~ (type_parameter 1)) (~ (type_parameter 0))))])))] - (return (list (` (#.Apply .Nothing (#.UnivQ #.End (~ body'))))))) + (in_meta (list (` (#.Apply .Nothing (#.UnivQ #.End (~ body'))))))) _ (failure "Wrong syntax for Rec")} @@ -2649,11 +2651,11 @@ "''YOLO'')"))]) ({(#Item value actions) (let' [dummy (local_identifier$ "")] - (return (list (list\fold ("lux type check" (-> Code Code Code) - (function' [pre post] (` ({(~ dummy) (~ post)} - (~ pre))))) - value - actions)))) + (in_meta (list (list\fold ("lux type check" (-> Code Code Code) + (function' [pre post] (` ({(~ dummy) (~ post)} + (~ pre))))) + value + actions)))) _ (failure "Wrong syntax for exec")} @@ -2695,11 +2697,11 @@ #None body'} ?type)] - (return (list (` ("lux def" (~ name) - (~ body'') - [(~ location_code) - (#.Record #.End)] - (~ (bit$ export?))))))) + (in_meta (list (` ("lux def" (~ name) + (~ body'') + [(~ location_code) + (#.Record #.End)] + (~ (bit$ export?))))))) #None (failure "Wrong syntax for def'")} @@ -2864,7 +2866,7 @@ (let' [pairs (|> patterns (list\map (function' [pattern] (list pattern body))) (list\join))] - (return (list\compose pairs branches)))) + (in_meta (list\compose pairs branches)))) _ (failure "Wrong syntax for ^or"))) @@ -2897,7 +2899,7 @@ (` (case (~ r) (~ l) (~ body'))))))) body) list - return) + in_meta) (failure "let requires an even number of parts")) _ @@ -2929,8 +2931,8 @@ (` ([(~ g!name) (~ arg)] (~ body'))) (` ([(~ g!name) (~ g!blank)] (.case (~ g!blank) (~ arg) (~ body'))))))))] - (return (list (nest (..local_identifier$ g!name) head - (list\fold (nest g!blank) body (list\reverse tail)))))) + (in_meta (list (nest (..local_identifier$ g!name) head + (list\fold (nest g!blank) body (list\reverse tail)))))) #None (failure "Wrong syntax for function"))) @@ -3075,11 +3077,11 @@ #None body) =meta (definition_annotations meta)] - (return (list (` ("lux def" (~ name) - (~ body) - [(~ location_code) - (#.Record (~ (with_func_args args =meta)))] - (~ (bit$ exported?))))))) + (in_meta (list (` ("lux def" (~ name) + (~ body) + [(~ location_code) + (#.Record (~ (with_func_args args =meta)))] + (~ (bit$ exported?))))))) #None (failure "Wrong syntax for def:")))) @@ -3110,7 +3112,7 @@ " (case tokens" ..\n " (^template [<tag>]" ..\n " [(^ (list [_ (<tag> [prefix name])]))" ..\n - " (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))])" ..\n + " (in (list (` [(~ (text$ prefix)) (~ (text$ name))])))])" ..\n " ([#Identifier] [#Tag])" __paragraph " _" ..\n @@ -3143,11 +3145,11 @@ (` ("lux macro" (function ((~ name) (~+ args)) (~ body))))) =meta (definition_annotations meta)] - (return (list (` ("lux def" (~ name) - (~ body) - [(~ location_code) - (#Record (~ =meta))] - (~ (bit$ exported?))))))) + (in_meta (list (` ("lux def" (~ name) + (~ body) + [(~ location_code) + (#Record (~ =meta))] + (~ (bit$ exported?))))))) #None (failure "Wrong syntax for macro:")))) @@ -3199,13 +3201,13 @@ _ (failure "Signatures require typed members!")))) (list\join sigs'))) - #let [[_module _name] name+ + .let [[_module _name] name+ def_name (identifier$ name) sig_type (record$ (list\map (: (-> [Text Code] [Code Code]) - (function (_ [m_name m_type]) - [(local_tag$ m_name) m_type])) + (function (_ [module_name m_type]) + [(local_tag$ module_name) m_type])) members)) - sig_meta (merged_definition_annotations (` {#.sig? #1}) + sig_meta (merged_definition_annotations (` {#.interface? #1}) meta) usage (case args #End @@ -3213,7 +3215,7 @@ _ (` ((~ def_name) (~+ args))))]] - (return (list (` (..type: (~+ (export exported?)) (~ usage) (~ sig_meta) (~ sig_type)))))) + (in_meta (list (` (..type: (~+ (export exported?)) (~ usage) (~ sig_meta) (~ sig_type)))))) #None (failure "Wrong syntax for interface:")))) @@ -3233,15 +3235,15 @@ (#Some y) (#Some y)))) -(template [<name> <form> <message> <doc_msg>] +(template [<name> <form> <message> <documentation>] [(macro: #export (<name> tokens) - {#.doc <doc_msg>} + {#.doc <documentation>} (case (list\reverse tokens) (^ (list& last init)) - (return (list (list\fold (: (-> Code Code Code) - (function (_ pre post) (` <form>))) - last - init))) + (in_meta (list (list\fold (: (-> Code Code Code) + (function (_ pre post) (` <form>))) + last + init))) _ (failure <message>)))] @@ -3386,9 +3388,9 @@ _ (list type)))] - [flat_variant #Sum] - [flat_tuple #Product] - [flat_lambda #Function] + [flat_variant #Sum] + [flat_tuple #Product] + [flat_lambda #Function] ) (def: (flat_application type) @@ -3451,10 +3453,10 @@ (-> Name (Meta [Nat (List Name) Bit Type])) (do meta_monad [=module (..module module) - #let [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags_table #types types #module_annotations _ #module_state _} =module]] + .let [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags_table #types types #module_annotations _ #module_state _} =module]] (case (get name tags_table) (#Some output) - (return output) + (in_meta output) _ (failure (text\compose "Unknown tag: " (name\encode [module name])))))) @@ -3474,21 +3476,21 @@ (#Named [module name] unnamed) (do meta_monad [=module (..module module) - #let [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags #types types #module_annotations _ #module_state _} =module]] + .let [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags #types types #module_annotations _ #module_state _} =module]] (case (get name types) (#Some [tags exported? (#Named _ _type)]) (case (interface_methods _type) (#Some members) - (return (#Some [tags members])) + (in_meta (#Some [tags members])) _ - (return #None)) + (in_meta #None)) _ (record_slots unnamed))) _ - (return #None))) + (in_meta #None))) (def: get_expected_type (Meta Type) @@ -3513,11 +3515,11 @@ tags (: (Meta (List Name)) (case tags+type (#Some [tags _]) - (return tags) + (in_meta tags) _ (failure "No tags available for type."))) - #let [tag_mappings (: (List [Text Code]) + .let [tag_mappings (: (List [Text Code]) (list\map (function (_ tag) [(second tag) (tag$ tag)]) tags))] members (monad\map meta_monad @@ -3589,11 +3591,11 @@ _ (` ((~ name) (~+ args))))] - (return (list (` (..def: (~+ (export exported?)) (~ usage) - (~ (merged_definition_annotations (` {#.implementation? #1}) - meta)) - (~ type) - (implementation (~+ definitions))))))) + (in_meta (list (` (..def: (~+ (export exported?)) (~ usage) + (~ (merged_definition_annotations (` {#.implementation? #1}) + meta)) + (~ type) + (implementation (~+ definitions))))))) #None (failure "Wrong syntax for implementation:")))) @@ -3669,20 +3671,20 @@ (let [typeC (` (#.Named [(~ (text$ module_name)) (~ (text$ name))] (.type (~ type''))))] - (return (list (case tags?? - (#Some tags) - (` ("lux def type tagged" (~ type_name) - (~ typeC) - (~ total_meta) - [(~+ (list\map text$ tags))] - (~ (bit$ exported?)))) - - _ - (` ("lux def" (~ type_name) - ("lux type check type" - (~ typeC)) - (~ total_meta) - (~ (bit$ exported?)))))))) + (in_meta (list (case tags?? + (#Some tags) + (` ("lux def type tagged" (~ type_name) + (~ typeC) + (~ total_meta) + [(~+ (list\map text$ tags))] + (~ (bit$ exported?)))) + + _ + (` ("lux def" (~ type_name) + ("lux type check type" + (~ typeC)) + (~ total_meta) + (~ (bit$ exported?)))))))) #None (failure "Wrong syntax for type:")))) @@ -3728,7 +3730,7 @@ (function (_ def) (case def [_ (#Identifier ["" name])] - (return name) + (in_meta name) _ (failure "#only/#+ and #exclude/#- require identifiers.")))) @@ -3751,20 +3753,20 @@ (^or (^ (list& [_ (#Tag ["" "*"])] tokens')) (^ (list& [_ (#Tag ["" "all"])] tokens'))) - (return [#All tokens']) + (in_meta [#All tokens']) (^or (^ (list& [_ (#Tag ["" "_"])] tokens')) (^ (list& [_ (#Tag ["" "nothing"])] tokens'))) - (return [#Ignore tokens']) + (in_meta [#Ignore tokens']) _ - (return [#Nothing tokens]))) + (in_meta [#Nothing tokens]))) (def: (openings_parser parts) (-> (List Code) (Meta [(List Openings) (List Code)])) (case parts #.End - (return [#.End #.End]) + (in_meta [#.End #.End]) (^ (list& [_ (#Form (list& [_ (#Text prefix)] structs))] parts')) (do meta_monad @@ -3772,18 +3774,18 @@ (function (_ struct) (case struct [_ (#Identifier ["" struct_name])] - (return struct_name) + (in_meta struct_name) _ (failure "Expected all implementations of opening form to be identifiers."))) structs) next+remainder (openings_parser parts')] (let [[next remainder] next+remainder] - (return [(#.Item [prefix structs'] next) - remainder]))) + (in_meta [(#.Item [prefix structs'] next) + remainder]))) _ - (return [#.End parts]))) + (in_meta [#.End parts]))) (def: (text\split! at x) (-> Nat Text [Text Text]) @@ -3794,7 +3796,7 @@ (-> Text Text (Maybe [Text Text])) (do ..maybe_monad [index (..index token sample) - #let [[pre post'] (text\split! index sample) + .let [[pre post'] (text\split! index sample) [_ post] (text\split! ("lux text size" token) post')]] (in [pre post]))) @@ -3876,13 +3878,13 @@ [_ (#Item _ tail)] (list\drop ("lux i64 -" 1 amount) tail))) -(def: (clean_module nested? relative_root module) +(def: (absolute_module_name nested? relative_root module) (-> Bit Text Text (Meta Text)) (case (count_relatives 0 module) 0 - (return (if nested? - ($_ "lux text concat" relative_root ..module_separator module) - module)) + (in_meta (if nested? + ($_ "lux text concat" relative_root ..module_separator module) + module)) relatives (let [parts (text\split_all_with ..module_separator relative_root) @@ -3898,27 +3900,12 @@ output (case ("lux text size" clean) 0 prefix _ ($_ text\compose prefix ..module_separator clean))] - (return output)) + (in_meta output)) (failure ($_ "lux text concat" "Cannot climb the module hierarchy..." ..\n "Importing module: " module ..\n " Relative Root: " relative_root ..\n)))))) -(def: (alter_domain alteration domain import) - (-> Nat Text Importation Importation) - (let [[import_name import_alias import_refer] import - original (text\split_all_with ..module_separator import_name) - truncated (list\drop (.nat alteration) original) - parallel (case domain - "" - truncated - - _ - (list& domain truncated))] - {#import_name (text\join_with ..module_separator parallel) - #import_alias import_alias - #import_refer import_refer})) - (def: (imports_parser nested? relative_root context_alias imports) (-> Bit Text Text (List Code) (Meta (List Importation))) (do meta_monad @@ -3927,59 +3914,59 @@ (function (_ token) (case token ## Simple - [_ (#Identifier ["" m_name])] + [_ (#Identifier ["" module_name])] (do meta_monad - [m_name (clean_module nested? relative_root m_name)] - (in (list {#import_name m_name + [absolute_module_name (..absolute_module_name nested? relative_root module_name)] + (in (list {#import_name absolute_module_name #import_alias #None #import_refer {#refer_defs #All #refer_open (list)}}))) ## Nested - (^ [_ (#Tuple (list& [_ (#Identifier ["" m_name])] extra))]) + (^ [_ (#Tuple (list& [_ (#Identifier ["" module_name])] extra))]) (do meta_monad - [import_name (case (normal_parallel_path relative_root m_name) - (#.Some parallel_path) - (in parallel_path) + [absolute_module_name (case (normal_parallel_path relative_root module_name) + (#.Some parallel_path) + (in parallel_path) - #.None - (clean_module nested? relative_root m_name)) + #.None + (..absolute_module_name nested? relative_root module_name)) referral+extra (referrals_parser extra) - #let [[referral extra] referral+extra] + .let [[referral extra] referral+extra] openings+extra (openings_parser extra) - #let [[openings extra] openings+extra] - sub_imports (imports_parser #1 import_name context_alias extra)] + .let [[openings extra] openings+extra] + sub_imports (imports_parser #1 absolute_module_name context_alias extra)] (in (case [referral openings] [#Nothing #End] sub_imports _ - (list& {#import_name import_name + (list& {#import_name absolute_module_name #import_alias #None #import_refer {#refer_defs referral #refer_open openings}} sub_imports)))) - (^ [_ (#Tuple (list& [_ (#Text alias)] [_ (#Identifier ["" m_name])] extra))]) + (^ [_ (#Tuple (list& [_ (#Text alias)] [_ (#Identifier ["" module_name])] extra))]) (do meta_monad - [import_name (case (normal_parallel_path relative_root m_name) - (#.Some parallel_path) - (in parallel_path) + [absolute_module_name (case (normal_parallel_path relative_root module_name) + (#.Some parallel_path) + (in parallel_path) - #.None - (clean_module nested? relative_root m_name)) + #.None + (..absolute_module_name nested? relative_root module_name)) referral+extra (referrals_parser extra) - #let [[referral extra] referral+extra] + .let [[referral extra] referral+extra] openings+extra (openings_parser extra) - #let [[openings extra] openings+extra - module_alias (..module_alias context_alias m_name alias)] - sub_imports (imports_parser #1 import_name module_alias extra)] + .let [[openings extra] openings+extra + module_alias (..module_alias context_alias module_name alias)] + sub_imports (imports_parser #1 absolute_module_name module_alias extra)] (in (case [referral openings] [#Ignore #End] sub_imports _ - (list& {#import_name import_name + (list& {#import_name absolute_module_name #import_alias (#Some module_alias) #import_refer {#refer_defs referral #refer_open openings}} @@ -4148,7 +4135,7 @@ (def: (type_definition full_name) (-> Name (Meta Type)) (do meta_monad - [#let [[module name] full_name] + [.let [[module name] full_name] current_module current_module_name] (function (_ compiler) (let [temp (if (text\= "" module) @@ -4310,12 +4297,12 @@ (failure "cond requires an uneven number of arguments.") (case (list\reverse tokens) (^ (list& else branches')) - (return (list (list\fold (: (-> [Code Code] Code Code) - (function (_ branch else) - (let [[right left] branch] - (` (if (~ left) (~ right) (~ else)))))) - else - (pairs branches')))) + (in_meta (list (list\fold (: (-> [Code Code] Code Code) + (function (_ branch else) + (let [[right left] branch] + (` (if (~ left) (~ right) (~ else)))))) + else + (pairs branches')))) _ (failure "Wrong syntax for cond")))) @@ -4349,7 +4336,7 @@ (do meta_monad [slot (normal slot') output (..type_tag slot) - #let [[idx tags exported? type] output] + .let [[idx tags exported? type] output] g!_ (gensym "_") g!output (gensym "")] (case (interface_methods type) @@ -4361,17 +4348,17 @@ g!output g!_)])) (zipped/2 tags (enumeration members))))] - (return (list (` ({(~ pattern) (~ g!output)} (~ record)))))) + (in_meta (list (` ({(~ pattern) (~ g!output)} (~ record)))))) _ (failure "get@ can only use records."))) (^ (list [_ (#Tuple slots)] record)) - (return (list (list\fold (: (-> Code Code Code) - (function (_ slot inner) - (` (..get@ (~ slot) (~ inner))))) - record - slots))) + (in_meta (list (list\fold (: (-> Code Code Code) + (function (_ slot inner) + (` (..get@ (~ slot) (~ inner))))) + record + slots))) (^ (list selector)) (do meta_monad @@ -4387,7 +4374,7 @@ (do meta_monad [output (record_slots type) g!_ (gensym "g!_") - #let [g!output (local_identifier$ short) + .let [g!output (local_identifier$ short) pattern (|> tags enumeration (list\map (function (_ [tag_idx tag]) @@ -4404,13 +4391,13 @@ (function (_ [sub_tag_index sname stype]) (open_declaration alias tags' sub_tag_index sname source+ stype))) (enumeration (zipped/2 tags' members')))] - (return (list\join decls'))) + (in_meta (list\join decls'))) _ - (return (list (` ("lux def" (~ (local_identifier$ (..module_alias "" short alias))) - (~ source+) - [(~ location_code) (#.Record #End)] - #0))))))) + (in_meta (list (` ("lux def" (~ (local_identifier$ (..module_alias "" short alias))) + (~ source+) + [(~ location_code) (#.Record #End)] + #0))))))) (macro: #export (open: tokens) {#.doc (text$ ($_ "lux text concat" @@ -4431,7 +4418,7 @@ (do meta_monad [struct_type (type_definition struct_name) output (record_slots struct_type) - #let [source (identifier$ struct_name)]] + .let [source (identifier$ struct_name)]] (case output (#Some [tags members]) (do meta_monad @@ -4439,7 +4426,7 @@ (function (_ [tag_index sname stype]) (open_declaration alias tags tag_index sname source stype))) (enumeration (zipped/2 tags members)))] - (return (list\join decls'))) + (in_meta (list\join decls'))) _ (failure (text\compose "Can only 'open:' structs: " (type\encode struct_type))))) @@ -4447,10 +4434,10 @@ _ (do meta_monad [g!struct (gensym "struct")] - (return (list (` ("lux def" (~ g!struct) (~ struct) - [(~ location_code) (#.Record #End)] - #0)) - (` (..open: (~ (text$ alias)) (~ g!struct))))))) + (in_meta (list (` ("lux def" (~ g!struct) (~ struct) + [(~ location_code) (#.Record #End)] + #0)) + (` (..open: (~ (text$ alias)) (~ g!struct))))))) _ (failure "Wrong syntax for open:"))) @@ -4464,7 +4451,7 @@ (do meta_monad [g!_ (gensym "_") g!arg (gensym "arg")] - (return (list (` (function ((~ g!_) (~ g!arg)) (|> (~ g!arg) (~+ tokens)))))))) + (in_meta (list (` (function ((~ g!_) (~ g!arg)) (|> (~ g!arg) (~+ tokens)))))))) (macro: #export (<<| tokens) {#.doc (text$ ($_ "lux text concat" @@ -4475,22 +4462,22 @@ (do meta_monad [g!_ (gensym "_") g!arg (gensym "arg")] - (return (list (` (function ((~ g!_) (~ g!arg)) (<| (~+ tokens) (~ g!arg)))))))) + (in_meta (list (` (function ((~ g!_) (~ g!arg)) (<| (~+ tokens) (~ g!arg)))))))) (def: (imported_by? import_name module_name) (-> Text Text (Meta Bit)) (do meta_monad [module (module module_name) - #let [{#module_hash _ #module_aliases _ #definitions _ #imports imports #tags _ #types _ #module_annotations _ #module_state _} module]] + .let [{#module_hash _ #module_aliases _ #definitions _ #imports imports #tags _ #types _ #module_annotations _ #module_state _} module]] (in (is_member? imports import_name)))) (def: (referrals module_name options) (-> Text (List Code) (Meta Refer)) (do meta_monad [referral+options (referrals_parser options) - #let [[referral options] referral+options] + .let [[referral options] referral+options] openings+options (openings_parser options) - #let [[openings options] openings+options] + .let [[openings options] openings+options] current_module current_module_name] (case options #End @@ -4508,13 +4495,13 @@ (-> Text Refer (Meta (List Code))) (do meta_monad [current_module current_module_name - #let [test_referrals (: (-> Text (List Text) (List Text) (Meta (List Any))) + .let [test_referrals (: (-> Text (List Text) (List Text) (Meta (List Any))) (function (_ module_name all_defs referred_defs) (monad\map meta_monad (: (-> Text (Meta Any)) (function (_ _def) (if (is_member? all_defs _def) - (return []) + (in_meta []) (failure ($_ text\compose _def " is not defined in module " module_name " @ " current_module))))) referred_defs)))] defs' (case r_defs @@ -4538,7 +4525,7 @@ #Nothing (in (list))) - #let [defs (list\map (: (-> Text Code) + .let [defs (list\map (: (-> Text Code) (function (_ def) (` ("lux def alias" (~ (local_identifier$ def)) (~ (identifier$ [module_name def])))))) defs') @@ -4607,7 +4594,7 @@ " [//" ..\n " [type (''.'' equivalence)]])"))} (do meta_monad - [#let [[_meta _imports] (: [(List [Code Code]) (List Code)] + [.let [[_meta _imports] (: [(List [Code Code]) (List Code)] (case tokens (^ (list& [_ (#Record _meta)] _imports)) [_meta _imports] @@ -4616,14 +4603,14 @@ [(list) tokens]))] current_module current_module_name imports (imports_parser #0 current_module "" _imports) - #let [=imports (|> imports + .let [=imports (|> imports (list\map (: (-> Importation Code) - (function (_ [m_name m_alias =refer]) - (` [(~ (text$ m_name)) (~ (text$ (..else "" m_alias)))])))) + (function (_ [module_name m_alias =refer]) + (` [(~ (text$ module_name)) (~ (text$ (..else "" m_alias)))])))) tuple$) =refers (list\map (: (-> Importation Code) - (function (_ [m_name m_alias =refer]) - (refer_code m_name m_alias =refer))) + (function (_ [module_name m_alias =refer]) + (refer_code module_name m_alias =refer))) imports) =module (` ("lux def module" [(~ location_code) (#.Record (~ (definition_annotations _meta)))] @@ -4639,10 +4626,10 @@ "(\ codec encode +123)"))} (case tokens (^ (list struct [_ (#Identifier member)])) - (return (list (` (let [(^open (~ (text$ ..self_reference))) (~ struct)] (~ (identifier$ member)))))) + (in_meta (list (` (let [(^open (~ (text$ ..self_reference))) (~ struct)] (~ (identifier$ member)))))) (^ (list& struct member args)) - (return (list (` ((..\ (~ struct) (~ member)) (~+ args))))) + (in_meta (list (` ((..\ (~ struct) (~ member)) (~+ args))))) _ (failure "Wrong syntax for \"))) @@ -4663,7 +4650,7 @@ (do meta_monad [slot (normal slot') output (..type_tag slot) - #let [[idx tags exported? type] output]] + .let [[idx tags exported? type] output]] (case (interface_methods type) (#Some members) (do meta_monad @@ -4672,7 +4659,7 @@ (function (_ [r_slot_name [r_idx r_type]]) (do meta_monad [g!slot (gensym "")] - (return [r_slot_name r_idx g!slot])))) + (in_meta [r_slot_name r_idx g!slot])))) (zipped/2 tags (enumeration members)))] (let [pattern (record$ (list\map (: (-> [Name Nat Code] [Code Code]) (function (_ [r_slot_name r_idx r_var]) @@ -4686,7 +4673,7 @@ value r_var)])) pattern'))] - (return (list (` ({(~ pattern) (~ output)} (~ record))))))) + (in_meta (list (` ({(~ pattern) (~ output)} (~ record))))))) _ (failure "set@ can only use records."))) @@ -4702,7 +4689,7 @@ (: (-> Code (Meta Code)) (function (_ _) (gensym "temp"))) slots) - #let [pairs (zipped/2 slots bindings) + .let [pairs (zipped/2 slots bindings) update_expr (list\fold (: (-> [Code Code] Code Code) (function (_ [s b] v) (` (..set@ (~ s) (~ v) (~ b))))) @@ -4752,7 +4739,7 @@ (do meta_monad [slot (normal slot') output (..type_tag slot) - #let [[idx tags exported? type] output]] + .let [[idx tags exported? type] output]] (case (interface_methods type) (#Some members) (do meta_monad @@ -4761,7 +4748,7 @@ (function (_ [r_slot_name [r_idx r_type]]) (do meta_monad [g!slot (gensym "")] - (return [r_slot_name r_idx g!slot])))) + (in_meta [r_slot_name r_idx g!slot])))) (zipped/2 tags (enumeration members)))] (let [pattern (record$ (list\map (: (-> [Name Nat Code] [Code Code]) (function (_ [r_slot_name r_idx r_var]) @@ -4775,7 +4762,7 @@ (` ((~ fun) (~ r_var))) r_var)])) pattern'))] - (return (list (` ({(~ pattern) (~ output)} (~ record))))))) + (in_meta (list (` ({(~ pattern) (~ output)} (~ record))))))) _ (failure "update@ can only use records."))) @@ -4866,7 +4853,7 @@ in)) #None)))) (#Some output) - (return (list\compose output branches)) + (in_meta (list\compose output branches)) #None (failure "Wrong syntax for ^template")) @@ -4901,18 +4888,18 @@ (list\map (|>> second baseline_column) pairs))) )) -(type: Doc_Fragment - (#Doc_Comment Text) - (#Doc_Example Code)) +(type: Documentation_Fragment + (#Documentation_Comment Text) + (#Documentation_Example Code)) -(def: (identify_doc_fragment code) - (-> Code Doc_Fragment) +(def: (documentation_fragment code) + (-> Code Documentation_Fragment) (case code [_ (#Text comment)] - (#Doc_Comment comment) + (#Documentation_Comment comment) _ - (#Doc_Example code))) + (#Documentation_Example code))) (template [<name> <extension> <doc>] [(def: #export <name> @@ -4963,7 +4950,7 @@ (|>> (list\map pair_list) list\join))) -(def: (doc_example_to_text prev_location baseline example) +(def: (example_documentation prev_location baseline example) (-> Location Nat Code [Location Text]) (case example (^template [<tag> <encode>] @@ -4983,7 +4970,7 @@ (^template [<tag> <open> <close> <prep>] [[group_location (<tag> parts)] (let [[group_location' parts_text] (list\fold (function (_ part [last_location text_accum]) - (let [[part_location part_text] (doc_example_to_text last_location baseline part)] + (let [[part_location part_text] (example_documentation last_location baseline part)] [part_location (text\compose text_accum part_text)])) [(delim_update_location group_location) ""] (<prep> parts))] @@ -4997,26 +4984,26 @@ [#Record "{" "}" ..un_paired]) [new_location (#Rev value)] - ("lux io error" "@doc_example_to_text Undefined behavior.") + ("lux io error" "@example_documentation Undefined behavior.") )) (def: (with_baseline baseline [file line column]) (-> Nat Location Location) [file line baseline]) -(def: (doc_fragment_to_text fragment) - (-> Doc_Fragment Text) +(def: (fragment_documentation fragment) + (-> Documentation_Fragment Text) (case fragment - (#Doc_Comment comment) + (#Documentation_Comment comment) (|> comment (text\split_all_with ..\n) (list\map (function (_ line) ($_ text\compose "## " line ..\n))) (text\join_with "")) - (#Doc_Example example) + (#Documentation_Example example) (let [baseline (baseline_column example) [location _] example - [_ text] (doc_example_to_text (with_baseline baseline location) baseline example)] + [_ text] (..example_documentation (with_baseline baseline location) baseline example)] (text\compose text __paragraph)))) (macro: #export (doc tokens) @@ -5031,13 +5018,13 @@ " (if (< +10 count)" ..\n " (recur (inc count) (f x))" ..\n " x)))"))} - (return (list (` [(~ location_code) - (#.Text (~ (|> tokens - (list\map (|>> identify_doc_fragment doc_fragment_to_text)) - (text\join_with "") - text$)))])))) + (in_meta (list (` [(~ location_code) + (#.Text (~ (|> tokens + (list\map (|>> ..documentation_fragment ..fragment_documentation)) + (text\join_with "") + text$)))])))) -(def: (interleave xs ys) +(def: (interleaved xs ys) (All [a] (-> (List a) (List a) (List a))) (case xs #End @@ -5049,7 +5036,7 @@ #End (#Item y ys') - (list& x y (interleave xs' ys'))))) + (list& x y (interleaved xs' ys'))))) (def: (type_code type) (-> Type Code) @@ -5116,25 +5103,25 @@ (do meta_monad [inits' (: (Meta (List Name)) (case (monad\map maybe_monad get_name inits) - (#Some inits') (return inits') + (#Some inits') (in_meta inits') #None (failure "Wrong syntax for loop"))) init_types (monad\map meta_monad type_definition inits') expected get_expected_type] - (return (list (` (("lux type check" - (-> (~+ (list\map type_code init_types)) - (~ (type_code expected))) - (function ((~ name) (~+ vars)) - (~ body))) - (~+ inits)))))) + (in_meta (list (` (("lux type check" + (-> (~+ (list\map type_code init_types)) + (~ (type_code expected))) + (function ((~ name) (~+ vars)) + (~ body))) + (~+ inits)))))) (do meta_monad [aliases (monad\map meta_monad (: (-> Code (Meta Code)) (function (_ _) (gensym ""))) inits)] - (return (list (` (let [(~+ (interleave aliases inits))] - (.loop (~ name) - [(~+ (interleave vars aliases))] - (~ body))))))))) + (in_meta (list (` (let [(~+ (..interleaved aliases inits))] + (.loop (~ name) + [(~+ (..interleaved vars aliases))] + (~ body))))))))) #.None (failure "Wrong syntax for loop")))) @@ -5154,16 +5141,16 @@ tslots (monad\map maybe_monad get_tag tslots')] (in [hslot tslots]))) (#Some slots) - (return slots) + (in_meta slots) #None (failure "Wrong syntax for ^slots"))) - #let [[hslot tslots] slots] + .let [[hslot tslots] slots] hslot (..normal hslot) tslots (monad\map meta_monad ..normal tslots) output (..type_tag hslot) g!_ (gensym "_") - #let [[idx tags exported? type] output + .let [[idx tags exported? type] output slot_pairings (list\map (: (-> Name [Text Code]) (function (_ [module name]) [name (local_identifier$ name)])) @@ -5175,7 +5162,7 @@ (#Some binding) [tag binding] #None [tag g!_])))) tags))]] - (return (list& pattern body branches))) + (in_meta (list& pattern body branches))) _ (failure "Wrong syntax for ^slots"))) @@ -5254,7 +5241,7 @@ (failure "[with_expansions] Improper macro expansion."))) #End - (return bodies) + (in_meta bodies) _ (failure "Wrong syntax for with_expansions")) @@ -5281,11 +5268,11 @@ _ type)) -(def: (anti_quote_def name) +(def: (static_simple_literal name) (-> Name (Meta Code)) (do meta_monad [type+value (definition_value name) - #let [[type value] type+value]] + .let [[type value] type+value]] (case (flat_alias type) (^template [<name> <type> <wrapper>] [(#Named ["library/lux" <name>] _) @@ -5300,20 +5287,20 @@ _ (failure (text\compose "Cannot anti-quote type: " (name\encode name)))))) -(def: (anti_quote token) +(def: (static_literal token) (-> Code (Meta Code)) (case token [_ (#Identifier [def_prefix def_name])] (if (text\= "" def_prefix) (do meta_monad [current_module current_module_name] - (anti_quote_def [current_module def_name])) - (anti_quote_def [def_prefix def_name])) + (static_simple_literal [current_module def_name])) + (static_simple_literal [def_prefix def_name])) (^template [<tag>] [[meta (<tag> parts)] (do meta_monad - [=parts (monad\map meta_monad anti_quote parts)] + [=parts (monad\map meta_monad static_literal parts)] (in [meta (<tag> =parts)]))]) ([#Form] [#Tuple]) @@ -5324,13 +5311,13 @@ (: (-> [Code Code] (Meta [Code Code])) (function (_ [slot value]) (do meta_monad - [=value (anti_quote value)] + [=value (static_literal value)] (in [slot =value])))) pairs)] (in [meta (#Record =pairs)])) _ - (\ meta_monad return token) + (\ meta_monad in_meta token) ## TODO: Figure out why this doesn't work: ## (\ meta_monad in token) )) @@ -5339,7 +5326,7 @@ (case tokens (^ (list pattern)) (do meta_monad - [pattern' (anti_quote pattern)] + [pattern' (static_literal pattern)] (in (list pattern'))) _ @@ -5352,10 +5339,10 @@ (-> Code (Meta [Code Code])) (case level (^ [_ (#Record (list [expr binding]))]) - (return [expr binding]) + (in_meta [expr binding]) _ - (return [level (` #1)]) + (in_meta [level (` #1)]) )) (def: (multi_level_case^ levels) @@ -5414,7 +5401,7 @@ (^ (list& [_meta (#Form levels)] body next_branches)) (do meta_monad [mlc (multi_level_case^ levels) - #let [initial_bind? (case mlc + .let [initial_bind? (case mlc [[_ (#.Identifier _)] _] #1 @@ -5457,7 +5444,7 @@ (case tokens (^template [<tag>] [(^ (list [_ (<tag> [prefix name])])) - (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))]) + (in_meta (list (` [(~ (text$ prefix)) (~ (text$ name))])))]) ([#Identifier] [#Tag]) _ @@ -5516,9 +5503,9 @@ (case tokens (^ (list& [_meta (#Form (list [_ (#Identifier ["" name])] pattern))] body branches)) (let [g!whole (local_identifier$ name)] - (return (list& g!whole - (` (case (~ g!whole) (~ pattern) (~ body))) - branches))) + (in_meta (list& g!whole + (` (case (~ g!whole) (~ pattern) (~ body))) + branches))) _ (failure (..wrong_syntax_error (name_of ..^@))))) @@ -5531,10 +5518,10 @@ (case tokens (^ (list& [_meta (#Form (list [_ (#Identifier ["" name])] [_ (#Tuple steps)]))] body branches)) (let [g!name (local_identifier$ name)] - (return (list& g!name - (` (let [(~ g!name) (|> (~ g!name) (~+ steps))] - (~ body))) - branches))) + (in_meta (list& g!name + (` (let [(~ g!name) (|> (~ g!name) (~+ steps))] + (~ body))) + branches))) _ (failure (..wrong_syntax_error (name_of ..^|>))))) @@ -5568,7 +5555,7 @@ #End (do meta_monad [location ..location - #let [[module line column] location + .let [[module line column] location location ($_ "lux text concat" (text\encode module) "," (nat\encode line) "," (nat\encode column)) message ($_ "lux text concat" "Undefined behavior @ " location)]] (in (list (` (..error! (~ (text$ message))))))) @@ -5627,7 +5614,7 @@ (-> (List Code) (Meta [Code (List Code)])) (case tokens (^ (list& token tokens')) - (return [token tokens']) + (in_meta [token tokens']) _ (failure "Could not parse anything.") @@ -5637,7 +5624,7 @@ (-> (List Code) (Meta [(List Code) (List Code)])) (case tokens (^ (list& head tail)) - (return [tokens (list)]) + (in_meta [tokens (list)]) _ (failure "Could not parse anything.") @@ -5647,7 +5634,7 @@ (-> (List Code) (Meta Any)) (case tokens (^ (list)) - (return []) + (in_meta []) _ (failure "Expected input Codes to be empty.") @@ -5657,10 +5644,10 @@ (-> (List Code) (Meta [Code (List Code)])) (case tokens (^ (list& [_ (#Record _anns)] tokens')) - (return [(record$ _anns) tokens']) + (in_meta [(record$ _anns) tokens']) _ - (return [(' {}) tokens]) + (in_meta [(' {}) tokens]) )) (macro: #export (template: tokens) @@ -5669,18 +5656,18 @@ (template: (square x) (* x x)))} (do meta_monad - [#let [[export? tokens] (export^ tokens)] + [.let [[export? tokens] (export^ tokens)] name+args|tokens (complex_declaration_parser tokens) - #let [[[name args] tokens] name+args|tokens] + .let [[[name args] tokens] name+args|tokens] anns|tokens (anns_parser tokens) - #let [[anns tokens] anns|tokens] + .let [[anns tokens] anns|tokens] input_templates|tokens (many_parser tokens) - #let [[input_templates tokens] input_templates|tokens] + .let [[input_templates tokens] input_templates|tokens] _ (end_parser tokens) g!tokens (gensym "tokens") g!compiler (gensym "compiler") g!_ (gensym "_") - #let [rep_env (list\map (function (_ arg) + .let [rep_env (list\map (function (_ arg) [arg (` ((~' ~) (~ (local_identifier$ arg))))]) args)] this_module current_module_name] @@ -5723,13 +5710,13 @@ (-> Code (Meta Text)) (case choice [_ (#Text platform)] - (..return platform) + (..in_meta platform) [_ (#Identifier identifier)] (do meta_monad [identifier (..global_identifier identifier) type+value (..definition_value identifier) - #let [[type value] type+value]] + .let [[type value] type+value]] (case (..flat_alias type) (^or (#Primitive "#Text" #End) (#Named ["library/lux" "Text"] (#Primitive "#Text" #End))) @@ -5754,13 +5741,13 @@ (failure ($_ text\compose "No code for target platform: " target)) (#.Some default) - (return (list default))) + (in_meta (list default))) (#Item [key pick] options') (do meta_monad [platform (..platform_name key)] (if (text\= target platform) - (return (list pick)) + (in_meta (list pick)) (target_pick target options' default))))) (macro: #export (for tokens) @@ -5776,14 +5763,13 @@ _ (failure (..wrong_syntax_error (name_of ..for)))))) -(template [<name> <type> <output>] - [(def: (<name> xy) - (All [a b] (-> [a b] <type>)) - (let [[x y] xy] - <output>))] +(template [<name>] + [(def: (<name> [left right]) + (All [left right] (-> [left right] <name>)) + <name>)] - [left a x] - [right b y]) + [left] + [right]) (def: (embedded_expansions code) (-> Code (Meta [(List [Code Code]) Code])) @@ -5808,7 +5794,7 @@ (do meta_monad [=key (embedded_expansions key) =val (embedded_expansions val) - #let [[key_labels key_labelled] =key + .let [[key_labels key_labelled] =key [val_labels val_labelled] =val]] (in [(list\compose key_labels val_labels) [key_labelled val_labelled]]))) kvs)] @@ -5816,22 +5802,21 @@ [ann (#Record (list\map right =kvs))]])) _ - (return [(list) code]))) + (in_meta [(list) code]))) (macro: #export (`` tokens) (case tokens (^ (list raw)) (do meta_monad [=raw (..embedded_expansions raw) - #let [[labels labelled] =raw]] + .let [[labels labelled] =raw]] (in (list (` (with_expansions [(~+ (|> labels (list\map (function (_ [label expansion]) (list label expansion))) list\join))] (~ labelled)))))) _ - (failure (..wrong_syntax_error (name_of ..``))) - )) + (failure (..wrong_syntax_error (name_of ..``))))) (def: (name$ [module name]) (-> Name Code) @@ -5897,7 +5882,7 @@ [#.Identifier name$]) [_ (#Form (#Item [[_ (#Identifier ["" "~"])] (#Item [unquoted #End])]))] - (return unquoted) + (in_meta unquoted) [_ (#Form (#Item [[_ (#Identifier ["" "~+"])] (#Item [spliced #End])]))] (failure "Cannot use (~+) inside of ^code unless it is the last element in a form or a tuple.") @@ -5939,12 +5924,12 @@ (case tokens (^ (list [_ (#Tuple bindings)] bodyT)) (if (multiple? 2 (list\size bindings)) - (return (list (` (..with_expansions [(~+ (|> bindings - ..pairs - (list\map (function (_ [localT valueT]) - (list localT (` (..as_is (~ valueT)))))) - (list\fold list\compose (list))))] - (~ bodyT))))) + (in_meta (list (` (..with_expansions [(~+ (|> bindings + ..pairs + (list\map (function (_ [localT valueT]) + (list localT (` (..as_is (~ valueT)))))) + (list\fold list\compose (list))))] + (~ bodyT))))) (..failure ":let requires an even number of parts")) _ |