aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2019-03-27 23:26:22 -0400
committerEduardo Julian2019-03-27 23:26:22 -0400
commit023b761c13744ccfe65090b0f4e10640093faa03 (patch)
tree30709a91846a271c3e9e1ecfb4ca61c4a0003b8f
parent8df108600f6791237d0079af6b582e6cb306906d (diff)
The Python compiler is alive.
Diffstat (limited to '')
-rw-r--r--lux-python/source/program.lux150
-rw-r--r--stdlib/source/lux.lux726
-rw-r--r--stdlib/source/lux/host/python.lux48
-rw-r--r--stdlib/source/lux/tool/compiler/meta/packager/script.lux19
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux26
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/python/primitive.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux32
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/python/structure.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/phase/synthesis/case.lux9
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)