diff options
| author | Eduardo Julian | 2019-03-27 23:26:22 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2019-03-27 23:26:22 -0400 |
| commit | 023b761c13744ccfe65090b0f4e10640093faa03 (patch) | |
| tree | 30709a91846a271c3e9e1ecfb4ca61c4a0003b8f | |
| parent | 8df108600f6791237d0079af6b582e6cb306906d (diff) | |
The Python compiler is alive.
Diffstat (limited to '')
10 files changed, 560 insertions, 458 deletions
diff --git a/lux-python/source/program.lux b/lux-python/source/program.lux index 21dac4f04..5baf9db04 100644 --- a/lux-python/source/program.lux +++ b/lux-python/source/program.lux @@ -3,6 +3,7 @@ [cli (#+ program:)] ["." io (#+ IO io)] [control + pipe [monad (#+ do)] ["." exception (#+ exception:)]] [data @@ -24,6 +25,7 @@ [tool [compiler ["." name] + ["." synthesis] [phase [macro (#+ Expander)] ["." generation @@ -38,8 +40,13 @@ (import: #long java/lang/String) +(import: #long (java/lang/Class a) + (getCanonicalName [] java/lang/String)) + (import: #long java/lang/Object - (toString [] java/lang/String)) + (new []) + (toString [] java/lang/String) + (getClass [] (java/lang/Class java/lang/Object))) (import: #long java/lang/Integer (longValue [] java/lang/Long)) @@ -101,10 +108,19 @@ (import: #long org/python/core/PyType (getName [] java/lang/String)) +(import: #long org/python/core/PyNone) +(import: #long org/python/core/PyBoolean) +(import: #long org/python/core/PyInteger) +(import: #long org/python/core/PyLong) +(import: #long org/python/core/PyFloat) +(import: #long org/python/core/PyTuple) +(import: #long org/python/core/PyList) + (import: #long org/python/core/PyString (new [java/lang/String])) (import: #long org/python/core/PyObject + (asInt [] java/lang/Integer) (asLong [] long) (asDouble [] double) (asString [] java/lang/String) @@ -114,6 +130,13 @@ (__len__ [] int) (getType [] org/python/core/PyType)) +(import: #long org/python/core/PyFunction + (__call__ [(Array org/python/core/PyObject)] org/python/core/PyObject)) + +(import: #long org/python/core/PyArray + (new [(java/lang/Class java/lang/Object) java/lang/Object]) + (getArray [] java/lang/Object)) + (import: #long org/python/util/PythonInterpreter (new []) (exec [String] #try void) @@ -122,7 +145,7 @@ (type: Translator (-> org/python/core/PyObject (Error Any))) -(def: (tuple lux-object host-object) +(def: (read-tuple read host-object) (-> Translator Translator) (let [size (|> host-object org/python/core/PyObject::__len__ .nat)] (loop [idx 0 @@ -133,7 +156,7 @@ (#error.Failure error) (#error.Success value) - (case (lux-object value) + (case (read value) (#error.Failure error) (#error.Failure error) @@ -149,66 +172,109 @@ (exception.report ["Object" (java/lang/Object::toString object)])) -(def: tag-field (org/python/core/PyString::new runtime.variant-tag-field)) -(def: flag-field (org/python/core/PyString::new runtime.variant-flag-field)) -(def: value-field (org/python/core/PyString::new runtime.variant-value-field)) - -(def: (variant lux-object host-object) +(def: (read-variant read host-object) (-> Translator Translator) - (case [(org/python/core/PyObject::__getitem__dict tag-field host-object) - (org/python/core/PyObject::__getitem__dict flag-field host-object) - (org/python/core/PyObject::__getitem__dict value-field host-object)] + (case [(org/python/core/PyObject::__getitem__ +0 host-object) + (org/python/core/PyObject::__getitem__ +1 host-object) + (org/python/core/PyObject::__getitem__ +2 host-object)] (^or [(#error.Failure error) _ _] [_ (#error.Failure error) _] [_ _ (#error.Failure error)]) (#error.Failure error) (^multi [(#error.Success tag) (#error.Success flag) (#error.Success value)] - [(lux-object tag) + [(read tag) (#error.Success tag)] - [(lux-object value) + [(read value) (#error.Success value)]) - (#error.Success [(java/lang/Long::intValue (:coerce java/lang/Long tag)) + (#error.Success [tag (: Any - (case (python-type (:coerce org/python/core/PyObject flag)) - "NoneType" + (case (host.check org/python/core/PyNone flag) + (#.Some _) (host.null) - _ - "")) + #.None + synthesis.unit)) value]) _ (exception.throw ..unknown-kind-of-object host-object))) -(def: (lux-object host-object) +(def: (read host-object) Translator - (case (python-type host-object) - "str" - (#error.Success (org/python/core/PyObject::asString host-object)) - - "bool" - (#error.Success (org/python/core/PyObject::__nonzero__ host-object)) - - "float" - (#error.Success (org/python/core/PyObject::asDouble host-object)) + (`` (<| (~~ (do-template [<class> <processing>] + [(case (host.check <class> host-object) + (#.Some host-object) + (#error.Success (<| <processing> host-object)) + + _)] + + [org/python/core/PyNone (new> [] [])] + [org/python/core/PyBoolean org/python/core/PyObject::__nonzero__] + [org/python/core/PyInteger org/python/core/PyObject::asInt] + [org/python/core/PyLong org/python/core/PyObject::asLong] + [org/python/core/PyFloat org/python/core/PyObject::asDouble] + [org/python/core/PyString org/python/core/PyObject::asString] + [org/python/core/PyFunction (|>)] + [org/python/core/PyArray org/python/core/PyArray::getArray] + [(Array java/lang/Object) (|>)] + )) + (~~ (do-template [<class> <processing>] + [(case (host.check <class> host-object) + (#.Some host-object) + (<| <processing> host-object) + + _)] + + [org/python/core/PyTuple (..read-variant read)] + [org/python/core/PyList (..read-tuple read)] + )) + (exec (log! (java/lang/Class::getCanonicalName + (java/lang/Object::getClass + (:coerce java/lang/Object host-object)))) + (log! (python-type host-object)) + (exception.throw ..unknown-kind-of-object host-object))))) + +(exception: (cannot-apply-a-non-function {object java/lang/Object}) + (exception.report + ["Object" (java/lang/Object::toString object)])) - (^or "int" "long") - (#error.Success (org/python/core/PyObject::asLong host-object)) +(def: (ensure-macro macro) + (-> Macro (Maybe org/python/core/PyFunction)) + (host.check org/python/core/PyFunction (:coerce java/lang/Object macro))) - "tuple" - (..tuple lux-object host-object) +(def: object-class + (java/lang/Class java/lang/Object) + (java/lang/Object::getClass (java/lang/Object::new))) - "dict" - (..variant lux-object host-object) +(def: to-host + (-> Any org/python/core/PyObject) + (|>> (:coerce java/lang/Object) (org/python/core/PyArray::new ..object-class))) - "NoneType" - (#error.Success []) - - type - (exception.throw ..unknown-kind-of-object host-object))) +(def: (call-macro inputs lux macro) + (-> (List Code) Lux org/python/core/PyFunction (Error (Error [Lux (List Code)]))) + (<| (:coerce (Error (Error [Lux (List Code)]))) + ..read + (org/python/core/PyFunction::__call__ (|> (host.array org/python/core/PyObject 2) + (host.array-write 0 (..to-host inputs)) + (host.array-write 1 (..to-host lux))) + macro))) (def: (expander macro inputs lux) Expander - (#error.Failure "YOLO")) + (case (ensure-macro macro) + (#.Some macro) + (case (call-macro inputs lux macro) + (#error.Success output) + (|> output + (:coerce org/python/core/PyObject) + ..read + (:coerce (Error (Error [Lux (List Code)])))) + + (#error.Failure error) + (#error.Failure error)) + + #.None + (exception.throw cannot-apply-a-non-function (:coerce java/lang/Object macro))) + ) (def: separator "___") @@ -222,7 +288,7 @@ (function (evaluate! alias input) (do error.monad [output (org/python/util/PythonInterpreter::eval (_.code input) interpreter)] - (..lux-object output)))) + (..read output)))) execute! (: (-> Text (_.Statement Any) (Error Nothing)) (function (execute! alias input) (do error.monad @@ -257,7 +323,7 @@ (-> (_.Expression Any) (_.Statement Any)) ($_ _.then (_.import "sys") - (_.when (_.= (_.string "main") (_.var "__name__")) + (_.when (_.= (_.string "__main__") (_.var "__name__")) (_.statement (_.apply/2 program (runtime.lux//program-args (|> (_.var "sys") (_.the "argv"))) _.none))))) diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 323615249..2add33e57 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1057,7 +1057,7 @@ (fail "Wrong syntax for $'")} tokens)) -(def:'' (list;map f xs) +(def:'' (list@map f xs) #Nil (#UnivQ #Nil (#UnivQ #Nil @@ -1068,7 +1068,7 @@ #Nil (#Cons x xs') - (#Cons (f x) (list;map f xs'))} + (#Cons (f x) (list@map f xs'))} xs)) (def:'' RepEnv @@ -1086,7 +1086,7 @@ #Nil} [xs ys])) -(def:'' (text;= x y) +(def:'' (text@= x y) #Nil (#Function Text (#Function Text Bit)) ("lux text =" x y)) @@ -1103,7 +1103,7 @@ #0 (get-rep key env')} - (text;= k key))} + (text@= k key))} env)) (def:'' (replace-syntax reps syntax) @@ -1118,13 +1118,13 @@ (get-rep name reps)) [meta (#Form parts)] - [meta (#Form (list;map (replace-syntax reps) parts))] + [meta (#Form (list@map (replace-syntax reps) parts))] [meta (#Tuple members)] - [meta (#Tuple (list;map (replace-syntax reps) members))] + [meta (#Tuple (list@map (replace-syntax reps) members))] [meta (#Record slots)] - [meta (#Record (list;map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) + [meta (#Record (list@map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) (function'' [slot] ({[k v] [(replace-syntax reps k) (replace-syntax reps v)]} @@ -1163,10 +1163,10 @@ #Nil (#Function Code Code) ({[_ (#Tuple members)] - (tuple$ (list;map update-parameters members)) + (tuple$ (list@map update-parameters members)) [_ (#Record pairs)] - (record$ (list;map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) + (record$ (list@map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) (function'' [pair] (let'' [name val] pair [name (update-parameters val)]))) @@ -1176,7 +1176,7 @@ (form$ (#Cons (tag$ ["lux" "Parameter"]) (#Cons (nat$ (n/+ 2 idx)) #Nil))) [_ (#Form members)] - (form$ (list;map update-parameters members)) + (form$ (list@map update-parameters members)) _ code} @@ -1204,7 +1204,7 @@ (#Function Nat Code) (form$ (#Cons (tag$ ["lux" "Parameter"]) (#Cons (nat$ idx) #Nil)))) -(def:'' (list;fold f init xs) +(def:'' (list@fold f init xs) #Nil ## (All [a b] (-> (-> b a a) a (List b) a)) (#UnivQ #Nil (#UnivQ #Nil (#Function (#Function (#Parameter 1) @@ -1217,14 +1217,14 @@ init (#Cons x xs') - (list;fold f (f x init) xs')} + (list@fold f (f x init) xs')} xs)) -(def:'' (list;size list) +(def:'' (list@size list) #Nil (#UnivQ #Nil (#Function ($' List (#Parameter 1)) Nat)) - (list;fold (function'' [_ acc] (n/+ 1 acc)) 0 list)) + (list@fold (function'' [_ acc] (n/+ 1 acc)) 0 list)) (macro:' #export (All tokens) (#Cons [(tag$ ["lux" "doc"]) @@ -1245,7 +1245,7 @@ ({(#Cons [_ (#Tuple args)] (#Cons body #Nil)) (parse-quantified-args args (function'' [names] - (let'' body' (list;fold ("lux check" (#Function Text (#Function Code Code)) + (let'' body' (list@fold ("lux check" (#Function Text (#Function Code Code)) (function'' [name' body'] (form$ (#Cons (tag$ ["lux" "UnivQ"]) (#Cons (tag$ ["lux" "Nil"]) @@ -1260,10 +1260,10 @@ body' [#0 _] - (replace-syntax (#Cons [self-name (make-parameter (n/* 2 (n/- 1 (list;size names))))] + (replace-syntax (#Cons [self-name (make-parameter (n/* 2 (n/- 1 (list@size names))))] #Nil) body')} - [(text;= "" self-name) names]) + [(text@= "" self-name) names]) #Nil))))) _ @@ -1289,7 +1289,7 @@ ({(#Cons [_ (#Tuple args)] (#Cons body #Nil)) (parse-quantified-args args (function'' [names] - (let'' body' (list;fold ("lux check" (#Function Text (#Function Code Code)) + (let'' body' (list@fold ("lux check" (#Function Text (#Function Code Code)) (function'' [name' body'] (form$ (#Cons (tag$ ["lux" "ExQ"]) (#Cons (tag$ ["lux" "Nil"]) @@ -1304,20 +1304,20 @@ body' [#0 _] - (replace-syntax (#Cons [self-name (make-parameter (n/* 2 (n/- 1 (list;size names))))] + (replace-syntax (#Cons [self-name (make-parameter (n/* 2 (n/- 1 (list@size names))))] #Nil) body')} - [(text;= "" self-name) names]) + [(text@= "" self-name) names]) #Nil))))) _ (fail "Wrong syntax for Ex")} tokens))) -(def:'' (list;reverse list) +(def:'' (list@reverse list) #Nil (All [a] (#Function ($' List a) ($' List a))) - (list;fold ("lux check" (All [a] (#Function a (#Function ($' List a) ($' List a)))) + (list@fold ("lux check" (All [a] (#Function a (#Function ($' List a) ($' List a)))) (function'' [head tail] (#Cons head tail))) #Nil list)) @@ -1331,7 +1331,7 @@ "## This is the type of a function that takes 2 Ints and returns an Int.")))] #Nil) ({(#Cons output inputs) - (return (#Cons (list;fold ("lux check" (#Function Code (#Function Code Code)) + (return (#Cons (list@fold ("lux check" (#Function Code (#Function Code Code)) (function'' [i o] (form$ (#Cons (tag$ ["lux" "Function"]) (#Cons i (#Cons o #Nil)))))) output inputs) @@ -1339,7 +1339,7 @@ _ (fail "Wrong syntax for ->")} - (list;reverse tokens))) + (list@reverse tokens))) (macro:' #export (list xs) (#Cons [(tag$ ["lux" "doc"]) @@ -1347,12 +1347,12 @@ ("lux text concat" "## List-construction macro." __paragraph) "(list +1 +2 +3)"))] #Nil) - (return (#Cons (list;fold (function'' [head tail] + (return (#Cons (list@fold (function'' [head tail] (form$ (#Cons (tag$ ["lux" "Cons"]) (#Cons (tuple$ (#Cons [head (#Cons [tail #Nil])])) #Nil)))) (tag$ ["lux" "Nil"]) - (list;reverse xs)) + (list@reverse xs)) #Nil))) (macro:' #export (list& xs) @@ -1364,7 +1364,7 @@ "(list& +1 +2 +3 (list +4 +5 +6))")))] #Nil) ({(#Cons last init) - (return (list (list;fold (function'' [head tail] + (return (list (list@fold (function'' [head tail] (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list head tail))))) last @@ -1372,7 +1372,7 @@ _ (fail "Wrong syntax for list&")} - (list;reverse xs))) + (list@reverse xs))) (macro:' #export (& tokens) (#Cons [(tag$ ["lux" "doc"]) @@ -1388,10 +1388,10 @@ (return (list (identifier$ ["lux" "Any"]))) (#Cons last prevs) - (return (list (list;fold (function'' [left right] (form$ (list (tag$ ["lux" "Product"]) left right))) + (return (list (list@fold (function'' [left right] (form$ (list (tag$ ["lux" "Product"]) left right))) last prevs)))} - (list;reverse tokens))) + (list@reverse tokens))) (macro:' #export (| tokens) (#Cons [(tag$ ["lux" "doc"]) @@ -1407,10 +1407,10 @@ (return (list (identifier$ ["lux" "Nothing"]))) (#Cons last prevs) - (return (list (list;fold (function'' [left right] (form$ (list (tag$ ["lux" "Sum"]) left right))) + (return (list (list@fold (function'' [left right] (form$ (list (tag$ ["lux" "Sum"]) left right))) last prevs)))} - (list;reverse tokens))) + (list@reverse tokens))) (macro:' (function' tokens) (let'' [name tokens'] ({(#Cons [[_ (#Identifier ["" name])] tokens']) @@ -1426,12 +1426,12 @@ (#Cons [harg targs]) (return (list (form$ (list (tuple$ (list (identifier$ ["" name]) harg)) - (list;fold (function'' [arg body'] + (list@fold (function'' [arg body'] (form$ (list (tuple$ (list (identifier$ ["" ""]) arg)) body'))) body - (list;reverse targs))))))} + (list@reverse targs))))))} args) _ @@ -1502,14 +1502,14 @@ (macro:' (let' tokens) ({(#Cons [[_ (#Tuple bindings)] (#Cons [body #Nil])]) - (return (list (list;fold ("lux check" (-> (& Code Code) Code + (return (list (list@fold ("lux check" (-> (& Code Code) Code Code) (function' [binding body] ({[label value] (form$ (list (record$ (list [label body])) value))} binding))) body - (list;reverse (as-pairs bindings))))) + (list@reverse (as-pairs bindings))))) _ (fail "Wrong syntax for let'")} @@ -1544,11 +1544,11 @@ (_ann (#Form (list (_ann (#Tag ["lux" "Cons"])) token (untemplate-list tokens'))))} tokens)) -(def:''' (list;compose xs ys) +(def:''' (list@compose xs ys) #Nil (All [a] (-> ($' List a) ($' List a) ($' List a))) ({(#Cons x xs') - (#Cons x (list;compose xs' ys)) + (#Cons x (list@compose xs' ys)) #Nil ys} @@ -1568,7 +1568,7 @@ #Nil (-> Code Code Code Code) ({[_ (#Form parts)] - (form$ (list;compose parts (list a1 a2))) + (form$ (list@compose parts (list a1 a2))) _ (form$ (list op a1 a2))} @@ -1586,14 +1586,14 @@ (text$ ("lux text concat" ("lux text concat" "## Left-association for the application of binary functions over variadic arguments." ..new-line) ("lux text concat" - ("lux text concat" "(_$ text;compose ''Hello, '' name ''. How are you?'')" ..new-line) + ("lux text concat" "(_$ text@compose ''Hello, '' name ''. How are you?'')" ..new-line) ("lux text concat" ("lux text concat" "## =>" ..new-line) - "(text;compose (text;compose ''Hello, '' name) ''. How are you?'')"))))] + "(text@compose (text@compose ''Hello, '' name) ''. How are you?'')"))))] #Nil) ({(#Cons op tokens') ({(#Cons first nexts) - (return (list (list;fold (function/flip (_$_joiner op)) first nexts))) + (return (list (list@fold (function/flip (_$_joiner op)) first nexts))) _ (fail "Wrong syntax for _$")} @@ -1608,18 +1608,18 @@ (text$ ("lux text concat" ("lux text concat" "## Right-association for the application of binary functions over variadic arguments." ..new-line) ("lux text concat" - ("lux text concat" "($_ text;compose ''Hello, '' name ''. How are you?'')" ..new-line) + ("lux text concat" "($_ text@compose ''Hello, '' name ''. How are you?'')" ..new-line) ("lux text concat" ("lux text concat" "## =>" ..new-line) - "(text;compose ''Hello, '' (text;compose name ''. How are you?''))"))))] + "(text@compose ''Hello, '' (text@compose name ''. How are you?''))"))))] #Nil) ({(#Cons op tokens') ({(#Cons last prevs) - (return (list (list;fold (_$_joiner op) last prevs))) + (return (list (list@fold (_$_joiner op) last prevs))) _ (fail "Wrong syntax for $_")} - (list;reverse tokens')) + (list@reverse tokens')) _ (fail "Wrong syntax for $_")} @@ -1676,7 +1676,7 @@ ({(#Cons monad (#Cons [_ (#Tuple bindings)] (#Cons body #Nil))) (let' [g!wrap (identifier$ ["" "wrap"]) g!bind (identifier$ ["" " bind "]) - body' (list;fold ("lux check" (-> (& Code Code) Code Code) + body' (list@fold ("lux check" (-> (& Code Code) Code Code) (function' [binding body'] (let' [[var value] binding] ({[_ (#Tag "" "let")] @@ -1688,7 +1688,7 @@ value))} var)))) body - (list;reverse (as-pairs bindings)))] + (list@reverse (as-pairs bindings)))] (return (list (form$ (list (record$ (list [(record$ (list [(tag$ ["lux" "wrap"]) g!wrap] [(tag$ ["lux" "bind"]) g!bind])) body'])) monad))))) @@ -1697,7 +1697,7 @@ (fail "Wrong syntax for do")} tokens)) -(def:''' (monad;map m f xs) +(def:''' (monad@map m f xs) #Nil ## (All [m a b] ## (-> (Monad m) (-> a (m b)) (List a) (m (List b)))) @@ -1713,7 +1713,7 @@ (#Cons x xs') (do m [y (f x) - ys (monad;map m f xs')] + ys (monad@map m f xs')] (wrap (#Cons y ys)))} xs))) @@ -1757,7 +1757,7 @@ (All [a] (-> Text ($' List (& Text a)) ($' Maybe a))) ({(#Cons [[k' v] plist']) - (if (text;= k k') + (if (text@= k k') (#Some v) (get k plist')) @@ -1773,7 +1773,7 @@ (list [k v]) (#Cons [[k' v'] dict']) - (if (text;= k k') + (if (text@= k k') (#Cons [[k' v] dict']) (#Cons [[k' v'] (put k v dict')]))} dict)) @@ -1786,17 +1786,17 @@ (-> Text Any) ("lux io log" message)) -(def:''' (text;compose x y) +(def:''' (text@compose x y) #Nil (-> Text Text Text) ("lux text concat" x y)) -(def:''' (name;encode full-name) +(def:''' (name@encode full-name) #Nil (-> Name Text) (let' [[module name] full-name] ({"" name - _ ($_ text;compose module "." name)} + _ ($_ text@compose module "." name)} module))) (def:''' (get-meta tag def-meta) @@ -1811,8 +1811,8 @@ _ (get-meta tag (record$ def-meta'))} - [(text;= prefix prefix') - (text;= name name')]) + [(text@= prefix prefix') + (text@= name name')]) _ (get-meta tag (record$ def-meta'))} @@ -1844,11 +1844,11 @@ (get-meta ["lux" "alias"] def-meta)) #None - (#Left ($_ text;compose "Unknown definition: " (name;encode full-name)))} + (#Left ($_ text@compose "Unknown definition: " (name@encode full-name)))} (get name definitions)) #None - (#Left ($_ text;compose "Unknown module: " module " @ " (name;encode full-name)))} + (#Left ($_ text@compose "Unknown module: " module " @ " (name@encode full-name)))} (get module modules)))) (def:''' (splice replace? untemplate elems) @@ -1884,10 +1884,10 @@ leftI)) lastO inits))} - (list;reverse elems)) + (list@reverse elems)) #0 (do meta-monad - [=elems (monad;map meta-monad untemplate elems)] + [=elems (monad@map meta-monad untemplate elems)] (wrap (untemplate-list =elems)))} replace?)) @@ -1932,7 +1932,7 @@ [#1 [_ (#Identifier [module name])]] (do meta-monad [real-name ({"" - (if (text;= "" subst) + (if (text@= "" subst) (wrap [module name]) (resolve-global-identifier [subst name])) @@ -1973,7 +1973,7 @@ [_ [_ (#Record fields)]] (do meta-monad - [=fields (monad;map meta-monad + [=fields (monad@map meta-monad ("lux check" (-> (& Code Code) ($' Meta Code)) (function' [kv] (let' [[k v] kv] @@ -2066,17 +2066,17 @@ (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" "## Piping macro." __paragraph - "(|> elems (list;map int;encode) (interpose '' '') (fold text;compose ''''))" __paragraph + "(|> elems (list@map int@encode) (interpose '' '') (fold text@compose ''''))" __paragraph "## =>" __paragraph - "(fold text;compose '''' (interpose '' '' (list;map int;encode elems)))"))]) + "(fold text@compose '''' (interpose '' '' (list@map int@encode elems)))"))]) ({(#Cons [init apps]) - (return (list (list;fold ("lux check" (-> Code Code Code) + (return (list (list@fold ("lux check" (-> Code Code Code) (function' [app acc] ({[_ (#Tuple parts)] - (tuple$ (list;compose parts (list acc))) + (tuple$ (list@compose parts (list acc))) [_ (#Form parts)] - (form$ (list;compose parts (list acc))) + (form$ (list@compose parts (list acc))) _ (` ((~ app) (~ acc)))} @@ -2092,17 +2092,17 @@ (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" "## Reverse piping macro." __paragraph - "(<| (fold text;compose '''') (interpose '' '') (list;map int;encode) elems)" __paragraph + "(<| (fold text@compose '''') (interpose '' '') (list@map int@encode) elems)" __paragraph "## =>" __paragraph - "(fold text;compose '''' (interpose '' '' (list;map int;encode elems)))"))]) + "(fold text@compose '''' (interpose '' '' (list@map int@encode elems)))"))]) ({(#Cons [init apps]) - (return (list (list;fold ("lux check" (-> Code Code Code) + (return (list (list@fold ("lux check" (-> Code Code Code) (function' [app acc] ({[_ (#Tuple parts)] - (tuple$ (list;compose parts (list acc))) + (tuple$ (list@compose parts (list acc))) [_ (#Form parts)] - (form$ (list;compose parts (list acc))) + (form$ (list@compose parts (list acc))) _ (` ((~ app) (~ acc)))} @@ -2112,7 +2112,7 @@ _ (fail "Wrong syntax for <|")} - (list;reverse tokens))) + (list@reverse tokens))) (def:''' (compose f g) (list [(tag$ ["lux" "doc"]) @@ -2173,13 +2173,13 @@ (get-rep sname env)) [meta (#Tuple elems)] - [meta (#Tuple (list;map (apply-template env) elems))] + [meta (#Tuple (list@map (apply-template env) elems))] [meta (#Form elems)] - [meta (#Form (list;map (apply-template env) elems))] + [meta (#Form (list@map (apply-template env) elems))] [meta (#Record members)] - [meta (#Record (list;map ("lux check" (-> (& Code Code) (& Code Code)) + [meta (#Record (list@map ("lux check" (-> (& Code Code) (& Code Code)) (function' [kv] (let' [[slot value] kv] [(apply-template env slot) (apply-template env value)]))) @@ -2197,14 +2197,14 @@ #Nil (#Cons [x xs']) - (list;compose (f x) (join-map f xs'))} + (list@compose (f x) (join-map f xs'))} xs)) (def:''' (every? p xs) #Nil (All [a] (-> (-> a Bit) ($' List a) Bit)) - (list;fold (function' [_2 _1] (if _1 (p _2) #0)) #1 xs)) + (list@fold (function' [_2 _1] (if _1 (p _2) #0)) #1 xs)) (def:''' #export (n/= test subject) (list [(tag$ ["lux" "doc"]) @@ -2274,10 +2274,10 @@ ({(#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])]) ({[(#Some bindings') (#Some data')] (let' [apply ("lux check" (-> RepEnv ($' List Code)) - (function' [env] (list;map (apply-template env) templates))) - num-bindings (list;size bindings')] + (function' [env] (list@map (apply-template env) templates))) + num-bindings (list@size bindings')] (if (every? (n/= num-bindings) - (list;map list;size data')) + (list@map list@size data')) (|> data' (join-map (compose apply (make-env bindings'))) return) @@ -2285,8 +2285,8 @@ _ (fail "Wrong syntax for do-template")} - [(monad;map maybe-monad get-short bindings) - (monad;map maybe-monad tuple->list data)]) + [(monad@map maybe-monad get-short bindings) + (monad@map maybe-monad tuple->list data)]) _ (fail "Wrong syntax for do-template")} @@ -2547,7 +2547,7 @@ [f/max Frac f/> "Frac(tion) minimum."] ) -(def:''' (bit;encode x) +(def:''' (bit@encode x) #Nil (-> Bit Text) (if x "#1" "#0")) @@ -2562,7 +2562,7 @@ _ ("lux io error" "undefined")} digit)) -(def:''' (nat;encode value) +(def:''' (nat@encode value) #Nil (-> Nat Text) ({0 @@ -2574,19 +2574,19 @@ (if (n/= 0 input) output (recur (n// 10 input) - (text;compose (|> input (n/% 10) digit-to-text) + (text@compose (|> input (n/% 10) digit-to-text) output)))))] (loop value ""))} value)) -(def:''' (int;abs value) +(def:''' (int@abs value) #Nil (-> Int Int) (if (i/< +0 value) (i/* -1 value) value)) -(def:''' (int;encode value) +(def:''' (int@encode value) #Nil (-> Int Text) (if (i/= +0 value) @@ -2597,14 +2597,14 @@ (("lux check" (-> Int Text Text) (function' recur [input output] (if (i/= +0 input) - (text;compose sign output) + (text@compose sign output) (recur (i// +10 input) - (text;compose (|> input (i/% +10) ("lux coerce" Nat) digit-to-text) + (text@compose (|> input (i/% +10) ("lux coerce" Nat) digit-to-text) output))))) - (|> value (i// +10) int;abs) - (|> value (i/% +10) int;abs ("lux coerce" Nat) digit-to-text))))) + (|> value (i// +10) int@abs) + (|> value (i/% +10) int@abs ("lux coerce" Nat) digit-to-text))))) -(def:''' (frac;encode x) +(def:''' (frac@encode x) #Nil (-> Frac Text) ("lux frac encode" x)) @@ -2638,7 +2638,7 @@ (#Some ("lux coerce" Macro def-value)) _ - (if (text;= module current-module) + (if (text@= module current-module) (#Some ("lux coerce" Macro def-value)) #None)} (get-meta ["lux" "export?"] def-meta)) @@ -2690,11 +2690,11 @@ #None #0} output)))) -(def:''' (list;join xs) +(def:''' (list@join xs) #Nil (All [a] (-> ($' List ($' List a)) ($' List a))) - (list;fold list;compose #Nil (list;reverse xs))) + (list@fold list@compose #Nil (list@reverse xs))) (def:''' (interpose sep xs) #Nil @@ -2738,8 +2738,8 @@ ({(#Some macro) (do meta-monad [expansion (macro args) - expansion' (monad;map meta-monad macro-expand expansion)] - (wrap (list;join expansion'))) + expansion' (monad@map meta-monad macro-expand expansion)] + (wrap (list@join expansion'))) #None (return (list token))} @@ -2759,28 +2759,28 @@ ({(#Some macro) (do meta-monad [expansion (macro args) - expansion' (monad;map meta-monad macro-expand-all expansion)] - (wrap (list;join expansion'))) + expansion' (monad@map meta-monad macro-expand-all expansion)] + (wrap (list@join expansion'))) #None (do meta-monad - [args' (monad;map meta-monad macro-expand-all args)] - (wrap (list (form$ (#Cons (identifier$ macro-name) (list;join args'))))))} + [args' (monad@map meta-monad macro-expand-all args)] + (wrap (list (form$ (#Cons (identifier$ macro-name) (list@join args'))))))} ?macro)) [_ (#Form members)] (do meta-monad - [members' (monad;map meta-monad macro-expand-all members)] - (wrap (list (form$ (list;join members'))))) + [members' (monad@map meta-monad macro-expand-all members)] + (wrap (list (form$ (list@join members'))))) [_ (#Tuple members)] (do meta-monad - [members' (monad;map meta-monad macro-expand-all members)] - (wrap (list (tuple$ (list;join members'))))) + [members' (monad@map meta-monad macro-expand-all members)] + (wrap (list (tuple$ (list@join members'))))) [_ (#Record pairs)] (do meta-monad - [pairs' (monad;map meta-monad + [pairs' (monad@map meta-monad (function' [kv] (let' [[key val] kv] (do meta-monad @@ -2802,10 +2802,10 @@ #Nil (-> Code Code) ({[_ (#Form (#Cons [_ (#Tag tag)] parts))] - (form$ (#Cons [(tag$ tag) (list;map walk-type parts)])) + (form$ (#Cons [(tag$ tag) (list@map walk-type parts)])) [_ (#Tuple members)] - (` (& (~+ (list;map walk-type members)))) + (` (& (~+ (list@map walk-type members)))) [_ (#Form (#Cons [_ (#Text "lux in-module")] (#Cons [_ (#Text module)] @@ -2817,10 +2817,10 @@ expression [_ (#Form (#Cons type-fn args))] - (list;fold ("lux check" (-> Code Code Code) + (list@fold ("lux check" (-> Code Code Code) (function' [arg type-fn] (` (#.Apply (~ arg) (~ type-fn))))) (walk-type type-fn) - (list;map walk-type args)) + (list@map walk-type args)) _ type} @@ -2890,7 +2890,7 @@ (-> ($' List Code) ($' Meta (& Code ($' Maybe ($' List Text))))) ({(#Cons [_ (#Record pairs)] #Nil) (do meta-monad - [members (monad;map meta-monad + [members (monad@map meta-monad (: (-> [Code Code] (Meta [Text Code])) (function' [pair] ({[[_ (#Tag "" member-name)] member-type] @@ -2900,8 +2900,8 @@ (fail "Wrong syntax for variant case.")} pair))) pairs)] - (return [(` (& (~+ (list;map second members)))) - (#Some (list;map first members))])) + (return [(` (& (~+ (list@map second members)))) + (#Some (list@map first members))])) (#Cons type #Nil) ({[_ (#Tag "" member-name)] @@ -2916,7 +2916,7 @@ (#Cons case cases) (do meta-monad - [members (monad;map meta-monad + [members (monad@map meta-monad (: (-> Code (Meta [Text Code])) (function' [case] ({[_ (#Tag "" member-name)] @@ -2932,8 +2932,8 @@ (fail "Wrong syntax for variant case.")} case))) (list& case cases))] - (return [(` (| (~+ (list;map second members)))) - (#Some (list;map first members))])) + (return [(` (| (~+ (list@map second members)))) + (#Some (list@map first members))])) _ (fail "Improper type-definition syntax")} @@ -2952,7 +2952,7 @@ #seed (n/+ 1 seed) #expected expected #cursor cursor #extensions extensions #scope-type-vars scope-type-vars} - (identifier$ ["" ($_ text;compose "__gensym__" prefix (nat;encode seed))]))} + (identifier$ ["" ($_ text@compose "__gensym__" prefix (nat@encode seed))]))} state)) (macro:' #export (Rec tokens) @@ -2981,7 +2981,7 @@ "''YOLO'')"))]) ({(#Cons value actions) (let' [dummy (identifier$ ["" ""])] - (return (list (list;fold ("lux check" (-> Code Code Code) + (return (list (list@fold ("lux check" (-> Code Code Code) (function' [pre post] (` ({(~ dummy) (~ post)} (~ pre))))) value @@ -2989,7 +2989,7 @@ _ (fail "Wrong syntax for exec")} - (list;reverse tokens))) + (list@reverse tokens))) (macro:' (def:' tokens) (let' [[export? tokens'] ({(#Cons [_ (#Tag ["" "export"])] tokens') @@ -3045,54 +3045,54 @@ (def:' (code-to-text code) (-> Code Text) ({[_ (#Bit value)] - (bit;encode value) + (bit@encode value) [_ (#Nat value)] - (nat;encode value) + (nat@encode value) [_ (#Int value)] - (int;encode value) + (int@encode value) [_ (#Rev value)] ("lux io error" "Undefined behavior.") [_ (#Frac value)] - (frac;encode value) + (frac@encode value) [_ (#Text value)] - ($_ text;compose ..double-quote value ..double-quote) + ($_ text@compose ..double-quote value ..double-quote) [_ (#Identifier [prefix name])] - (if (text;= "" prefix) + (if (text@= "" prefix) name - ($_ text;compose prefix "." name)) + ($_ text@compose prefix "." name)) [_ (#Tag [prefix name])] - (if (text;= "" prefix) - ($_ text;compose "#" name) - ($_ text;compose "#" prefix "." name)) + (if (text@= "" prefix) + ($_ text@compose "#" name) + ($_ text@compose "#" prefix "." name)) [_ (#Form xs)] - ($_ text;compose "(" (|> xs - (list;map code-to-text) + ($_ text@compose "(" (|> xs + (list@map code-to-text) (interpose " ") - list;reverse - (list;fold text;compose "")) ")") + list@reverse + (list@fold text@compose "")) ")") [_ (#Tuple xs)] - ($_ text;compose "[" (|> xs - (list;map code-to-text) + ($_ text@compose "[" (|> xs + (list@map code-to-text) (interpose " ") - list;reverse - (list;fold text;compose "")) "]") + list@reverse + (list@fold text@compose "")) "]") [_ (#Record kvs)] - ($_ text;compose "{" (|> kvs - (list;map (function' [kv] ({[k v] ($_ text;compose (code-to-text k) " " (code-to-text v))} + ($_ text@compose "{" (|> kvs + (list@map (function' [kv] ({[k v] ($_ text@compose (code-to-text k) " " (code-to-text v))} kv))) (interpose " ") - list;reverse - (list;fold text;compose "")) "}")} + list@reverse + (list@fold text@compose "")) "}")} code)) (def:' (expander branches) @@ -3121,11 +3121,11 @@ (do meta-monad [] (wrap (list))) _ - (fail ($_ text;compose "'lux.case' expects an even number of tokens: " (|> branches - (list;map code-to-text) + (fail ($_ text@compose "'lux.case' expects an even number of tokens: " (|> branches + (list@map code-to-text) (interpose " ") - list;reverse - (list;fold text;compose ""))))} + list@reverse + (list@fold text@compose ""))))} branches)) (macro:' #export (case tokens) @@ -3195,9 +3195,9 @@ _ (let' [pairs (|> patterns - (list;map (function' [pattern] (list pattern body))) - (list;join))] - (return (list;compose pairs branches)))) + (list@map (function' [pattern] (list pattern body))) + (list@join))] + (return (list@compose pairs branches)))) _ (fail "Wrong syntax for ^or"))) @@ -3220,9 +3220,9 @@ " (op x y))"))]) (case tokens (^ (list [_ (#Tuple bindings)] body)) - (if (multiple? 2 (list;size bindings)) - (|> bindings as-pairs list;reverse - (list;fold (: (-> [Code Code] Code Code) + (if (multiple? 2 (list@size bindings)) + (|> bindings as-pairs list@reverse + (list@fold (: (-> [Code Code] Code Code) (function' [lr body'] (let' [[l r] lr] (if (identifier? l) @@ -3256,14 +3256,14 @@ (#Some g!name head tail body) (let [g!blank (identifier$ ["" ""]) g!name (identifier$ ["" g!name]) - body+ (list;fold (: (-> Code Code Code) + body+ (list@fold (: (-> Code Code Code) (function' [arg body'] (if (identifier? arg) (` ([(~ g!blank) (~ arg)] (~ body'))) (` ([(~ g!blank) (~ g!blank)] (case (~ g!blank) (~ arg) (~ body'))))))) body - (list;reverse tail))] + (list@reverse tail))] (return (list (if (identifier? head) (` ([(~ g!name) (~ head)] (~ body+))) (` ([(~ g!name) (~ g!blank)] (case (~ g!blank) (~ head) (~ body+)))))))) @@ -3300,13 +3300,13 @@ [_ (#Tuple xs)] (|> xs - (list;map process-def-meta-value) + (list@map process-def-meta-value) untemplate-list (meta-code ["lux" "Tuple"])) [_ (#Record kvs)] (|> kvs - (list;map (: (-> [Code Code] Code) + (list@map (: (-> [Code Code] Code) (function (_ [k v]) (` [(~ (process-def-meta-value k)) (~ (process-def-meta-value v))])))) @@ -3316,7 +3316,7 @@ (def:' (process-def-meta kvs) (-> (List [Code Code]) Code) - (untemplate-list (list;map (: (-> [Code Code] Code) + (untemplate-list (list@map (: (-> [Code Code] Code) (function (_ [k v]) (` [(~ (process-def-meta-value k)) (~ (process-def-meta-value v))]))) @@ -3330,14 +3330,14 @@ _ (` (#.Cons [[(~ cursor-code) (#.Tag ["lux" "func-args"])] - [(~ cursor-code) (#.Tuple (.list (~+ (list;map (function (_ arg) + [(~ cursor-code) (#.Tuple (.list (~+ (list@map (function (_ arg) (` [(~ cursor-code) (#.Text (~ (text$ (code-to-text arg))))])) args))))]] (~ meta))))) (def:' (with-type-args args) (-> (List Code) Code) - (` {#.type-args [(~+ (list;map (function (_ arg) (text$ (code-to-text arg))) + (` {#.type-args [(~+ (list@map (function (_ arg) (text$ (code-to-text arg))) args))]})) (def:' (export^ tokens) @@ -3435,7 +3435,7 @@ (-> Code Code Code) (case addition [cursor (#Record pairs)] - (list;fold meta-code-add base pairs) + (list@fold meta-code-add base pairs) _ base)) @@ -3523,9 +3523,9 @@ (#Some name args meta sigs) (do meta-monad [name+ (normalize name) - sigs' (monad;map meta-monad macro-expand sigs) + sigs' (monad@map meta-monad macro-expand sigs) members (: (Meta (List [Text Code])) - (monad;map meta-monad + (monad@map meta-monad (: (-> Code (Meta [Text Code])) (function (_ token) (case token @@ -3534,10 +3534,10 @@ _ (fail "Signatures require typed members!")))) - (list;join sigs'))) + (list@join sigs'))) #let [[_module _name] name+ def-name (identifier$ name) - sig-type (record$ (list;map (: (-> [Text Code] [Code Code]) + sig-type (record$ (list@map (: (-> [Text Code] [Code Code]) (function (_ [m-name m-type]) [(tag$ ["" m-name]) m-type])) members)) @@ -3572,9 +3572,9 @@ (do-template [<name> <form> <message> <doc-msg>] [(macro: #export (<name> tokens) {#.doc <doc-msg>} - (case (list;reverse tokens) + (case (list@reverse tokens) (^ (list& last init)) - (return (list (list;fold (: (-> Code Code Code) + (return (list (list@fold (: (-> Code Code Code) (function (_ pre post) (` <form>))) last init))) @@ -3650,7 +3650,7 @@ _ (#Left "Wrong syntax for default"))) -(def: (text;split-all-with splitter input) +(def: (text@split-all-with splitter input) (-> Text Text (List Text)) (case (index-of splitter input) #None @@ -3658,7 +3658,7 @@ (#Some idx) (list& ("lux text clip" input 0 idx) - (text;split-all-with splitter + (text@split-all-with splitter ("lux text clip" input (n/+ 1 idx) ("lux text size" input)))))) (def: (nth idx xs) @@ -3803,7 +3803,7 @@ (#Right state module) _ - (#Left ($_ text;compose "Unknown module: " name)))))) + (#Left ($_ text@compose "Unknown module: " name)))))) (def: get-current-module (Meta Module) @@ -3821,7 +3821,7 @@ (return output) _ - (fail (text;compose "Unknown tag: " (name;encode [module name])))))) + (fail (text@compose "Unknown tag: " (name@encode [module name])))))) (def: (resolve-type-tags type) (-> Type (Meta (Maybe [(List Name) (List Type)]))) @@ -3871,7 +3871,7 @@ (macro: #export (structure tokens) {#.doc "Not meant to be used directly. Prefer 'structure:'."} (do meta-monad - [tokens' (monad;map meta-monad macro-expand tokens) + [tokens' (monad@map meta-monad macro-expand tokens) struct-type get-expected-type tags+type (resolve-type-tags struct-type) tags (: (Meta (List Name)) @@ -3882,9 +3882,9 @@ _ (fail "No tags available for type."))) #let [tag-mappings (: (List [Text Code]) - (list;map (function (_ tag) [(second tag) (tag$ tag)]) + (list@map (function (_ tag) [(second tag) (tag$ tag)]) tags))] - members (monad;map meta-monad + members (monad@map meta-monad (: (-> Code (Meta [Code Code])) (function (_ token) (case token @@ -3894,22 +3894,22 @@ (wrap [tag value]) _ - (fail (text;compose "Unknown structure member: " tag-name))) + (fail (text@compose "Unknown structure member: " tag-name))) _ (fail "Invalid structure member.")))) - (list;join tokens'))] + (list@join tokens'))] (wrap (list (record$ members))))) -(def: (text;join-with separator parts) +(def: (text@join-with separator parts) (-> Text (List Text) Text) (case parts #Nil "" (#Cons head tail) - (list;fold (function (_ right left) - ($_ text;compose left separator right)) + (list@fold (function (_ right left) + ($_ text@compose left separator right)) head tail))) @@ -4007,7 +4007,7 @@ type-meta (: Code (case tags?? (#Some tags) - (` {#.tags [(~+ (list;map text$ tags))] + (` {#.tags [(~+ (list@map text$ tags))] #.type? #1}) _ @@ -4078,7 +4078,7 @@ (def: (extract-defs defs) (-> (List Code) (Meta (List Text))) - (monad;map meta-monad + (monad@map meta-monad (: (-> Code (Meta Text)) (function (_ def) (case def @@ -4123,7 +4123,7 @@ (^ (list& [_ (#Form (list& [_ (#Text prefix)] structs))] parts')) (do meta-monad - [structs' (monad;map meta-monad + [structs' (monad@map meta-monad (function (_ struct) (case struct [_ (#Identifier ["" struct-name])] @@ -4184,23 +4184,23 @@ (count-relatives (n/+ 1 relatives) input) relatives))) -(def: (list;take amount list) +(def: (list@take amount list) (All [a] (-> Nat (List a) (List a))) (case [amount list] (^or [0 _] [_ #Nil]) #Nil [_ (#Cons head tail)] - (#Cons head (list;take (n/- 1 amount) tail)))) + (#Cons head (list@take (n/- 1 amount) tail)))) -(def: (list;drop amount list) +(def: (list@drop amount list) (All [a] (-> Nat (List a) (List a))) (case [amount list] (^or [0 _] [_ #Nil]) list [_ (#Cons _ tail)] - (list;drop (n/- 1 amount) tail))) + (list@drop (n/- 1 amount) tail))) (def: (clean-module nested? relative-root module) (-> Bit Text Text (Meta Text)) @@ -4211,19 +4211,19 @@ module)) relatives - (let [parts (text;split-all-with ..module-separator relative-root) + (let [parts (text@split-all-with ..module-separator relative-root) jumps (n/- 1 relatives)] - (if (n/< (list;size parts) jumps) + (if (n/< (list@size parts) jumps) (let [prefix (|> parts - list;reverse - (list;drop jumps) - list;reverse + list@reverse + (list@drop jumps) + list@reverse (interpose ..module-separator) - (text;join-with "")) + (text@join-with "")) clean ("lux text clip" module relatives ("lux text size" module)) output (case ("lux text size" clean) 0 prefix - _ ($_ text;compose prefix ..module-separator clean))] + _ ($_ text@compose prefix ..module-separator clean))] (return output)) (fail ($_ "lux text concat" "Cannot climb the module hierarchy..." ..new-line @@ -4233,22 +4233,22 @@ (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) + 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-name (text@join-with ..module-separator parallel) #import-alias import-alias #import-refer import-refer})) (def: (parse-imports nested? relative-root context-alias imports) (-> Bit Text Text (List Code) (Meta (List Importation))) (do meta-monad - [imports' (monad;map meta-monad + [imports' (monad@map meta-monad (: (-> Code (Meta (List Importation))) (function (_ token) (case token @@ -4301,27 +4301,27 @@ parallel-tree]))]) (do meta-monad [parallel-imports (parse-imports nested? relative-root context-alias (list parallel-tree))] - (wrap (list;map (alter-domain alteration domain) parallel-imports))) + (wrap (list@map (alter-domain alteration domain) parallel-imports))) (^ [_ (#Record (list [[_ (#Nat alteration)] parallel-tree]))]) (do meta-monad [parallel-imports (parse-imports nested? relative-root context-alias (list parallel-tree))] - (wrap (list;map (alter-domain alteration "") parallel-imports))) + (wrap (list@map (alter-domain alteration "") parallel-imports))) (^ [_ (#Record (list [[_ (#Tag ["" domain])] parallel-tree]))]) (do meta-monad [parallel-imports (parse-imports nested? relative-root context-alias (list parallel-tree)) - #let [alteration (list;size (text;split-all-with ..module-separator domain))]] - (wrap (list;map (alter-domain alteration domain) parallel-imports))) + #let [alteration (list@size (text@split-all-with ..module-separator domain))]] + (wrap (list@map (alter-domain alteration domain) parallel-imports))) _ (do meta-monad [current-module current-module-name] - (fail (text;compose "Wrong syntax for import @ " current-module)))))) + (fail (text@compose "Wrong syntax for import @ " current-module)))))) imports)] - (wrap (list;join imports')))) + (wrap (list@join imports')))) (def: (exported-definitions module state) (-> Text (Meta (List Text))) @@ -4333,7 +4333,7 @@ modules)] (case (get module modules) (#Some =module) - (let [to-alias (list;map (: (-> [Text Definition] + (let [to-alias (list@map (: (-> [Text Definition] (List Text)) (function (_ [name [def-type def-meta def-value]]) (case (get-meta ["lux" "export?"] def-meta) @@ -4344,10 +4344,10 @@ (list)))) (let [{#module-hash _ #module-aliases _ #definitions definitions #imports _ #tags tags #types types #module-annotations _ #module-state _} =module] definitions))] - (#Right state (list;join to-alias))) + (#Right state (list@join to-alias))) #None - (#Left ($_ text;compose "Unknown module: " module))) + (#Left ($_ text@compose "Unknown module: " module))) )) (def: (filter p xs) @@ -4363,9 +4363,9 @@ (def: (is-member? cases name) (-> (List Text) Text Bit) - (let [output (list;fold (function (_ case prev) + (let [output (list@fold (function (_ case prev) (or prev - (text;= case name))) + (text@= case name))) #0 cases)] output)) @@ -4393,7 +4393,7 @@ #captured {#counter _ #mappings closure}} (try-both (find (: (-> [Text [Type Any]] (Maybe Type)) (function (_ [bname [type _]]) - (if (text;= name bname) + (if (text@= name bname) (#Some type) #None)))) (: (List [Text [Type Any]]) locals) @@ -4428,12 +4428,12 @@ #scope-type-vars scope-type-vars} state] (case (get v-prefix modules) #None - (#Left (text;compose "Unknown definition: " (name;encode name))) + (#Left (text@compose "Unknown definition: " (name@encode name))) (#Some {#definitions definitions #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-annotations _ #module-state _}) (case (get v-name definitions) #None - (#Left (text;compose "Unknown definition: " (name;encode name))) + (#Left (text@compose "Unknown definition: " (name@encode name))) (#Some [def-type def-meta def-value]) (#Right [state [def-type def-value]]))))) @@ -4455,7 +4455,7 @@ [#let [[module name] full-name] current-module current-module-name] (function (_ compiler) - (let [temp (if (text;= "" module) + (let [temp (if (text@= "" module) (case (find-in-env name compiler) (#Some struct-type) (#Right [compiler struct-type]) @@ -4466,13 +4466,13 @@ (#Right [compiler struct-type]) _ - (#Left ($_ text;compose "Unknown var: " (name;encode full-name))))) + (#Left ($_ text@compose "Unknown var: " (name@encode full-name))))) (case (find-def-type full-name compiler) (#Some struct-type) (#Right [compiler struct-type]) _ - (#Left ($_ text;compose "Unknown var: " (name;encode full-name)))))] + (#Left ($_ text@compose "Unknown var: " (name@encode full-name)))))] (case temp (#Right [compiler (#Var type-id)]) (let [{#info _ #source _ #current-module _ #modules _ @@ -4505,7 +4505,7 @@ _ (list))) -(def: (type;encode type) +(def: (type@encode type) (-> Type Text) (case type (#Primitive name params) @@ -4514,41 +4514,41 @@ name _ - ($_ text;compose "(" name " " (|> params (list;map type;encode) (interpose " ") list;reverse (list;fold text;compose "")) ")")) + ($_ text@compose "(" name " " (|> params (list@map type@encode) (interpose " ") list@reverse (list@fold text@compose "")) ")")) (#Sum _) - ($_ text;compose "(| " (|> (flatten-variant type) (list;map type;encode) (interpose " ") list;reverse (list;fold text;compose "")) ")") + ($_ text@compose "(| " (|> (flatten-variant type) (list@map type@encode) (interpose " ") list@reverse (list@fold text@compose "")) ")") (#Product _) - ($_ text;compose "[" (|> (flatten-tuple type) (list;map type;encode) (interpose " ") list;reverse (list;fold text;compose "")) "]") + ($_ text@compose "[" (|> (flatten-tuple type) (list@map type@encode) (interpose " ") list@reverse (list@fold text@compose "")) "]") (#Function _) - ($_ text;compose "(-> " (|> (flatten-lambda type) (list;map type;encode) (interpose " ") list;reverse (list;fold text;compose "")) ")") + ($_ text@compose "(-> " (|> (flatten-lambda type) (list@map type@encode) (interpose " ") list@reverse (list@fold text@compose "")) ")") (#Parameter id) - (nat;encode id) + (nat@encode id) (#Var id) - ($_ text;compose "⌈v:" (nat;encode id) "⌋") + ($_ text@compose "⌈v:" (nat@encode id) "⌋") (#Ex id) - ($_ text;compose "⟨e:" (nat;encode id) "⟩") + ($_ text@compose "⟨e:" (nat@encode id) "⟩") (#UnivQ env body) - ($_ text;compose "(All " (type;encode body) ")") + ($_ text@compose "(All " (type@encode body) ")") (#ExQ env body) - ($_ text;compose "(Ex " (type;encode body) ")") + ($_ text@compose "(Ex " (type@encode body) ")") (#Apply _) (let [[func args] (flatten-app type)] - ($_ text;compose - "(" (type;encode func) " " - (|> args (list;map type;encode) (interpose " ") list;reverse (list;fold text;compose "")) + ($_ text@compose + "(" (type@encode func) " " + (|> args (list@map type@encode) (interpose " ") list@reverse (list@fold text@compose "")) ")")) (#Named [prefix name] _) - ($_ text;compose prefix "." name) + ($_ text@compose prefix "." name) )) (macro: #export (^open tokens) @@ -4570,13 +4570,13 @@ struct-evidence (resolve-type-tags init-type)] (case struct-evidence #None - (fail (text;compose "Can only 'open' structs: " (type;encode init-type))) + (fail (text@compose "Can only 'open' structs: " (type@encode init-type))) (#Some tags&members) (do meta-monad [full-body ((: (-> Name [(List Name) (List Type)] Code (Meta Code)) (function (recur source [tags members] target) - (let [pattern (record$ (list;map (function (_ [t-module t-name]) + (let [pattern (record$ (list@map (function (_ [t-module t-name]) [(tag$ [t-module t-name]) (identifier$ ["" (de-alias "" t-name alias)])]) tags))] @@ -4610,11 +4610,11 @@ __paragraph " ## else-branch" ..new-line " ''???'')"))} - (if (n/= 0 (n/% 2 (list;size tokens))) + (if (n/= 0 (n/% 2 (list@size tokens))) (fail "cond requires an uneven number of arguments.") - (case (list;reverse tokens) + (case (list@reverse tokens) (^ (list& else branches')) - (return (list (list;fold (: (-> [Code Code] Code Code) + (return (list (list@fold (: (-> [Code Code] Code Code) (function (_ branch else) (let [[right left] branch] (` (if (~ left) (~ right) (~ else)))))) @@ -4658,7 +4658,7 @@ g!output (gensym "")] (case (resolve-struct-type type) (#Some members) - (let [pattern (record$ (list;map (: (-> [Name [Nat Type]] [Code Code]) + (let [pattern (record$ (list@map (: (-> [Name [Nat Type]] [Code Code]) (function (_ [[r-prefix r-name] [r-idx r-type]]) [(tag$ [r-prefix r-name]) (if (n/= idx r-idx) @@ -4671,7 +4671,7 @@ (fail "get@ can only use records."))) (^ (list [_ (#Tuple slots)] record)) - (return (list (list;fold (: (-> Code Code Code) + (return (list (list@fold (: (-> Code Code Code) (function (_ slot inner) (` (..get@ (~ slot) (~ inner))))) record @@ -4694,11 +4694,11 @@ (case output (#Some [tags members]) (do meta-monad - [decls' (monad;map meta-monad + [decls' (monad@map meta-monad (: (-> [Name Type] (Meta (List Code))) (function (_ [sname stype]) (open-field alias sname source+ stype))) (zip2 tags members))] - (return (list;join decls'))) + (return (list@join decls'))) _ (return (list (` ("lux def" (~ (identifier$ ["" (de-alias "" name alias)])) @@ -4728,14 +4728,14 @@ (case output (#Some [tags members]) (do meta-monad - [decls' (monad;map meta-monad (: (-> [Name Type] (Meta (List Code))) + [decls' (monad@map meta-monad (: (-> [Name Type] (Meta (List Code))) (function (_ [sname stype]) (open-field alias sname source stype))) (zip2 tags members))] - (return (list;join decls'))) + (return (list@join decls'))) _ - (fail (text;compose "Can only 'open:' structs: " (type;encode struct-type))))) + (fail (text@compose "Can only 'open:' structs: " (type@encode struct-type))))) _ (do meta-monad @@ -4750,9 +4750,9 @@ (macro: #export (|>> tokens) {#.doc (text$ ($_ "lux text concat" "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..new-line - "(|>> (list;map int;encode) (interpose '' '') (fold text;compose ''''))" ..new-line + "(|>> (list@map int@encode) (interpose '' '') (fold text@compose ''''))" ..new-line "## =>" ..new-line - "(function (_ <arg>) (fold text;compose '''' (interpose '' '' (list;map int;encode <arg>))))"))} + "(function (_ <arg>) (fold text@compose '''' (interpose '' '' (list@map int@encode <arg>))))"))} (do meta-monad [g!_ (gensym "_") g!arg (gensym "arg")] @@ -4761,9 +4761,9 @@ (macro: #export (<<| tokens) {#.doc (text$ ($_ "lux text concat" "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..new-line - "(<<| (fold text;compose '''') (interpose '' '') (list;map int;encode))" ..new-line + "(<<| (fold text@compose '''') (interpose '' '') (list@map int@encode))" ..new-line "## =>" ..new-line - "(function (_ <arg>) (fold text;compose '''' (interpose '' '' (list;map int;encode <arg>))))"))} + "(function (_ <arg>) (fold text@compose '''' (interpose '' '' (list@map int@encode <arg>))))"))} (do meta-monad [g!_ (gensym "_") g!arg (gensym "arg")] @@ -4786,12 +4786,12 @@ current-module current-module-name #let [test-referrals (: (-> Text (List Text) (List Text) (Meta (List Any))) (function (_ module-name all-defs referred-defs) - (monad;map meta-monad + (monad@map meta-monad (: (-> Text (Meta Any)) (function (_ _def) (if (is-member? all-defs _def) (return []) - (fail ($_ text;compose _def " is not defined in module " module-name " @ " current-module))))) + (fail ($_ text@compose _def " is not defined in module " module-name " @ " current-module))))) referred-defs)))]] (case options #Nil @@ -4799,11 +4799,11 @@ #refer-open openings}) _ - (fail ($_ text;compose "Wrong syntax for refer @ " current-module + (fail ($_ text@compose "Wrong syntax for refer @ " current-module ..new-line (|> options - (list;map code-to-text) + (list@map code-to-text) (interpose " ") - (list;fold text;compose ""))))))) + (list@fold text@compose ""))))))) (def: (write-refer module-name [r-defs r-opens]) (-> Text Refer (Meta (List Code))) @@ -4811,12 +4811,12 @@ [current-module current-module-name #let [test-referrals (: (-> Text (List Text) (List Text) (Meta (List Any))) (function (_ module-name all-defs referred-defs) - (monad;map meta-monad + (monad@map meta-monad (: (-> Text (Meta Any)) (function (_ _def) (if (is-member? all-defs _def) (return []) - (fail ($_ text;compose _def " is not defined in module " module-name " @ " current-module))))) + (fail ($_ text@compose _def " is not defined in module " module-name " @ " current-module))))) referred-defs)))] defs' (case r-defs #All @@ -4839,17 +4839,17 @@ #Nothing (wrap (list))) - #let [defs (list;map (: (-> Text Code) + #let [defs (list@map (: (-> Text Code) (function (_ def) (` ("lux def alias" (~ (identifier$ ["" def])) (~ (identifier$ [module-name def])))))) defs') openings (join-map (: (-> Openings (List Code)) (function (_ [alias structs]) - (list;map (function (_ name) + (list@map (function (_ name) (` (open: (~ (text$ alias)) (~ (identifier$ [module-name name]))))) structs))) r-opens)]] - (wrap (list;compose defs openings)) + (wrap (list@compose defs openings)) )) (macro: #export (refer tokens) @@ -4871,19 +4871,19 @@ (list (' #*)) (#Only defs) - (list (form$ (list& (' #+) (list;map local-identifier$ defs)))) + (list (form$ (list& (' #+) (list@map local-identifier$ defs)))) (#Exclude defs) - (list (form$ (list& (' #-) (list;map local-identifier$ defs)))) + (list (form$ (list& (' #-) (list@map local-identifier$ defs)))) #Ignore (list) #Nothing (list))) - openings (list;map (function (_ [alias structs]) + openings (list@map (function (_ [alias structs]) (form$ (list& (text$ (..replace-all ..contextual-reference module-alias alias)) - (list;map local-identifier$ structs)))) + (list@map local-identifier$ structs)))) r-opens)] (` (..refer (~ (text$ module-name)) (~+ localizations) @@ -4917,11 +4917,11 @@ [(list) tokens]))] current-module current-module-name imports (parse-imports #0 current-module "" _imports) - #let [=imports (list;map (: (-> Importation Code) + #let [=imports (list@map (: (-> Importation Code) (function (_ [m-name m-alias =refer]) (` [(~ (text$ m-name)) (~ (text$ (default "" m-alias)))]))) imports) - =refers (list;map (: (-> Importation Code) + =refers (list@map (: (-> Importation Code) (function (_ [m-name m-alias =refer]) (refer-to-code m-name m-alias =refer))) imports) @@ -4968,19 +4968,19 @@ (case (resolve-struct-type type) (#Some members) (do meta-monad - [pattern' (monad;map meta-monad + [pattern' (monad@map meta-monad (: (-> [Name [Nat Type]] (Meta [Name Nat Code])) (function (_ [r-slot-name [r-idx r-type]]) (do meta-monad [g!slot (gensym "")] (return [r-slot-name r-idx g!slot])))) (zip2 tags (enumerate members)))] - (let [pattern (record$ (list;map (: (-> [Name Nat Code] [Code Code]) + (let [pattern (record$ (list@map (: (-> [Name Nat Code] [Code Code]) (function (_ [r-slot-name r-idx r-var]) [(tag$ r-slot-name) r-var])) pattern')) - output (record$ (list;map (: (-> [Name Nat Code] [Code Code]) + output (record$ (list@map (: (-> [Name Nat Code] [Code Code]) (function (_ [r-slot-name r-idx r-var]) [(tag$ r-slot-name) (if (n/= idx r-idx) @@ -4999,23 +4999,23 @@ _ (do meta-monad - [bindings (monad;map meta-monad + [bindings (monad@map meta-monad (: (-> Code (Meta Code)) (function (_ _) (gensym "temp"))) slots) #let [pairs (zip2 slots bindings) - update-expr (list;fold (: (-> [Code Code] Code Code) + update-expr (list@fold (: (-> [Code Code] Code Code) (function (_ [s b] v) (` (..set@ (~ s) (~ v) (~ b))))) value - (list;reverse pairs)) - [_ accesses'] (list;fold (: (-> [Code Code] [Code (List (List Code))] [Code (List (List Code))]) + (list@reverse pairs)) + [_ accesses'] (list@fold (: (-> [Code Code] [Code (List (List Code))] [Code (List (List Code))]) (function (_ [new-slot new-binding] [old-record accesses']) [(` (get@ (~ new-slot) (~ new-binding))) (#Cons (list new-binding old-record) accesses')])) [record (: (List (List Code)) #Nil)] pairs) - accesses (list;join (list;reverse accesses'))]] + accesses (list@join (list@reverse accesses'))]] (wrap (list (` (let [(~+ accesses)] (~ update-expr))))))) @@ -5055,19 +5055,19 @@ (case (resolve-struct-type type) (#Some members) (do meta-monad - [pattern' (monad;map meta-monad + [pattern' (monad@map meta-monad (: (-> [Name [Nat Type]] (Meta [Name Nat Code])) (function (_ [r-slot-name [r-idx r-type]]) (do meta-monad [g!slot (gensym "")] (return [r-slot-name r-idx g!slot])))) (zip2 tags (enumerate members)))] - (let [pattern (record$ (list;map (: (-> [Name Nat Code] [Code Code]) + (let [pattern (record$ (list@map (: (-> [Name Nat Code] [Code Code]) (function (_ [r-slot-name r-idx r-var]) [(tag$ r-slot-name) r-var])) pattern')) - output (record$ (list;map (: (-> [Name Nat Code] [Code Code]) + output (record$ (list@map (: (-> [Name Nat Code] [Code Code]) (function (_ [r-slot-name r-idx r-var]) [(tag$ r-slot-name) (if (n/= idx r-idx) @@ -5115,7 +5115,7 @@ " (-> (List Type) Type Type)" ..new-line " (case type" ..new-line " (#.Primitive name params)" ..new-line - " (#.Primitive name (list;map (beta-reduce env) params))" + " (#.Primitive name (list@map (beta-reduce env) params))" __paragraph " (^template [<tag>]" ..new-line " (<tag> left right)" ..new-line @@ -5149,17 +5149,17 @@ branches)) (case (: (Maybe (List Code)) (do maybe-monad - [bindings' (monad;map maybe-monad get-short bindings) - data' (monad;map maybe-monad tuple->list data)] - (if (every? (n/= (list;size bindings')) (list;map list;size data')) + [bindings' (monad@map maybe-monad get-short bindings) + data' (monad@map maybe-monad tuple->list data)] + (if (every? (n/= (list@size bindings')) (list@map list@size data')) (let [apply (: (-> RepEnv (List Code)) - (function (_ env) (list;map (apply-template env) templates)))] + (function (_ env) (list@map (apply-template env) templates)))] (|> data' (join-map (compose apply (make-env bindings'))) wrap)) #None))) (#Some output) - (return (list;compose output branches)) + (return (list@compose output branches)) #None (fail "Wrong syntax for ^template")) @@ -5193,14 +5193,14 @@ (^template [<tag>] [[_ _ column] (<tag> parts)] - (list;fold n/min column (list;map find-baseline-column parts))) + (list@fold n/min column (list@map find-baseline-column parts))) ([#Form] [#Tuple]) [[_ _ column] (#Record pairs)] - (list;fold n/min column - (list;compose (list;map (|>> first find-baseline-column) pairs) - (list;map (|>> second find-baseline-column) pairs))) + (list@fold n/min column + (list@compose (list@map (|>> first find-baseline-column) pairs) + (list@map (|>> second find-baseline-column) pairs))) )) (type: Doc-Fragment @@ -5216,9 +5216,9 @@ _ (#Doc-Example code))) -(def: (text;encode original) +(def: (text@encode original) (-> Text Text) - ($_ text;compose ..double-quote original ..double-quote)) + ($_ text@compose ..double-quote original ..double-quote)) (do-template [<name> <extension> <doc>] [(def: #export (<name> value) @@ -5230,9 +5230,9 @@ [dec "lux i64 -" "Decrement function."] ) -(def: tag;encode +(def: tag@encode (-> Name Text) - (|>> name;encode (text;compose "#"))) + (|>> name@encode (text@compose "#"))) (def: (repeat n x) (All [a] (-> Int a (List a))) @@ -5243,18 +5243,18 @@ (def: (cursor-padding baseline [_ old-line old-column] [_ new-line new-column]) (-> Nat Cursor Cursor Text) (if (n/= old-line new-line) - (text;join-with "" (repeat (.int (n/- old-column new-column)) " ")) - (let [extra-lines (text;join-with "" (repeat (.int (n/- old-line new-line)) ..new-line)) - space-padding (text;join-with "" (repeat (.int (n/- baseline new-column)) " "))] - (text;compose extra-lines space-padding)))) + (text@join-with "" (repeat (.int (n/- old-column new-column)) " ")) + (let [extra-lines (text@join-with "" (repeat (.int (n/- old-line new-line)) ..new-line)) + space-padding (text@join-with "" (repeat (.int (n/- baseline new-column)) " "))] + (text@compose extra-lines space-padding)))) -(def: (text;size x) +(def: (text@size x) (-> Text Nat) ("lux text size" x)) (def: (update-cursor [file line column] code-text) (-> Cursor Text Cursor) - [file line (n/+ column (text;size code-text))]) + [file line (n/+ column (text@size code-text))]) (def: (delim-update-cursor [file line column]) (-> Cursor Cursor) @@ -5262,7 +5262,7 @@ (def: rejoin-all-pairs (-> (List [Code Code]) (List Code)) - (|>> (list;map rejoin-pair) list;join)) + (|>> (list@map rejoin-pair) list@join)) (def: (doc-example->Text prev-cursor baseline example) (-> Cursor Nat Code [Cursor Text]) @@ -5271,25 +5271,25 @@ [new-cursor (<tag> value)] (let [as-text (<encode> value)] [(update-cursor new-cursor as-text) - (text;compose (cursor-padding baseline prev-cursor new-cursor) + (text@compose (cursor-padding baseline prev-cursor new-cursor) as-text)])) - ([#Bit bit;encode] - [#Nat nat;encode] - [#Int int;encode] - [#Frac frac;encode] - [#Text text;encode] - [#Identifier name;encode] - [#Tag tag;encode]) + ([#Bit bit@encode] + [#Nat nat@encode] + [#Int int@encode] + [#Frac frac@encode] + [#Text text@encode] + [#Identifier name@encode] + [#Tag tag@encode]) (^template [<tag> <open> <close> <prep>] [group-cursor (<tag> parts)] - (let [[group-cursor' parts-text] (list;fold (function (_ part [last-cursor text-accum]) + (let [[group-cursor' parts-text] (list@fold (function (_ part [last-cursor text-accum]) (let [[part-cursor part-text] (doc-example->Text last-cursor baseline part)] - [part-cursor (text;compose text-accum part-text)])) + [part-cursor (text@compose text-accum part-text)])) [(delim-update-cursor group-cursor) ""] (<prep> parts))] [(delim-update-cursor group-cursor') - ($_ text;compose (cursor-padding baseline prev-cursor group-cursor) + ($_ text@compose (cursor-padding baseline prev-cursor group-cursor) <open> parts-text <close>)])) @@ -5310,15 +5310,15 @@ (case fragment (#Doc-Comment comment) (|> comment - (text;split-all-with ..new-line) - (list;map (function (_ line) ($_ text;compose "## " line ..new-line))) - (text;join-with "")) + (text@split-all-with ..new-line) + (list@map (function (_ line) ($_ text@compose "## " line ..new-line))) + (text@join-with "")) (#Doc-Example example) (let [baseline (find-baseline-column example) [cursor _] example [_ text] (doc-example->Text (with-baseline baseline cursor) baseline example)] - (text;compose text __paragraph)))) + (text@compose text __paragraph)))) (macro: #export (doc tokens) {#.doc (text$ ($_ "lux text concat" @@ -5334,8 +5334,8 @@ " x)))"))} (return (list (` [(~ cursor-code) (#.Text (~ (|> tokens - (list;map (|>> identify-doc-fragment doc-fragment->Text)) - (text;join-with "") + (list@map (|>> identify-doc-fragment doc-fragment->Text)) + (text@join-with "") text$)))])))) (def: (interleave xs ys) @@ -5356,7 +5356,7 @@ (-> Type Code) (case type (#Primitive name params) - (` (#.Primitive (~ (text$ name)) (~ (untemplate-list (list;map type-to-code params))))) + (` (#.Primitive (~ (text$ name)) (~ (untemplate-list (list@map type-to-code params))))) (^template [<tag>] (<tag> left right) @@ -5372,7 +5372,7 @@ (^template [<tag>] (<tag> env type) - (let [env' (untemplate-list (list;map type-to-code env))] + (let [env' (untemplate-list (list@map type-to-code env))] (` (<tag> (~ env') (~ (type-to-code type)))))) ([#.UnivQ] [#.ExQ]) @@ -5411,23 +5411,23 @@ (case ?params (#.Some [name bindings body]) (let [pairs (as-pairs bindings) - vars (list;map first pairs) - inits (list;map second pairs)] + vars (list@map first pairs) + inits (list@map second pairs)] (if (every? identifier? inits) (do meta-monad [inits' (: (Meta (List Name)) - (case (monad;map maybe-monad get-name inits) + (case (monad@map maybe-monad get-name inits) (#Some inits') (return inits') #None (fail "Wrong syntax for loop"))) - init-types (monad;map meta-monad find-type inits') + init-types (monad@map meta-monad find-type inits') expected get-expected-type] - (return (list (` (("lux check" (-> (~+ (list;map type-to-code init-types)) + (return (list (` (("lux check" (-> (~+ (list@map type-to-code init-types)) (~ (type-to-code expected))) (function ((~ name) (~+ vars)) (~ body))) (~+ inits)))))) (do meta-monad - [aliases (monad;map meta-monad + [aliases (monad@map meta-monad (: (-> Code (Meta Code)) (function (_ _) (gensym ""))) inits)] @@ -5450,7 +5450,7 @@ (case (: (Maybe [Name (List Name)]) (do maybe-monad [hslot (get-tag hslot') - tslots (monad;map maybe-monad get-tag tslots')] + tslots (monad@map maybe-monad get-tag tslots')] (wrap [hslot tslots]))) (#Some slots) (return slots) @@ -5459,14 +5459,14 @@ (fail "Wrong syntax for ^slots"))) #let [[hslot tslots] slots] hslot (normalize hslot) - tslots (monad;map meta-monad normalize tslots) + tslots (monad@map meta-monad normalize tslots) output (resolve-tag hslot) g!_ (gensym "_") #let [[idx tags exported? type] output - slot-pairings (list;map (: (-> Name [Text Code]) + slot-pairings (list@map (: (-> Name [Text Code]) (function (_ [module name]) [name (identifier$ ["" name])])) (list& hslot tslots)) - pattern (record$ (list;map (: (-> Name [Code Code]) + pattern (record$ (list@map (: (-> Name [Code Code]) (function (_ [module name]) (let [tag (tag$ [module name])] (case (get name slot-pairings) @@ -5485,22 +5485,22 @@ (#Some (list target)) [_ (#Identifier [prefix name])] - (if (and (text;= "" prefix) - (text;= label name)) + (if (and (text@= "" prefix) + (text@= label name)) (#Some tokens) (#Some (list target))) (^template [<tag>] [cursor (<tag> elems)] (do maybe-monad - [placements (monad;map maybe-monad (place-tokens label tokens) elems)] - (wrap (list [cursor (<tag> (list;join placements))])))) + [placements (monad@map maybe-monad (place-tokens label tokens) elems)] + (wrap (list [cursor (<tag> (list@join placements))])))) ([#Tuple] [#Form]) [cursor (#Record pairs)] (do maybe-monad - [=pairs (monad;map maybe-monad + [=pairs (monad@map maybe-monad (: (-> [Code Code] (Maybe [Code Code])) (function (_ [slot value]) (do maybe-monad @@ -5601,13 +5601,13 @@ ["Text" Text text$]) _ - (fail (text;compose "Cannot anti-quote type: " (name;encode name)))))) + (fail (text@compose "Cannot anti-quote type: " (name@encode name)))))) (def: (anti-quote token) (-> Code (Meta Code)) (case token [_ (#Identifier [def-prefix def-name])] - (if (text;= "" def-prefix) + (if (text@= "" def-prefix) (do meta-monad [current-module current-module-name] (anti-quote-def [current-module def-name])) @@ -5616,14 +5616,14 @@ (^template [<tag>] [meta (<tag> parts)] (do meta-monad - [=parts (monad;map meta-monad anti-quote parts)] + [=parts (monad@map meta-monad anti-quote parts)] (wrap [meta (<tag> =parts)]))) ([#Form] [#Tuple]) [meta (#Record pairs)] (do meta-monad - [=pairs (monad;map meta-monad + [=pairs (monad@map meta-monad (: (-> [Code Code] (Meta [Code Code])) (function (_ [slot value]) (do meta-monad @@ -5667,12 +5667,12 @@ (#Cons init extras) (do meta-monad - [extras' (monad;map meta-monad case-level^ extras)] + [extras' (monad@map meta-monad case-level^ extras)] (wrap [init extras'])))) (def: (multi-level-case$ g!_ [[init-pattern levels] body]) (-> Code [Multi-Level-Case Code] (List Code)) - (let [inner-pattern-body (list;fold (function (_ [calculation pattern] success) + (let [inner-pattern-body (list@fold (function (_ [calculation pattern] success) (` (case (~ calculation) (~ pattern) (~ success) @@ -5680,7 +5680,7 @@ (~ g!_) #.None))) (` (#.Some (~ body))) - (: (List [Code Code]) (list;reverse levels)))] + (: (List [Code Code]) (list@reverse levels)))] (list init-pattern inner-pattern-body))) (macro: #export (^multi tokens) @@ -5688,7 +5688,7 @@ "Useful in situations where the result of a branch depends on further refinements on the values being matched." "For example:" (case (split (size static) uri) - (^multi (#.Some [chunk uri']) [(text;= static chunk) #1]) + (^multi (#.Some [chunk uri']) [(text@= static chunk) #1]) (match-uri endpoint? parts' uri') _ @@ -5697,7 +5697,7 @@ "Short-cuts can be taken when using bit tests." "The example above can be rewritten as..." (case (split (size static) uri) - (^multi (#.Some [chunk uri']) (text;= static chunk)) + (^multi (#.Some [chunk uri']) (text@= static chunk)) (match-uri endpoint? parts' uri') _ @@ -5731,8 +5731,8 @@ ## 'wrong-syntax-error' for easier maintenance of the error-messages. (def: wrong-syntax-error (-> Name Text) - (|>> name;encode - (text;compose "Wrong syntax for "))) + (|>> name@encode + (text@compose "Wrong syntax for "))) (macro: #export (name-of tokens) {#.doc (doc "Given an identifier or a tag, gives back a 2 tuple with the prefix and name parts, both as Text." @@ -5786,7 +5786,7 @@ "In the example below, 0 corresponds to the 'a' variable." (def: #export (from-list list) (All [a] (-> (List a) (Row a))) - (list;fold add + (list@fold add (: (Row ($ 0)) empty) list)))} @@ -5794,12 +5794,12 @@ (^ (list [_ (#Nat idx)])) (do meta-monad [stvs get-scope-type-vars] - (case (list-at idx (list;reverse stvs)) + (case (list-at idx (list@reverse stvs)) (#Some var-id) (wrap (list (` (#Ex (~ (nat$ var-id)))))) #None - (fail (text;compose "Indexed-type does not exist: " (nat;encode idx))))) + (fail (text@compose "Indexed-type does not exist: " (nat@encode idx))))) _ (fail (..wrong-syntax-error (name-of ..$))))) @@ -5818,7 +5818,7 @@ (macro: #export (^@ tokens) {#.doc (doc "Allows you to simultaneously bind and de-structure a value." (def: (hash (^@ set [Hash<a> _])) - (list;fold (function (_ elem acc) (n/+ (:: Hash<a> hash elem) acc)) + (list@fold (function (_ elem acc) (n/+ (:: Hash<a> hash elem) acc)) 0 (to-list set))))} (case tokens @@ -5905,7 +5905,7 @@ (case tokens (^ (list& [_ (#Form (list& [_ (#Identifier ["" name])] args'))] tokens')) (do meta-monad - [args (monad;map meta-monad + [args (monad@map meta-monad (function (_ arg') (case arg' [_ (#Identifier ["" arg-name])] @@ -5977,7 +5977,7 @@ 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 (` ((~' ~) (~ (identifier$ ["" arg]))))]) args)] this-module current-module-name] @@ -5985,9 +5985,9 @@ ((~ (identifier$ ["" name])) (~ g!tokens) (~ g!compiler)) (~ anns) (case (~ g!tokens) - (^ (list (~+ (list;map (|>> [""] identifier$) args)))) + (^ (list (~+ (list@map (|>> [""] identifier$) args)))) (#.Right [(~ g!compiler) - (list (~+ (list;map (function (_ template) + (list (~+ (list@map (function (_ template) (` (`' (~ (replace-syntax rep-env template))))) input-templates)))]) @@ -6024,7 +6024,7 @@ (#Cons [key value] options') (case key (^multi [_ (#Text platform)] - (text;= target platform)) + (text@= target platform)) (#Some value) _ @@ -6041,7 +6041,7 @@ (wrap (list pick)) #None - (fail ($_ text;compose "No code for target platform: " target))) + (fail ($_ text@compose "No code for target platform: " target))) (^ (list [_ (#Record options)] default)) (wrap (list (..default default (pick-for-target target options)))) @@ -6069,24 +6069,24 @@ (^template [<tag>] [ann (<tag> parts)] (do meta-monad - [=parts (monad;map meta-monad label-code parts)] - (wrap [(list;fold list;compose (list) (list;map left =parts)) - [ann (<tag> (list;map right =parts))]]))) + [=parts (monad@map meta-monad label-code parts)] + (wrap [(list@fold list@compose (list) (list@map left =parts)) + [ann (<tag> (list@map right =parts))]]))) ([#Form] [#Tuple]) [ann (#Record kvs)] (do meta-monad - [=kvs (monad;map meta-monad + [=kvs (monad@map meta-monad (function (_ [key val]) (do meta-monad [=key (label-code key) =val (label-code val) #let [[key-labels key-labelled] =key [val-labels val-labelled] =val]] - (wrap [(list;compose key-labels val-labels) [key-labelled val-labelled]]))) + (wrap [(list@compose key-labels val-labels) [key-labelled val-labelled]]))) kvs)] - (wrap [(list;fold list;compose (list) (list;map left =kvs)) - [ann (#Record (list;map right =kvs))]])) + (wrap [(list@fold list@compose (list) (list@map left =kvs)) + [ann (#Record (list@map right =kvs))]])) _ (return [(list) code]))) @@ -6098,8 +6098,8 @@ [=raw (label-code raw) #let [[labels labelled] =raw]] (wrap (list (` (with-expansions [(~+ (|> labels - (list;map (function (_ [label expansion]) (list label expansion))) - list;join))] + (list@map (function (_ [label expansion]) (list label expansion))) + list@join))] (~ labelled)))))) _ @@ -6138,7 +6138,7 @@ [_ (#Record fields)] (do meta-monad - [=fields (monad;map meta-monad + [=fields (monad@map meta-monad (function (_ [key value]) (do meta-monad [=key (untemplate-pattern key) @@ -6156,17 +6156,17 @@ (^template [<tag>] [_ (<tag> elems)] - (case (list;reverse elems) + (case (list@reverse elems) (#Cons [_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] inits) (do meta-monad - [=inits (monad;map meta-monad untemplate-pattern (list;reverse inits)) + [=inits (monad@map meta-monad untemplate-pattern (list@reverse inits)) g!meta (gensym "g!meta")] (wrap (` [(~ g!meta) (<tag> (~ (untemplate-list& spliced =inits)))]))) _ (do meta-monad - [=elems (monad;map meta-monad untemplate-pattern elems) + [=elems (monad@map meta-monad untemplate-pattern elems) g!meta (gensym "g!meta")] (wrap (` [(~ g!meta) (<tag> (~ (untemplate-list =elems)))]))))) ([#Tuple] [#Form]) @@ -6237,9 +6237,9 @@ (-> Cursor Text) (let [separator ", " fields ($_ "lux text concat" - (text;encode file) separator - (nat;encode line) separator - (nat;encode column))] + (text@encode file) separator + (nat@encode line) separator + (nat@encode column))] ($_ "lux text concat" "[" fields "]"))) (do-template [<zero> <one>] diff --git a/stdlib/source/lux/host/python.lux b/stdlib/source/lux/host/python.lux index afdb923fc..134e35798 100644 --- a/stdlib/source/lux/host/python.lux +++ b/stdlib/source/lux/host/python.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Code not or and list if cond int) + [lux (#- Code not or and list if cond int comment) [control pipe] [data @@ -72,9 +72,9 @@ (-> Text SVar) (|>> :abstraction)) - (do-template [<name> <kind> <prefix>] + (do-template [<name> <brand> <prefix>] [(def: #export <name> - (-> SVar (Var <kind>)) + (-> SVar (Var <brand>)) (|>> :representation (format <prefix>) :abstraction))] [poly Poly "*"] @@ -95,6 +95,10 @@ (-> Int Literal) (|>> %i :abstraction)) + (def: #export (long value) + (-> Int Literal) + (:abstraction (format (%i value) "L"))) + (def: #export float (-> Frac Literal) (`` (|>> (cond> (~~ (do-template [<lux> <python>] @@ -110,9 +114,28 @@ [%f]) :abstraction))) + (def: sanitize + (-> Text Text) + (`` (|>> (~~ (do-template [<find> <replace>] + [(text.replace-all <find> <replace>)] + + ["\" "\\"] + [text.tab "\t"] + [text.vertical-tab "\v"] + [text.null "\0"] + [text.back-space "\b"] + [text.form-feed "\f"] + [text.new-line "\n"] + [text.carriage-return "\r"] + [text.double-quote (format "\" text.double-quote)] + )) + ))) + (def: #export string (-> Text Literal) - (|>> (text.enclose' text.double-quote) :abstraction)) + (|>> ..sanitize + (text.enclose [text.double-quote text.double-quote]) + :abstraction)) (def: (composite-literal left-delimiter right-delimiter entry-serializer) (All [a] @@ -122,7 +145,9 @@ (<| :abstraction ..expression (format left-delimiter - (|> entries (list@map entry-serializer) (text.join-with ",")) + (|> entries + (list@map entry-serializer) + (text.join-with ", ")) right-delimiter)))) (do-template [<name> <pre> <post>] @@ -154,9 +179,9 @@ (-> (Expression Any) (List (Expression Any)) (Computation Any)) (<| :abstraction ..expression - (format (:representation func) "(" (text.join-with "," (list@map ..code args)) ")"))) + (format (:representation func) "(" (text.join-with ", " (list@map ..code args)) ")"))) - (do-template [<name> <kind> <prefix>] + (do-template [<name> <brand> <prefix>] [(def: (<name> var) (-> (Expression Any) Text) (format <prefix> (:representation var)))] @@ -324,7 +349,7 @@ (..nest (:representation body!)) (|> excepts (list@map (function (_ [classes exception catch!]) - (format text.new-line "except (" (text.join-with "," (list@map ..code classes)) + (format text.new-line "except (" (text.join-with ", " (list@map ..code classes)) ") as " (:representation exception) ":" (..nest (:representation catch!))))) (text.join-with ""))))) @@ -344,12 +369,17 @@ (-> SVar (List (Ex [k] (Var k))) (Statement Any) (Statement Any)) (:abstraction (format "def " (:representation name) - "(" (|> args (list@map ..code) (text.join-with ",")) "):" + "(" (|> args (list@map ..code) (text.join-with ", ")) "):" (..nest (:representation body))))) (def: #export (import module-name) (-> Text (Statement Any)) (:abstraction (format "import " module-name))) + + (def: #export (comment commentary on) + (All [brand] (-> Text (Code brand) (Code brand))) + (:abstraction (format "# " (..sanitize commentary) text.new-line + (:representation on)))) ) (def: #export (cond clauses else!) diff --git a/stdlib/source/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/lux/tool/compiler/meta/packager/script.lux index ac4582346..57e0800b1 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager/script.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager/script.lux @@ -1,5 +1,7 @@ (.module: [lux #* + [control + [pipe (#+ case>)]] [data ["." product] ["." text @@ -28,9 +30,14 @@ (:coerce (List [Name _.Statement])) (list@map product.right)))) list@join - (list@fold (function (_ post! pre!) - (_.then pre! post!)) - _.use-strict) - (: _.Statement) - _.code - encoding.to-utf8)) + (case> (#.Cons head tail) + (|> (list@fold (function (_ post! pre!) + (_.then pre! post!)) + head + tail) + (: _.Statement) + _.code + encoding.to-utf8) + + #.Nil + (encoding.to-utf8 "")))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux index b5ef432f6..0e3864bd0 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux @@ -746,5 +746,7 @@ (Operation Any) (///.with-buffer (do ////.monad - [_ (///.save! ["" ..prefix] ..runtime)] + [_ (///.save! ["" ..prefix] ($_ _.then + _.use-strict + ..runtime))] (///.save-buffer! ..artifact)))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux index 48fd005fb..4cfc7a1e6 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux @@ -29,14 +29,14 @@ Bundle (<| (bundle.prefix "i64") (|> bundle.empty - (bundle.install "and" (binary (product.uncurry _.bit-and))) - (bundle.install "or" (binary (product.uncurry _.bit-or))) - (bundle.install "xor" (binary (product.uncurry _.bit-xor))) - (bundle.install "left-shift" (binary (|>> (product.uncurry _.bit-shl) ///runtime.i64//64))) - (bundle.install "logical-right-shift" (binary (product.uncurry (function.flip ///runtime.i64//logic-right-shift)))) - (bundle.install "arithmetic-right-shift" (binary (product.uncurry (function.flip _.bit-shr)))) - (bundle.install "=" (binary (product.uncurry _.=))) - (bundle.install "+" (binary (product.uncurry _.+))) + (bundle.install "and" (binary (product.uncurry (function.flip _.bit-and)))) + (bundle.install "or" (binary (product.uncurry (function.flip _.bit-or)))) + (bundle.install "xor" (binary (product.uncurry (function.flip _.bit-xor)))) + (bundle.install "left-shift" (binary (function.compose ///runtime.i64//64 (product.uncurry _.bit-shl)))) + (bundle.install "logical-right-shift" (binary (product.uncurry ///runtime.i64//logic-right-shift))) + (bundle.install "arithmetic-right-shift" (binary (product.uncurry _.bit-shr))) + (bundle.install "=" (binary (product.uncurry (function.flip _.=)))) + (bundle.install "+" (binary (product.uncurry (function.flip _.+)))) (bundle.install "-" (binary (product.uncurry (function.flip _.-)))) ))) @@ -59,7 +59,7 @@ (<| (bundle.prefix "int") (|> bundle.empty (bundle.install "<" (binary (product.uncurry (function.flip _.<)))) - (bundle.install "*" (binary (product.uncurry _.*))) + (bundle.install "*" (binary (product.uncurry (function.flip _.*)))) (bundle.install "/" (binary (product.uncurry (function.flip _./)))) (bundle.install "%" (binary (product.uncurry (function.flip _.%)))) (bundle.install "frac" (unary _.float/1)) @@ -69,12 +69,12 @@ Bundle (<| (bundle.prefix "frac") (|> bundle.empty - (bundle.install "+" (binary (product.uncurry _.+))) + (bundle.install "+" (binary (product.uncurry (function.flip _.+)))) (bundle.install "-" (binary (product.uncurry (function.flip _.-)))) - (bundle.install "*" (binary (product.uncurry _.*))) + (bundle.install "*" (binary (product.uncurry (function.flip _.*)))) (bundle.install "/" (binary (product.uncurry (function.flip _./)))) (bundle.install "%" (binary (product.uncurry (function.flip _.%)))) - (bundle.install "=" (binary (product.uncurry _.=))) + (bundle.install "=" (binary (product.uncurry (function.flip _.=)))) (bundle.install "<" (binary (product.uncurry (function.flip _.<)))) (bundle.install "smallest" (nullary frac//smallest)) (bundle.install "min" (nullary frac//min)) @@ -99,7 +99,7 @@ Bundle (<| (bundle.prefix "text") (|> bundle.empty - (bundle.install "=" (binary (product.uncurry _.=))) + (bundle.install "=" (binary (product.uncurry (function.flip _.=)))) (bundle.install "<" (binary (product.uncurry (function.flip _.<)))) (bundle.install "concat" (binary (product.uncurry (function.flip _.+)))) (bundle.install "index" (trinary text//index)) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/primitive.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/primitive.lux index 1ddd3950e..33b9b7781 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/python/primitive.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/python/primitive.lux @@ -16,7 +16,7 @@ (def: #export i64 (-> (I64 Any) (Expression Any)) - (|>> .int _.int)) + (|>> .int _.long)) (def: #export f64 (-> Frac (Expression Any)) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux index e3a8a4537..564bbdb35 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux @@ -33,10 +33,6 @@ [Bundle ///.Bundle] ) -(def: #export variant-tag-field "_lux_tag") -(def: #export variant-flag-field "_lux_flag") -(def: #export variant-value-field "_lux_value") - (def: prefix Text "LuxRuntime") (def: #export unit (_.string synthesis.unit)) @@ -49,9 +45,7 @@ (def: (variant' tag last? value) (-> (Expression Any) (Expression Any) (Expression Any) (Computation Any)) - (_.dict (list [(_.string ..variant-tag-field) tag] - [(_.string ..variant-flag-field) last?] - [(_.string ..variant-value-field) value]))) + (_.tuple (list tag last? value))) (def: #export (variant tag last? value) (-> Nat Bit (Expression Any) (Computation Any)) @@ -83,7 +77,7 @@ (def: (feature name definition) (-> SVar (-> SVar (Statement Any)) (Statement Any)) - (_.def name (list) (definition name))) + (definition name)) (syntax: #export (with-vars {vars (s.tuple (p.some s.local-identifier))} body) @@ -216,15 +210,15 @@ ## Must slice (_.return (_.slice-from index product)))))) -(runtime: (sum//get sum wantedTag wantsLast) +(runtime: (sum//get sum wantsLast wantedTag) (let [no-match! (_.return _.none) - sum-tag (_.nth (_.string ..variant-tag-field) sum) - sum-flag (_.nth (_.string ..variant-flag-field) sum) - sum-value (_.nth (_.string ..variant-value-field) sum) + sum-tag (_.nth (_.int +0) sum) + sum-flag (_.nth (_.int +1) sum) + sum-value (_.nth (_.int +2) sum) is-last? (_.= (_.string "") sum-flag) test-recursion! (_.if is-last? ## Must recurse. - (_.return (sum//get sum-value (_.- sum-tag wantedTag) wantsLast)) + (_.return (sum//get sum-value wantsLast (_.- sum-tag wantedTag))) no-match!)] (_.cond (list [(_.= sum-tag wantedTag) (_.if (_.= wantsLast sum-flag) @@ -312,14 +306,7 @@ ) (runtime: (text//clip @text @from @to) - (with-vars [length] - ($_ _.then - (_.set (list length) (_.len/1 @text)) - (_.if ($_ _.and - (|> @to (within? length)) - (|> @from (up-to? @to))) - (_.return (..some (|> @text (_.slice @from (inc @to))))) - (_.return ..none))))) + (_.return (|> @text (_.slice @from (inc @to))))) (runtime: (text//char text idx) (_.if (|> idx (within? (_.len/1 text))) @@ -388,5 +375,6 @@ (Operation Any) (///.with-buffer (do ////.monad - [_ (///.save! ["" ..prefix] ..runtime)] + [_ (///.save! ["" ..prefix] (<| (_.comment "-*- coding: utf-8 -*-") + ..runtime))] (///.save-buffer! ..artifact)))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/structure.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/structure.lux index 1415251df..6daf5e532 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/python/structure.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/python/structure.lux @@ -24,7 +24,7 @@ _ (do ////.monad [elemsT+ (monad.map @ generate elemsS+)] - (wrap (_.tuple elemsT+))))) + (wrap (_.list elemsT+))))) (def: #export (variant generate [lefts right? valueS]) (-> Phase (Variant Synthesis) (Operation (Expression Any))) diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux index 841846351..7da1a41c7 100644 --- a/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux @@ -244,9 +244,18 @@ synthesis-storage) (list inputS exprS)) + (^ (/.branch/if [testS thenS elseS])) + (list@fold for-synthesis synthesis-storage (list testS thenS elseS)) + (^ (/.branch/case [inputS pathS])) (|> synthesis-storage (for-synthesis inputS) (for-path pathS)) + (^ (/.loop/scope [start initsS+ iterationS])) + (list@fold for-synthesis synthesis-storage (#.Cons iterationS initsS+)) + + (^ (/.loop/recur replacementsS+)) + (list@fold for-synthesis synthesis-storage replacementsS+) + (#/.Extension [extension argsS]) (list@fold for-synthesis synthesis-storage argsS) |