aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2017-12-01 23:40:15 -0400
committerEduardo Julian2017-12-01 23:40:15 -0400
commit414c0a1a1f53322d8f4c11230ded98c5b83b6310 (patch)
tree5ac65a4b63731c1c457fd079a26735f1af27846b /stdlib
parent0ea9403e482b7f01df9e634ae2533b20ef56a9ab (diff)
- Changed some of the syntax for macro templating.
- "gensym" now produces Ident instead of Code.
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux.lux585
-rw-r--r--stdlib/source/lux/cli.lux16
-rw-r--r--stdlib/source/lux/concurrency/actor.lux68
-rw-r--r--stdlib/source/lux/concurrency/space.lux6
-rw-r--r--stdlib/source/lux/control/concatenative.lux55
-rw-r--r--stdlib/source/lux/control/cont.lux4
-rw-r--r--stdlib/source/lux/control/contract.lux6
-rw-r--r--stdlib/source/lux/control/exception.lux2
-rw-r--r--stdlib/source/lux/control/pipe.lux48
-rw-r--r--stdlib/source/lux/data/coll/list.lux32
-rw-r--r--stdlib/source/lux/data/coll/sequence.lux2
-rw-r--r--stdlib/source/lux/data/coll/stream.lux13
-rw-r--r--stdlib/source/lux/data/coll/tree/rose.lux2
-rw-r--r--stdlib/source/lux/data/format/json.lux4
-rw-r--r--stdlib/source/lux/data/lazy.lux7
-rw-r--r--stdlib/source/lux/data/text/format.lux2
-rw-r--r--stdlib/source/lux/data/text/regex.lux21
-rw-r--r--stdlib/source/lux/host.js.lux4
-rw-r--r--stdlib/source/lux/host.jvm.lux137
-rw-r--r--stdlib/source/lux/lang/type.lux6
-rw-r--r--stdlib/source/lux/macro.lux16
-rw-r--r--stdlib/source/lux/macro/poly.lux32
-rw-r--r--stdlib/source/lux/macro/poly/eq.lux16
-rw-r--r--stdlib/source/lux/macro/poly/functor.lux14
-rw-r--r--stdlib/source/lux/macro/poly/json.lux32
-rw-r--r--stdlib/source/lux/macro/syntax.lux18
-rw-r--r--stdlib/source/lux/test.lux32
-rw-r--r--stdlib/source/lux/type/abstract.lux20
-rw-r--r--stdlib/source/lux/type/implicit.lux12
-rw-r--r--stdlib/source/lux/type/object.lux250
-rw-r--r--stdlib/source/lux/type/unit.lux8
31 files changed, 739 insertions, 731 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 4ec6e1ea1..e7326f34b 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -1064,7 +1064,7 @@
_
(fail "Wrong syntax for $'")}))
-(def:'' (map f xs)
+(def:'' (list/map f xs)
#Nil
(#UnivQ #Nil
(#UnivQ #Nil
@@ -1076,7 +1076,7 @@
#Nil
(#Cons x xs')
- (#Cons (f x) (map f xs'))}))
+ (#Cons (f x) (list/map f xs'))}))
(def:'' RepEnv
#Nil
@@ -1126,18 +1126,18 @@
syntax})
[meta (#Form parts)]
- [meta (#Form (map (replace-syntax reps) parts))]
+ [meta (#Form (list/map (replace-syntax reps) parts))]
[meta (#Tuple members)]
- [meta (#Tuple (map (replace-syntax reps) members))]
+ [meta (#Tuple (list/map (replace-syntax reps) members))]
[meta (#Record slots)]
- [meta (#Record (map ("lux check" (#Function (#Product Code Code) (#Product Code Code))
- (function'' [slot]
- ("lux case" slot
- {[k v]
- [(replace-syntax reps k) (replace-syntax reps v)]})))
- slots))]
+ [meta (#Record (list/map ("lux check" (#Function (#Product Code Code) (#Product Code Code))
+ (function'' [slot]
+ ("lux case" slot
+ {[k v]
+ [(replace-syntax reps k) (replace-syntax reps v)]})))
+ slots))]
_
syntax})
@@ -1148,20 +1148,20 @@
(#Function Code Code)
("lux case" code
{[_ (#Tuple members)]
- (tuple$ (map update-bounds members))
+ (tuple$ (list/map update-bounds members))
[_ (#Record pairs)]
- (record$ (map ("lux check" (#Function (#Product Code Code) (#Product Code Code))
- (function'' [pair]
- (let'' [name val] pair
- [name (update-bounds val)])))
- pairs))
+ (record$ (list/map ("lux check" (#Function (#Product Code Code) (#Product Code Code))
+ (function'' [pair]
+ (let'' [name val] pair
+ [name (update-bounds val)])))
+ pairs))
[_ (#Form (#Cons [_ (#Tag "lux" "Bound")] (#Cons [_ (#Nat idx)] #Nil)))]
(form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ ("lux nat +" +2 idx)) #Nil)))
[_ (#Form members)]
- (form$ (map update-bounds members))
+ (form$ (list/map update-bounds members))
_
code}))
@@ -1854,7 +1854,7 @@
(#Cons lastI inits)
(do Monad<Meta>
[lastO ("lux case" lastI
- {[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))]
+ {[_ (#Form (#Cons [[_ (#Symbol ["" "~+"])] (#Cons [spliced #Nil])]))]
(wrap spliced)
_
@@ -1864,7 +1864,7 @@
(monad/fold Monad<Meta>
(function' [leftI rightO]
("lux case" leftI
- {[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))]
+ {[_ (#Form (#Cons [[_ (#Symbol ["" "~+"])] (#Cons [spliced #Nil])]))]
(wrap (form$ (list (symbol$ ["lux" "splice-helper"])
spliced
rightO)))
@@ -1933,6 +1933,9 @@
[true [_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))]]
(return unquoted)
+ [true [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [ident #Nil])]))]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) ident))))
+
[true [_ (#Form (#Cons [[_ (#Symbol ["" "~'"])] (#Cons [keep-quoted #Nil])]))]]
(untemplate false subst keep-quoted)
@@ -1996,10 +1999,10 @@
(macro:' #export (` tokens)
(list [(tag$ ["lux" "doc"])
- (text$ "## Hygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms.
+ (text$ "## Hygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~+) must also be used as forms.
## All unprefixed macros will receive their parent module's prefix if imported; otherwise will receive the prefix of the module on which the quasi-quote is being used.
(` (def: (~ name)
- (function [(~@ args)]
+ (function [(~+ args)]
(~ body))))")])
("lux case" tokens
{(#Cons template #Nil)
@@ -2013,9 +2016,9 @@
(macro:' #export (`' tokens)
(list [(tag$ ["lux" "doc"])
- (text$ "## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms.
+ (text$ "## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~+) must also be used as forms.
(`' (def: (~ name)
- (function [(~@ args)]
+ (function [(~+ args)]
(~ body))))")])
("lux case" tokens
{(#Cons template #Nil)
@@ -2042,12 +2045,12 @@
(macro:' #export (|> tokens)
(list [(tag$ ["lux" "doc"])
(text$ "## Piping macro.
- (|> elems (map int/encode) (interpose \" \") (fold text/compose \"\"))
+ (|> elems (list/map int/encode) (interpose \" \") (fold text/compose \"\"))
## =>
(fold text/compose \"\"
(interpose \" \"
- (map int/encode elems)))")])
+ (list/map int/encode elems)))")])
("lux case" tokens
{(#Cons [init apps])
(return (list (list/fold ("lux check" (-> Code Code Code)
@@ -2070,12 +2073,12 @@
(macro:' #export (<| tokens)
(list [(tag$ ["lux" "doc"])
(text$ "## Reverse piping macro.
- (<| (fold text/compose \"\") (interpose \" \") (map int/encode) elems)
+ (<| (fold text/compose \"\") (interpose \" \") (list/map int/encode) elems)
## =>
(fold text/compose \"\"
(interpose \" \"
- (map int/encode elems)))")])
+ (list/map int/encode elems)))")])
("lux case" (list/reverse tokens)
{(#Cons [init apps])
(return (list (list/fold ("lux check" (-> Code Code Code)
@@ -2155,17 +2158,17 @@
template})
[meta (#Tuple elems)]
- [meta (#Tuple (map (apply-template env) elems))]
+ [meta (#Tuple (list/map (apply-template env) elems))]
[meta (#Form elems)]
- [meta (#Form (map (apply-template env) elems))]
+ [meta (#Form (list/map (apply-template env) elems))]
[meta (#Record members)]
- [meta (#Record (map ("lux check" (-> (& Code Code) (& Code Code))
- (function' [kv]
- (let' [[slot value] kv]
- [(apply-template env slot) (apply-template env value)])))
- members))]
+ [meta (#Record (list/map ("lux check" (-> (& Code Code) (& Code Code))
+ (function' [kv]
+ (let' [[slot value] kv]
+ [(apply-template env slot) (apply-template env value)])))
+ members))]
_
template}))
@@ -2203,10 +2206,10 @@
(monad/map Monad<Maybe> tuple->list data)]
{[(#Some bindings') (#Some data')]
(let' [apply ("lux check" (-> RepEnv ($' List Code))
- (function' [env] (map (apply-template env) templates)))
+ (function' [env] (list/map (apply-template env) templates)))
num-bindings (list/size bindings')]
(if (every? (function' [sample] ("lux nat =" num-bindings sample))
- (map list/size data'))
+ (list/map list/size data'))
(|> data'
(join-map (compose apply (make-env bindings')))
return)
@@ -2591,16 +2594,16 @@
(-> Code Code)
("lux case" type
{[_ (#Form (#Cons [_ (#Tag tag)] parts))]
- (form$ (#Cons [(tag$ tag) (map walk-type parts)]))
+ (form$ (#Cons [(tag$ tag) (list/map walk-type parts)]))
[_ (#Tuple members)]
- (` (& (~@ (map walk-type members))))
+ (` (& (~+ (list/map walk-type members))))
[_ (#Form (#Cons type-fn args))]
(list/fold ("lux check" (-> Code Code Code)
(function' [arg type-fn] (` (#.Apply (~ arg) (~ type-fn)))))
(walk-type type-fn)
- (map walk-type args))
+ (list/map walk-type args))
_
type}))
@@ -2677,8 +2680,8 @@
_
(fail "Wrong syntax for variant case.")})))
pairs)]
- (return [(` (& (~@ (map second members))))
- (#Some (map first members))]))
+ (return [(` (& (~+ (list/map second members))))
+ (#Some (list/map first members))]))
(#Cons type #Nil)
("lux case" type
@@ -2686,7 +2689,7 @@
(return [(` #.Unit) (#Some (list member-name))])
[_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))]
- (return [(` (& (~@ member-types))) (#Some (list member-name))])
+ (return [(` (& (~+ member-types))) (#Some (list member-name))])
_
(return [type #None])})
@@ -2704,20 +2707,20 @@
(return [member-name member-type])
[_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))]
- (return [member-name (` (& (~@ member-types)))])
+ (return [member-name (` (& (~+ member-types)))])
_
(fail "Wrong syntax for variant case.")})))
(list& case cases))]
- (return [(` (| (~@ (map second members))))
- (#Some (map first members))]))
+ (return [(` (| (~+ (list/map second members))))
+ (#Some (list/map first members))]))
_
(fail "Improper type-definition syntax")}))
(def:''' (gensym prefix state)
#Nil
- (-> Text ($' Meta Code))
+ (-> Text ($' Meta Ident))
("lux case" state
{{#info info #source source #current-module _ #modules modules
#scopes scopes #type-context types #host host
@@ -2729,7 +2732,7 @@
#seed (n/+ +1 seed) #expected expected
#cursor cursor
#scope-type-vars scope-type-vars}
- (symbol$ ["" ($_ text/compose "__gensym__" prefix (nat/encode seed))]))}))
+ ["" ($_ text/compose "__gensym__" prefix (nat/encode seed))])}))
(macro:' #export (Rec tokens)
(list [(tag$ ["lux" "doc"])
@@ -2795,7 +2798,7 @@
body
_
- (` (function' (~ name) [(~@ args)] (~ body)))})
+ (` (function' (~ name) [(~+ args)] (~ body)))})
body'' ("lux case" ?type
{(#Some type)
(` (: (~ type) (~ body')))
@@ -2849,21 +2852,21 @@
[_ (#Form xs)]
($_ text/compose "(" (|> xs
- (map code-to-text)
+ (list/map code-to-text)
(interpose " ")
list/reverse
(list/fold text/compose "")) ")")
[_ (#Tuple xs)]
($_ text/compose "[" (|> xs
- (map code-to-text)
+ (list/map code-to-text)
(interpose " ")
list/reverse
(list/fold text/compose "")) "]")
[_ (#Record kvs)]
($_ text/compose "{" (|> kvs
- (map (function' [kv] ("lux case" kv {[k v] ($_ text/compose (code-to-text k) " " (code-to-text v))})))
+ (list/map (function' [kv] ("lux case" kv {[k v] ($_ text/compose (code-to-text k) " " (code-to-text v))})))
(interpose " ")
list/reverse
(list/fold text/compose "")) "}")}
@@ -2897,7 +2900,7 @@
_
(fail ($_ text/compose "\"lux.case\" expects an even number of tokens: " (|> branches
- (map code-to-text)
+ (list/map code-to-text)
(interpose " ")
list/reverse
(list/fold text/compose ""))))}))
@@ -2974,7 +2977,7 @@
_
(let' [pairs (|> patterns
- (map (function' [pattern] (list pattern body)))
+ (list/map (function' [pattern] (list pattern body)))
(list/join))]
(return (list/compose pairs branches))))
_
@@ -3033,20 +3036,19 @@
_
#None))
- (#Some ident head tail body)
- (let [g!blank (symbol$ ["" ""])
- g!name (symbol$ ident)
+ (#Some g!name head tail body)
+ (let [g!blank ["" ""]
body+ (list/fold (: (-> Code Code Code)
(function' [arg body']
(if (symbol? arg)
- (` ("lux function" (~ g!blank) (~ arg) (~ body')))
- (` ("lux function" (~ g!blank) (~ g!blank)
- (case (~ g!blank) (~ arg) (~ body')))))))
+ (` ("lux function" (~@ g!blank) (~ arg) (~ body')))
+ (` ("lux function" (~@ g!blank) (~@ g!blank)
+ (case (~@ g!blank) (~ arg) (~ body')))))))
body
(list/reverse tail))]
(return (list (if (symbol? head)
- (` ("lux function" (~ g!name) (~ head) (~ body+)))
- (` ("lux function" (~ g!name) (~ g!blank) (case (~ g!blank) (~ head) (~ body+))))))))
+ (` ("lux function" (~@ g!name) (~ head) (~ body+)))
+ (` ("lux function" (~@ g!name) (~@ g!blank) (case (~@ g!blank) (~ head) (~ body+))))))))
#None
(fail "Wrong syntax for function")))
@@ -3080,27 +3082,27 @@
[_ (#Tuple xs)]
(|> xs
- (map process-def-meta-value)
+ (list/map process-def-meta-value)
untemplate-list
(meta-code ["lux" "Tuple"]))
[_ (#Record kvs)]
(|> kvs
- (map (: (-> [Code Code] Code)
- (function [[k v]]
- (` [(~ (process-def-meta-value k))
- (~ (process-def-meta-value v))]))))
+ (list/map (: (-> [Code Code] Code)
+ (function [[k v]]
+ (` [(~ (process-def-meta-value k))
+ (~ (process-def-meta-value v))]))))
untemplate-list
(meta-code ["lux" "Record"]))
))
(def:' (process-def-meta kvs)
(-> (List [Code Code]) Code)
- (untemplate-list (map (: (-> [Code Code] Code)
- (function [[k v]]
- (` [(~ (process-def-meta-value k))
- (~ (process-def-meta-value v))])))
- kvs)))
+ (untemplate-list (list/map (: (-> [Code Code] Code)
+ (function [[k v]]
+ (` [(~ (process-def-meta-value k))
+ (~ (process-def-meta-value v))])))
+ kvs)))
(def:' (with-func-args args meta)
(-> (List Code) Code Code)
@@ -3110,15 +3112,15 @@
_
(` (#.Cons [[(~ cursor-code) (#.Tag ["lux" "func-args"])]
- [(~ cursor-code) (#.Tuple (.list (~@ (map (function [arg]
- (` [(~ cursor-code) (#.Text (~ (text$ (code-to-text arg))))]))
- args))))]]
+ [(~ 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 [(~@ (map (function [arg] (text$ (code-to-text arg)))
- args))]}))
+ (` {#.type-args [(~+ (list/map (function [arg] (text$ (code-to-text arg)))
+ args))]}))
(def:' Export-Level
Type
@@ -3198,7 +3200,7 @@
body
_
- (` (function (~ name) [(~@ args)] (~ body))))
+ (` (function (~ name) [(~+ args)] (~ body))))
body (case ?type
(#Some type)
(` (: (~ type) (~ body)))
@@ -3279,8 +3281,8 @@
(let [name (symbol$ name)
def-sig (case args
#Nil name
- _ (` ((~ name) (~@ args))))]
- (return (list (` (..def: (~@ (export-level exported?))
+ _ (` ((~ name) (~+ args))))]
+ (return (list (` (..def: (~+ (export-level exported?))
(~ def-sig)
(~ (meta-code-merge (` {#.macro? true})
meta))
@@ -3340,10 +3342,10 @@
(list/join sigs')))
#let [[_module _name] name+
def-name (symbol$ name)
- sig-type (record$ (map (: (-> [Text Code] [Code Code])
- (function [[m-name m-type]]
- [(tag$ ["" m-name]) m-type]))
- members))
+ sig-type (record$ (list/map (: (-> [Text Code] [Code Code])
+ (function [[m-name m-type]]
+ [(tag$ ["" m-name]) m-type]))
+ members))
sig-meta (meta-code-merge (` {#.sig? true})
meta)
usage (case args
@@ -3351,8 +3353,8 @@
def-name
_
- (` ((~ def-name) (~@ args))))]]
- (return (list (` (..type: (~@ (export-level exported?)) (~ usage) (~ sig-meta) (~ sig-type))))))
+ (` ((~ def-name) (~+ args))))]]
+ (return (list (` (..type: (~+ (export-level exported?)) (~ usage) (~ sig-meta) (~ sig-type))))))
#None
(fail "Wrong syntax for sig:"))))
@@ -3678,8 +3680,8 @@
_
(fail "No tags available for type.")))
#let [tag-mappings (: (List [Text Code])
- (map (function [tag] [(second tag) (tag$ tag)])
- tags))]
+ (list/map (function [tag] [(second tag) (tag$ tag)])
+ tags))]
members (monad/map Monad<Meta>
(: (-> Code (Meta [Code Code]))
(function [token]
@@ -3766,12 +3768,12 @@
name
_
- (` ((~ name) (~@ args))))]
- (return (list (` (..def: (~@ (export-level exported?)) (~ usage)
+ (` ((~ name) (~+ args))))]
+ (return (list (` (..def: (~+ (export-level exported?)) (~ usage)
(~ (meta-code-merge (` {#.struct? true})
meta))
(~ type)
- (struct (~@ defs)))))))
+ (struct (~+ defs)))))))
#None
(fail "Cannot infer name, so struct must have a name other than \"_\"!"))
@@ -3830,7 +3832,7 @@
type-meta (: Code
(case tags??
(#Some tags)
- (` {#.tags [(~@ (map text$ tags))]
+ (` {#.tags [(~+ (list/map text$ tags))]
#.type? true})
_
@@ -3849,10 +3851,10 @@
(#Some type)
_
- (#Some (` (All (~ type-name) [(~@ args)] (~ type)))))))]
+ (#Some (` (All (~ type-name) [(~+ args)] (~ type)))))))]
(case type'
(#Some type'')
- (return (list (` (..def: (~@ (export-level exported?)) (~ type-name)
+ (return (list (` (..def: (~+ (export-level exported?)) (~ type-name)
(~ ($_ meta-code-merge (with-type-args args)
(if rec? (' {#.type-rec? true}) (' {}))
type-meta
@@ -3986,14 +3988,14 @@
(case tokens
(^ (list& [_ (#Tag "" "open")] [_ (#Form parts)] tokens'))
(if (|> parts
- (map (: (-> Code Bool)
- (function [part]
- (case part
- (^or [_ (#Text _)] [_ (#Symbol _)])
- true
+ (list/map (: (-> Code Bool)
+ (function [part]
+ (case part
+ (^or [_ (#Text _)] [_ (#Symbol _)])
+ true
- _
- false))))
+ _
+ false))))
(list/fold (function [r l] (and l r)) true))
(let [openings (list/fold (: (-> Code (List Openings) (List Openings))
(function [part openings]
@@ -4022,14 +4024,14 @@
(def: (parse-short-openings parts)
(-> (List Code) (Meta [(List Openings) (List Code)]))
(if (|> parts
- (map (: (-> Code Bool)
- (function [part]
- (case part
- (^or [_ (#Text _)] [_ (#Symbol _)])
- true
+ (list/map (: (-> Code Bool)
+ (function [part]
+ (case part
+ (^or [_ (#Text _)] [_ (#Symbol _)])
+ true
- _
- false))))
+ _
+ false))))
(list/fold (function [r l] (and l r)) true))
(let [openings (list/fold (: (-> Code (List Openings) (List Openings))
(function [part openings]
@@ -4054,16 +4056,16 @@
(def: (decorate-sub-importations super-name)
(-> Text (List Importation) (List Importation))
- (map (: (-> Importation Importation)
- (function [importation]
- (let [{#import-name _name
- #import-alias _alias
- #import-refer {#refer-defs _referrals
- #refer-open _openings}} importation]
- {#import-name ($_ text/compose super-name "/" _name)
- #import-alias _alias
- #import-refer {#refer-defs _referrals
- #refer-open _openings}})))))
+ (list/map (: (-> Importation Importation)
+ (function [importation]
+ (let [{#import-name _name
+ #import-alias _alias
+ #import-refer {#refer-defs _referrals
+ #refer-open _openings}} importation]
+ {#import-name ($_ text/compose super-name "/" _name)
+ #import-alias _alias
+ #import-refer {#refer-defs _referrals
+ #refer-open _openings}})))))
(def: (replace-all pattern value template)
(-> Text Text Text Text)
@@ -4187,18 +4189,18 @@
modules)]
(case (get module modules)
(#Some =module)
- (let [to-alias (map (: (-> [Text Def]
- (List Text))
- (function [[name [def-type def-meta def-value]]]
- (case [(get-meta ["lux" "export?"] def-meta)
- (get-meta ["lux" "hidden?"] def-meta)]
- [(#Some [_ (#Bool true)]) #None]
- (list name)
+ (let [to-alias (list/map (: (-> [Text Def]
+ (List Text))
+ (function [[name [def-type def-meta def-value]]]
+ (case [(get-meta ["lux" "export?"] def-meta)
+ (get-meta ["lux" "hidden?"] def-meta)]
+ [(#Some [_ (#Bool true)]) #None]
+ (list name)
- _
- (list))))
- (let [{#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-annotations _ #module-state _} =module]
- defs))]
+ _
+ (list))))
+ (let [{#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-annotations _ #module-state _} =module]
+ defs))]
(#Right state (list/join to-alias)))
#None
@@ -4369,7 +4371,7 @@
name
_
- ($_ text/compose "(" name " " (|> params (map type/show) (interpose " ") list/reverse (list/fold text/compose "")) ")"))
+ ($_ text/compose "(" name " " (|> params (list/map type/show) (interpose " ") list/reverse (list/fold text/compose "")) ")"))
#Void
"Void"
@@ -4378,13 +4380,13 @@
"Unit"
(#Sum _)
- ($_ text/compose "(| " (|> (flatten-variant type) (map type/show) (interpose " ") list/reverse (list/fold text/compose "")) ")")
+ ($_ text/compose "(| " (|> (flatten-variant type) (list/map type/show) (interpose " ") list/reverse (list/fold text/compose "")) ")")
(#Product _)
- ($_ text/compose "[" (|> (flatten-tuple type) (map type/show) (interpose " ") list/reverse (list/fold text/compose "")) "]")
+ ($_ text/compose "[" (|> (flatten-tuple type) (list/map type/show) (interpose " ") list/reverse (list/fold text/compose "")) "]")
(#Function _)
- ($_ text/compose "(-> " (|> (flatten-lambda type) (map type/show) (interpose " ") list/reverse (list/fold text/compose "")) ")")
+ ($_ text/compose "(-> " (|> (flatten-lambda type) (list/map type/show) (interpose " ") list/reverse (list/fold text/compose "")) ")")
(#Bound id)
(nat/encode id)
@@ -4405,7 +4407,7 @@
(let [[func args] (flatten-app type)]
($_ text/compose
"(" (type/show func) " "
- (|> args (map type/show) (interpose " ") list/reverse (list/fold text/compose ""))
+ (|> args (list/map type/show) (interpose " ") list/reverse (list/fold text/compose ""))
")"))
(#Named [prefix name] _)
@@ -4426,10 +4428,10 @@
(do Monad<Meta>
[full-body ((: (-> Ident [(List Ident) (List Type)] Code (Meta Code))
(function recur [source [tags members] target]
- (let [pattern (record$ (map (function [[t-module t-name]]
- [(tag$ [t-module t-name])
- (symbol$ ["" (text/compose prefix t-name)])])
- tags))]
+ (let [pattern (record$ (list/map (function [[t-module t-name]]
+ [(tag$ [t-module t-name])
+ (symbol$ ["" (text/compose prefix t-name)])])
+ tags))]
(do Monad<Meta>
[enhanced-target (monad/fold Monad<Meta>
(function [[[_ m-name] m-type] enhanced-target]
@@ -4462,7 +4464,7 @@
(^ (list& [_ (#Form (list [_ (#Text prefix)]))] body branches))
(do Monad<Meta>
[g!temp (gensym "temp")]
- (return (list& g!temp (` (^open' (~ g!temp) (~ (text$ prefix)) (~ body))) branches)))
+ (return (list& (symbol$ g!temp) (` (^open' (~@ g!temp) (~ (text$ prefix)) (~ body))) branches)))
(^ (list& [_ (#Form (list))] body branches))
(return (list& (` (..^open "")) body branches))
@@ -4524,13 +4526,14 @@
g!output (gensym "")]
(case (resolve-struct-type type)
(#Some members)
- (let [pattern (record$ (map (: (-> [Ident [Nat Type]] [Code Code])
- (function [[[r-prefix r-name] [r-idx r-type]]]
- [(tag$ [r-prefix r-name]) (if (n/= idx r-idx)
- g!output
- g!_)]))
- (zip2 tags (enumerate members))))]
- (return (list (` ("lux case" (~ record) {(~ pattern) (~ g!output)})))))
+ (let [pattern (record$ (list/map (: (-> [Ident [Nat Type]] [Code Code])
+ (function [[[r-prefix r-name] [r-idx r-type]]]
+ [(tag$ [r-prefix r-name])
+ (symbol$ (if (n/= idx r-idx)
+ g!output
+ g!_))]))
+ (zip2 tags (enumerate members))))]
+ (return (list (` ("lux case" (~ record) {(~ pattern) (~@ g!output)})))))
_
(fail "get@ can only use records.")))
@@ -4545,7 +4548,7 @@
(^ (list selector))
(do Monad<Meta>
[g!record (gensym "record")]
- (wrap (list (` (function [(~ g!record)] (..get@ (~ selector) (~ g!record)))))))
+ (wrap (list (` (function [(~@ g!record)] (..get@ (~ selector) (~@ g!record)))))))
_
(fail "Wrong syntax for get@")))
@@ -4606,27 +4609,27 @@
(macro: #export (|>> tokens)
{#.doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it.
- (|>> (map int/encode) (interpose \" \") (fold text/compose \"\"))
+ (|>> (list/map int/encode) (interpose \" \") (fold text/compose \"\"))
## =>
(function [<arg>]
(fold text/compose \"\"
(interpose \" \"
- (map int/encode <arg>))))"}
+ (list/map int/encode <arg>))))"}
(do Monad<Meta>
[g!arg (gensym "arg")]
- (return (list (` (function [(~ g!arg)] (|> (~ g!arg) (~@ tokens))))))))
+ (return (list (` (function [(~@ g!arg)] (|> (~@ g!arg) (~+ tokens))))))))
(macro: #export (<<| tokens)
{#.doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it.
- (<<| (fold text/compose \"\") (interpose \" \") (map int/encode))
+ (<<| (fold text/compose \"\") (interpose \" \") (list/map int/encode))
## =>
(function [<arg>]
(fold text/compose \"\"
(interpose \" \"
- (map int/encode <arg>))))"}
+ (list/map int/encode <arg>))))"}
(do Monad<Meta>
[g!arg (gensym "arg")]
- (return (list (` (function [(~ g!arg)] (<| (~@ tokens) (~ g!arg))))))))
+ (return (list (` (function [(~@ g!arg)] (<| (~+ tokens) (~@ g!arg))))))))
(def: (imported-by? import-name module-name)
(-> Text Text (Meta Bool))
@@ -4660,7 +4663,7 @@
_
(fail ($_ text/compose "Wrong syntax for refer @ " current-module
"\n" (|> options
- (map code-to-text)
+ (list/map code-to-text)
(interpose " ")
(list/fold text/compose "")))))))
@@ -4695,19 +4698,19 @@
#Nothing
(wrap (list)))
- #let [defs (map (: (-> Text Code)
- (function [def]
- (` ("lux def" (~ (symbol$ ["" def]))
- (~ (symbol$ [module-name def]))
- [(~ cursor-code)
- (#.Record (#Cons [[(~ cursor-code) (#.Tag ["lux" "alias"])]
- [(~ cursor-code) (#.Symbol [(~ (text$ module-name)) (~ (text$ def))])]]
- #Nil))]))))
- defs')
+ #let [defs (list/map (: (-> Text Code)
+ (function [def]
+ (` ("lux def" (~ (symbol$ ["" def]))
+ (~ (symbol$ [module-name def]))
+ [(~ cursor-code)
+ (#.Record (#Cons [[(~ cursor-code) (#.Tag ["lux" "alias"])]
+ [(~ cursor-code) (#.Symbol [(~ (text$ module-name)) (~ (text$ def))])]]
+ #Nil))]))))
+ defs')
openings (join-map (: (-> Openings (List Code))
(function [[prefix structs]]
- (map (function [[_ name]] (` (open (~ (symbol$ [module-name name])) (~ (text$ prefix)))))
- structs)))
+ (list/map (function [[_ name]] (` (open (~ (symbol$ [module-name name])) (~ (text$ prefix)))))
+ structs)))
r-opens)]]
(wrap (list/compose defs openings))
))
@@ -4730,21 +4733,21 @@
(list (' #refer) (' #all))
(#Only defs)
- (list (' #refer) (`' (#only (~@ (map (|>> [""] symbol$)
- defs)))))
+ (list (' #refer) (`' (#only (~+ (list/map (|>> [""] symbol$)
+ defs)))))
(#Exclude defs)
- (list (' #refer) (`' (#exclude (~@ (map (|>> [""] symbol$)
- defs)))))
+ (list (' #refer) (`' (#exclude (~+ (list/map (|>> [""] symbol$)
+ defs)))))
#Nothing
(list)))
=opens (join-map (function [[prefix structs]]
- (list& (text$ prefix) (map symbol$ structs)))
+ (list& (text$ prefix) (list/map symbol$ structs)))
r-opens)]
(` (..refer (~ (text$ module-name))
- (~@ =defs)
- (~' #open) ((~@ =opens))))))
+ (~+ =defs)
+ (~' #open) ((~+ =opens))))))
(macro: #export (module: tokens)
{#.doc "Module-definition macro.
@@ -4783,15 +4786,15 @@
[(list) tokens]))]
current-module current-module-name
imports (parse-imports current-module _imports)
- #let [=imports (map (: (-> Importation Code)
- (function [[m-name m-alias =refer]]
- (` [(~ (text$ m-name)) (~ (text$ (default "" m-alias)))])))
- imports)
- =refers (map (: (-> Importation Code)
- (function [[m-name m-alias =refer]]
- (refer-to-code m-name =refer)))
- imports)
- =meta (process-def-meta (list& [(` #.imports) (` [(~@ =imports)])]
+ #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)
+ (function [[m-name m-alias =refer]]
+ (refer-to-code m-name =refer)))
+ imports)
+ =meta (process-def-meta (list& [(` #.imports) (` [(~+ =imports)])]
_meta))
=module (` ("lux module" [(~ cursor-code)
(#.Record (~ =meta))]))]]
@@ -4808,7 +4811,7 @@
(return (list (` (let [(^open) (~ struct)] (~ (symbol$ member))))))
(^ (list& struct [_ (#Symbol member)] args))
- (return (list (` ((let [(^open) (~ struct)] (~ (symbol$ member))) (~@ args)))))
+ (return (list (` ((let [(^open) (~ struct)] (~ (symbol$ member))) (~+ args)))))
_
(fail "Wrong syntax for ::")))
@@ -4841,18 +4844,20 @@
(function [[r-slot-name [r-idx r-type]]]
(do Monad<Meta>
[g!slot (gensym "")]
- (return [r-slot-name r-idx g!slot]))))
+ (return [r-slot-name r-idx (symbol$ g!slot)]))))
(zip2 tags (enumerate members)))]
- (let [pattern (record$ (map (: (-> [Ident Nat Code] [Code Code])
- (function [[r-slot-name r-idx r-var]]
- [(tag$ r-slot-name) r-var]))
- pattern'))
- output (record$ (map (: (-> [Ident Nat Code] [Code Code])
- (function [[r-slot-name r-idx r-var]]
- [(tag$ r-slot-name) (if (n/= idx r-idx)
- value
- r-var)]))
- pattern'))]
+ (let [pattern (record$ (list/map (: (-> [Ident Nat Code] [Code Code])
+ (function [[r-slot-name r-idx r-var]]
+ [(tag$ r-slot-name)
+ r-var]))
+ pattern'))
+ output (record$ (list/map (: (-> [Ident Nat Code] [Code Code])
+ (function [[r-slot-name r-idx r-var]]
+ [(tag$ r-slot-name)
+ (if (n/= idx r-idx)
+ value
+ r-var)]))
+ pattern'))]
(return (list (` ("lux case" (~ record) {(~ pattern) (~ output)}))))))
_
@@ -4866,35 +4871,36 @@
_
(do Monad<Meta>
[bindings (monad/map Monad<Meta>
- (: (-> Code (Meta Code))
+ (: (-> Code (Meta Ident))
(function [_] (gensym "temp")))
slots)
#let [pairs (zip2 slots bindings)
- update-expr (list/fold (: (-> [Code Code] Code Code)
+ update-expr (list/fold (: (-> [Code Ident] Code Code)
(function [[s b] v]
- (` (..set@ (~ s) (~ v) (~ b)))))
+ (` (..set@ (~ s) (~ v) (~@ b)))))
value
(list/reverse pairs))
- [_ accesses'] (list/fold (: (-> [Code Code] [Code (List (List Code))] [Code (List (List Code))])
+ [_ accesses'] (list/fold (: (-> [Code Ident] [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')]))
+ (let [new-binding (symbol$ new-binding)]
+ [(` (get@ (~ new-slot) (~ new-binding)))
+ (#Cons (list new-binding old-record) accesses')])))
[record (: (List (List Code)) #Nil)]
pairs)
accesses (list/join (list/reverse accesses'))]]
- (wrap (list (` (let [(~@ accesses)]
+ (wrap (list (` (let [(~+ accesses)]
(~ update-expr)))))))
(^ (list selector value))
(do Monad<Meta>
[g!record (gensym "record")]
- (wrap (list (` (function [(~ g!record)] (..set@ (~ selector) (~ value) (~ g!record)))))))
+ (wrap (list (` (function [(~@ g!record)] (..set@ (~ selector) (~ value) (~@ g!record)))))))
(^ (list selector))
(do Monad<Meta>
[g!value (gensym "value")
g!record (gensym "record")]
- (wrap (list (` (function [(~ g!value) (~ g!record)] (..set@ (~ selector) (~ g!value) (~ g!record)))))))
+ (wrap (list (` (function [(~@ g!value) (~@ g!record)] (..set@ (~ selector) (~@ g!value) (~@ g!record)))))))
_
(fail "Wrong syntax for set@")))
@@ -4927,18 +4933,20 @@
(function [[r-slot-name [r-idx r-type]]]
(do Monad<Meta>
[g!slot (gensym "")]
- (return [r-slot-name r-idx g!slot]))))
+ (return [r-slot-name r-idx (symbol$ g!slot)]))))
(zip2 tags (enumerate members)))]
- (let [pattern (record$ (map (: (-> [Ident Nat Code] [Code Code])
- (function [[r-slot-name r-idx r-var]]
- [(tag$ r-slot-name) r-var]))
- pattern'))
- output (record$ (map (: (-> [Ident Nat Code] [Code Code])
- (function [[r-slot-name r-idx r-var]]
- [(tag$ r-slot-name) (if (n/= idx r-idx)
- (` ((~ fun) (~ r-var)))
- r-var)]))
- pattern'))]
+ (let [pattern (record$ (list/map (: (-> [Ident Nat Code] [Code Code])
+ (function [[r-slot-name r-idx r-var]]
+ [(tag$ r-slot-name)
+ r-var]))
+ pattern'))
+ output (record$ (list/map (: (-> [Ident Nat Code] [Code Code])
+ (function [[r-slot-name r-idx r-var]]
+ [(tag$ r-slot-name)
+ (if (n/= idx r-idx)
+ (` ((~ fun) (~ r-var)))
+ r-var)]))
+ pattern'))]
(return (list (` ("lux case" (~ record) {(~ pattern) (~ output)}))))))
_
@@ -4953,20 +4961,20 @@
(do Monad<Meta>
[g!record (gensym "record")
g!temp (gensym "temp")]
- (wrap (list (` (let [(~ g!record) (~ record)
- (~ g!temp) (get@ [(~@ slots)] (~ g!record))]
- (set@ [(~@ slots)] ((~ fun) (~ g!temp)) (~ g!record))))))))
+ (wrap (list (` (let [(~@ g!record) (~ record)
+ (~@ g!temp) (get@ [(~+ slots)] (~@ g!record))]
+ (set@ [(~+ slots)] ((~ fun) (~@ g!temp)) (~@ g!record))))))))
(^ (list selector fun))
(do Monad<Meta>
[g!record (gensym "record")]
- (wrap (list (` (function [(~ g!record)] (..update@ (~ selector) (~ fun) (~ g!record)))))))
+ (wrap (list (` (function [(~@ g!record)] (..update@ (~ selector) (~ fun) (~@ g!record)))))))
(^ (list selector))
(do Monad<Meta>
[g!fun (gensym "fun")
g!record (gensym "record")]
- (wrap (list (` (function [(~ g!fun) (~ g!record)] (..update@ (~ selector) (~ g!fun) (~ g!record)))))))
+ (wrap (list (` (function [(~@ g!fun) (~@ g!record)] (..update@ (~ selector) (~@ g!fun) (~@ g!record)))))))
_
(fail "Wrong syntax for update@")))
@@ -5015,9 +5023,9 @@
(do Monad<Maybe>
[bindings' (monad/map Monad<Maybe> get-name bindings)
data' (monad/map Monad<Maybe> tuple->list data)]
- (if (every? (n/= (list/size bindings')) (map list/size data'))
+ (if (every? (n/= (list/size bindings')) (list/map list/size data'))
(let [apply (: (-> RepEnv (List Code))
- (function [env] (map (apply-template env) templates)))]
+ (function [env] (list/map (apply-template env) templates)))]
(|> data'
(join-map (compose apply (make-env bindings')))
wrap))
@@ -5057,14 +5065,14 @@
(^template [<tag>]
[[_ _ column] (<tag> parts)]
- (list/fold n/min column (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 (map (|>> first find-baseline-column) pairs)
- (map (|>> second find-baseline-column) pairs)))
+ (list/compose (list/map (|>> first find-baseline-column) pairs)
+ (list/map (|>> second find-baseline-column) pairs)))
))
(type: Doc-Fragment
@@ -5149,7 +5157,7 @@
(def: rejoin-all-pairs
(-> (List [Code Code]) (List Code))
- (|>> (map rejoin-pair) list/join))
+ (|>> (list/map rejoin-pair) list/join))
(def: (doc-example->Text prev-cursor baseline example)
(-> Cursor Nat Code [Cursor Text])
@@ -5198,7 +5206,7 @@
(#Doc-Comment comment)
(|> comment
(text/split "\n")
- (map (function [line] ($_ text/compose "## " line "\n")))
+ (list/map (function [line] ($_ text/compose "## " line "\n")))
text/join)
(#Doc-Example example)
@@ -5220,7 +5228,7 @@
x)))"}
(return (list (` [(~ cursor-code)
(#.Text (~ (|> tokens
- (map (|>> identify-doc-fragment doc-fragment->Text))
+ (list/map (|>> identify-doc-fragment doc-fragment->Text))
text/join
text$)))]))))
@@ -5242,7 +5250,7 @@
(-> Type Code)
(case type
(#Primitive name params)
- (` (#Primitive (~ (text$ name)) (~ (untemplate-list (map type-to-code params)))))
+ (` (#Primitive (~ (text$ name)) (~ (untemplate-list (list/map type-to-code params)))))
#Void
(` #Void)
@@ -5268,11 +5276,11 @@
(` (#Ex (~ (nat$ id))))
(#UnivQ env type)
- (let [env' (untemplate-list (map type-to-code env))]
+ (let [env' (untemplate-list (list/map type-to-code env))]
(` (#UnivQ (~ env') (~ (type-to-code type)))))
(#ExQ env type)
- (let [env' (untemplate-list (map type-to-code env))]
+ (let [env' (untemplate-list (list/map type-to-code env))]
(` (#ExQ (~ env') (~ (type-to-code type)))))
(#Apply arg fun)
@@ -5293,8 +5301,8 @@
(case tokens
(^ (list [_ (#Tuple bindings)] body))
(let [pairs (as-pairs bindings)
- vars (map first pairs)
- inits (map second pairs)]
+ vars (list/map first pairs)
+ inits (list/map second pairs)]
(if (every? symbol? inits)
(do Monad<Meta>
[inits' (: (Meta (List Ident))
@@ -5303,18 +5311,19 @@
#None (fail "Wrong syntax for loop")))
init-types (monad/map Monad<Meta> find-type inits')
expected get-expected-type]
- (return (list (` (("lux check" (-> (~@ (map type-to-code init-types))
+ (return (list (` (("lux check" (-> (~+ (list/map type-to-code init-types))
(~ (type-to-code expected)))
- (function (~ (symbol$ ["" "recur"])) [(~@ vars)]
+ (function (~ (symbol$ ["" "recur"])) [(~+ vars)]
(~ body)))
- (~@ inits))))))
+ (~+ inits))))))
(do Monad<Meta>
[aliases (monad/map Monad<Meta>
- (: (-> Code (Meta Code))
+ (: (-> Code (Meta Ident))
(function [_] (gensym "")))
- inits)]
- (return (list (` (let [(~@ (interleave aliases inits))]
- (.loop [(~@ (interleave vars aliases))]
+ inits)
+ #let [aliases (list/map symbol$ aliases)]]
+ (return (list (` (let [(~+ (interleave aliases inits))]
+ (.loop [(~+ (interleave vars aliases))]
(~ body)))))))))
_
@@ -5345,16 +5354,16 @@
output (resolve-tag hslot)
g!_ (gensym "_")
#let [[idx tags exported? type] output
- slot-pairings (map (: (-> Ident [Text Code])
- (function [[module name]] [name (symbol$ ["" name])]))
- (list& hslot tslots))
- pattern (record$ (map (: (-> Ident [Code Code])
- (function [[module name]]
- (let [tag (tag$ [module name])]
- (case (get name slot-pairings)
- (#Some binding) [tag binding]
- #None [tag g!_]))))
- tags))]]
+ slot-pairings (list/map (: (-> Ident [Text Code])
+ (function [[module name]] [name (symbol$ ["" name])]))
+ (list& hslot tslots))
+ pattern (record$ (list/map (: (-> Ident [Code Code])
+ (function [[module name]]
+ (let [tag (tag$ [module name])]
+ (case (get name slot-pairings)
+ (#Some binding) [tag binding]
+ #None [tag (symbol$ g!_)]))))
+ tags))]]
(return (list& pattern body branches)))
_
@@ -5430,8 +5439,8 @@
(do Monad<Meta>
[expansion (macro-expand-once macro-expr)]
(case (place-tokens var-name expansion (` (.with-expansions
- [(~@ bindings')]
- (~@ bodies))))
+ [(~+ bindings')]
+ (~+ bodies))))
(#Some output)
(wrap output)
@@ -5569,13 +5578,13 @@
(wrap [init extras']))))
(def: (multi-level-case$ g!_ [[init-pattern levels] body])
- (-> Code [Multi-Level-Case Code] (List Code))
+ (-> Ident [Multi-Level-Case Code] (List Code))
(let [inner-pattern-body (list/fold (function [[calculation pattern] success]
(` (case (~ calculation)
(~ pattern)
(~ success)
- (~ g!_)
+ (~@ g!_)
#.None)))
(` (#.Some (~ body)))
(: (List [Code Code]) (list/reverse levels)))]
@@ -5606,19 +5615,19 @@
[mlc (multi-level-case^ levels)
expected get-expected-type
g!temp (gensym "temp")]
- (let [output (list g!temp
+ (let [output (list (symbol$ g!temp)
(` ("lux case" ("lux check" (#.Apply (~ (type-to-code expected)) Maybe)
- (case (~ g!temp)
- (~@ (multi-level-case$ g!temp [mlc body]))
+ (case (~@ g!temp)
+ (~+ (multi-level-case$ g!temp [mlc body]))
- (~ g!temp)
+ (~@ g!temp)
#.None))
- {(#Some (~ g!temp))
- (~ g!temp)
+ {(#Some (~@ g!temp))
+ (~@ g!temp)
#None
- (case (~ g!temp)
- (~@ next-branches))})))]
+ (case (~@ g!temp)
+ (~+ next-branches))})))]
(wrap output)))
_
@@ -5713,9 +5722,9 @@
(to-list set))))}
(case tokens
(^ (list& [_meta (#Form (list [_ (#Symbol ["" name])] pattern))] body branches))
- (let [g!whole (symbol$ ["" name])]
- (return (list& g!whole
- (` (case (~ g!whole) (~ pattern) (~ body)))
+ (let [g!whole ["" name]]
+ (return (list& (symbol$ g!whole)
+ (` (case (~@ g!whole) (~ pattern) (~ body)))
branches)))
_
@@ -5728,9 +5737,9 @@
(foo value)))}
(case tokens
(^ (list& [_meta (#Form (list [_ (#Symbol ["" name])] [_ (#Tuple steps)]))] body branches))
- (let [g!name (symbol$ ["" name])]
- (return (list& g!name
- (` (let [(~ g!name) (|> (~ g!name) (~@ steps))]
+ (let [g!name ["" name]]
+ (return (list& (symbol$ g!name)
+ (` (let [(~@ g!name) (|> (~@ g!name) (~+ steps))]
(~ body)))
branches)))
@@ -5876,18 +5885,18 @@
g!tokens (gensym "tokens")
g!compiler (gensym "compiler")
g!_ (gensym "_")
- #let [rep-env (map (function [arg]
- [arg (` ((~' ~) (~ (symbol$ ["" arg]))))])
- args)]]
- (wrap (list (` (macro: (~@ (gen-export-level ?export-level))
- ((~ (symbol$ ["" name])) (~ g!tokens) (~ g!compiler))
+ #let [rep-env (list/map (function [arg]
+ [arg (` ((~' ~) (~ (symbol$ ["" arg]))))])
+ args)]]
+ (wrap (list (` (macro: (~+ (gen-export-level ?export-level))
+ ((~ (symbol$ ["" name])) (~@ g!tokens) (~@ g!compiler))
(~ anns)
- (case (~ g!tokens)
- (^ (list (~@ (map (|>> [""] symbol$) args))))
- (#.Right [(~ g!compiler)
+ (case (~@ g!tokens)
+ (^ (list (~+ (list/map (|>> [""] symbol$) args))))
+ (#.Right [(~@ g!compiler)
(list (` (~ (replace-syntax rep-env input-template))))])
- (~ g!_)
+ (~@ g!_)
(#.Left (~ (text$ (text/compose "Wrong syntax for " name))))
)))))
))
@@ -5972,14 +5981,14 @@
(^ [ann (#Form (list [_ (#Symbol ["" "~~"])] expansion))])
(do Monad<Meta>
[g!expansion (gensym "g!expansion")]
- (wrap [(list [g!expansion expansion]) g!expansion]))
+ (wrap [(list [(symbol$ g!expansion) expansion]) (symbol$ g!expansion)]))
(^template [<tag>]
[ann (<tag> parts)]
(do Monad<Meta>
[=parts (monad/map Monad<Meta> label-code parts)]
- (wrap [(list/fold list/compose (list) (map left =parts))
- [ann (<tag> (map right =parts))]])))
+ (wrap [(list/fold list/compose (list) (list/map left =parts))
+ [ann (<tag> (list/map right =parts))]])))
([#Form] [#Tuple])
[ann (#Record kvs)]
@@ -5993,8 +6002,8 @@
[val-labels val-labelled] =val]]
(wrap [(list/compose key-labels val-labels) [key-labelled val-labelled]])))
kvs)]
- (wrap [(list/fold list/compose (list) (map left =kvs))
- [ann (#Record (map right =kvs))]]))
+ (wrap [(list/fold list/compose (list) (list/map left =kvs))
+ [ann (#Record (list/map right =kvs))]]))
_
(return [(list) code])))
@@ -6005,8 +6014,8 @@
(do Monad<Meta>
[=raw (label-code raw)
#let [[labels labelled] =raw]]
- (wrap (list (` (with-expansions [(~@ (|> labels
- (map (function [[label expansion]] (list label expansion)))
+ (wrap (list (` (with-expansions [(~+ (|> labels
+ (list/map (function [[label expansion]] (list label expansion)))
list/join))]
(~ labelled))))))
@@ -6034,7 +6043,7 @@
[_ (<tag> value)]
(do Monad<Meta>
[g!meta (gensym "g!meta")]
- (wrap (` [(~ g!meta) (<tag> (~ (<gen> value)))]))))
+ (wrap (` [(~@ g!meta) (<tag> (~ (<gen> value)))]))))
([#Bool "Bool" bool$]
[#Nat "Nat" nat$]
[#Int "Int" int$]
@@ -6054,29 +6063,29 @@
(wrap (` [(~ =key) (~ =value)]))))
fields)
g!meta (gensym "g!meta")]
- (wrap (` [(~ g!meta) (#.Record (~ (untemplate-list =fields)))])))
+ (wrap (` [(~@ g!meta) (#.Record (~ (untemplate-list =fields)))])))
[_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))]
(return unquoted)
- [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))]
- (fail "Cannot use (~@) inside of ^code unless it is the last element in a form or a tuple.")
+ [_ (#Form (#Cons [[_ (#Symbol ["" "~+"])] (#Cons [spliced #Nil])]))]
+ (fail "Cannot use (~+) inside of ^code unless it is the last element in a form or a tuple.")
(^template [<tag>]
[_ (<tag> elems)]
(case (list/reverse elems)
- (#Cons [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))]
+ (#Cons [_ (#Form (#Cons [[_ (#Symbol ["" "~+"])] (#Cons [spliced #Nil])]))]
inits)
(do Monad<Meta>
[=inits (monad/map Monad<Meta> untemplate-pattern (list/reverse inits))
g!meta (gensym "g!meta")]
- (wrap (` [(~ g!meta) (<tag> (~ (untemplate-list& spliced =inits)))])))
+ (wrap (` [(~@ g!meta) (<tag> (~ (untemplate-list& spliced =inits)))])))
_
(do Monad<Meta>
[=elems (monad/map Monad<Meta> untemplate-pattern elems)
g!meta (gensym "g!meta")]
- (wrap (` [(~ g!meta) (<tag> (~ (untemplate-list =elems)))])))))
+ (wrap (` [(~@ g!meta) (<tag> (~ (untemplate-list =elems)))])))))
([#Tuple] [#Form])
))
diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux
index 328d717ce..5aa8217e2 100644
--- a/stdlib/source/lux/cli.lux
+++ b/stdlib/source/lux/cli.lux
@@ -129,23 +129,23 @@
(#Parsed args)
(with-gensyms [g!args g!_ g!output g!message]
- (wrap (list (` ("lux program" (~ g!args)
+ (wrap (list (` ("lux program" (~@ g!args)
(case ((: (..CLI (io.IO Unit))
(do .._Monad<CLI>_
- [(~@ (|> args
+ [(~+ (|> args
(list/map (function [[binding parser]]
(list binding parser)))
list/join))
- (~ g!_) ..end]
+ (~@ g!_) ..end]
((~' wrap) (do io.Monad<IO>
[]
(~ body)))))
- (~ g!args))
- (#E.Success [(~ g!_) (~ g!output)])
- (~ g!output)
+ (~@ g!args))
+ (#E.Success [(~@ g!_) (~@ g!output)])
+ (~@ g!output)
- (#E.Error (~ g!message))
- (error! (~ g!message))
+ (#E.Error (~@ g!message))
+ (error! (~@ g!message))
)))
)))
))
diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux
index a079d2d28..9f3403aad 100644
--- a/stdlib/source/lux/concurrency/actor.lux
+++ b/stdlib/source/lux/concurrency/actor.lux
@@ -221,7 +221,7 @@
output (message state self)
#let [_ (log! "AFTER")]]
(wrap output)))))}
- (with-gensyms [g!message g!self g!state g!init g!error g!return g!output]
+ (with-gensyms [g!init]
(do @
[module macro.current-module-name
#let [g!type (code.local-symbol (state-name _name))
@@ -229,16 +229,16 @@
g!actor (code.local-symbol _name)
g!new (code.local-symbol (new-name _name))
g!vars (list/map code.local-symbol _vars)]]
- (wrap (list (` (type: (~@ (csw.export export)) ((~ g!type) (~@ g!vars))
+ (wrap (list (` (type: (~+ (csw.export export)) ((~ g!type) (~+ g!vars))
(~ state-type)))
- (` (type: (~@ (csw.export export)) ((~ g!actor) (~@ g!vars))
+ (` (type: (~+ (csw.export export)) ((~ g!actor) (~+ g!vars))
(~ (|> annotations
(with-actor [module _name])
csw.annotations))
- (..Actor ((~ g!type) (~@ g!vars)))))
- (` (def: (~@ (csw.export export)) (~ g!behavior)
- (All [(~@ g!vars)]
- (..Behavior ((~ g!type) (~@ g!vars))))
+ (..Actor ((~ g!type) (~+ g!vars)))))
+ (` (def: (~+ (csw.export export)) (~ g!behavior)
+ (All [(~+ g!vars)]
+ (..Behavior ((~ g!type) (~+ g!vars))))
{#..handle (~ (case ?handle
#.None
(` ..default-handle)
@@ -260,10 +260,10 @@
(do P.Monad<Promise>
[]
(~ bodyC))))))}))
- (` (def: (~@ (csw.export export)) ((~ g!new) (~ g!init))
- (All [(~@ g!vars)]
- (-> ((~ g!type) (~@ g!vars)) (io.IO ((~ g!actor) (~@ g!vars)))))
- (..spawn (~ g!behavior) (~ g!init))))))
+ (` (def: (~+ (csw.export export)) ((~ g!new) (~@ g!init))
+ (All [(~+ g!vars)]
+ (-> ((~ g!type) (~+ g!vars)) (io.IO ((~ g!actor) (~+ g!vars)))))
+ (..spawn (~ g!behavior) (~@ g!init))))))
)))
(type: Signature
@@ -313,7 +313,7 @@
#let [g!type (code.symbol (product.both id state-name actor-name))
g!message (code.local-symbol (get@ #name signature))
g!actor-vars (list/map code.local-symbol actor-vars)
- g!actor (` ((~ (code.symbol actor-name)) (~@ g!actor-vars)))
+ actorC (` ((~ (code.symbol actor-name)) (~+ g!actor-vars)))
g!all-vars (|> (get@ #vars signature) (list/map code.local-symbol) (list/compose g!actor-vars))
g!inputsC (|> (get@ #inputs signature) (list/map (|>> product.left code.local-symbol)))
g!inputsT (|> (get@ #inputs signature) (list/map product.right))
@@ -335,32 +335,32 @@
(code.replace g!var g!ref outputT))
(get@ #output signature)
ref-replacements)]]
- (wrap (list (` (def: (~@ (csw.export export)) ((~ g!message) (~@ g!inputsC) (~ g!self))
+ (wrap (list (` (def: (~+ (csw.export export)) ((~ g!message) (~+ g!inputsC) (~ g!self))
(~ (|> annotations
(with-message actor-name)
csw.annotations))
- (All [(~@ g!all-vars)] (-> (~@ g!inputsT) (~ g!actor) (T.Task (~ (get@ #output signature)))))
- (let [(~ g!task) (T.task (~ g!outputT))]
+ (All [(~+ g!all-vars)] (-> (~+ g!inputsT) (~ actorC) (T.Task (~ (get@ #output signature)))))
+ (let [(~@ g!task) (T.task (~ g!outputT))]
(io.run (do io.Monad<IO>
- [(~ g!sent?) (..send (function [(~ g!state) (~ g!self)]
- (do P.Monad<Promise>
- [(~ g!return) (: (T.Task [((~ g!type) (~@ g!actor-refs))
- (~ g!outputT)])
- (do T.Monad<Task>
- []
- (~ body)))]
- (case (~ g!return)
- (#.Right [(~ g!state) (~ g!return)])
- (exec (io.run (P.resolve (#.Right (~ g!return)) (~ g!task)))
- (T.return (~ g!state)))
-
- (#.Left (~ g!error))
- (exec (io.run (P.resolve (#.Left (~ g!error)) (~ g!task)))
- (T.fail (~ g!error))))
- ))
- (~ g!self))]
- (if (~ g!sent?)
- ((~' wrap) (~ g!task))
+ [(~@ g!sent?) (..send (function [(~ g!state) (~ g!self)]
+ (do P.Monad<Promise>
+ [(~@ g!return) (: (T.Task [((~ g!type) (~+ g!actor-refs))
+ (~ g!outputT)])
+ (do T.Monad<Task>
+ []
+ (~ body)))]
+ (case (~@ g!return)
+ (#.Right [(~ g!state) (~@ g!return)])
+ (exec (io.run (P.resolve (#.Right (~@ g!return)) (~@ g!task)))
+ (T.return (~ g!state)))
+
+ (#.Left (~@ g!error))
+ (exec (io.run (P.resolve (#.Left (~@ g!error)) (~@ g!task)))
+ (T.fail (~@ g!error))))
+ ))
+ (~ g!self))]
+ (if (~@ g!sent?)
+ ((~' wrap) (~@ g!task))
((~' wrap) (T.throw ..Dead ""))))))))
))
)))
diff --git a/stdlib/source/lux/concurrency/space.lux b/stdlib/source/lux/concurrency/space.lux
index 1ba795b24..388415c44 100644
--- a/stdlib/source/lux/concurrency/space.lux
+++ b/stdlib/source/lux/concurrency/space.lux
@@ -133,16 +133,16 @@
(do @
[actor-name (A.resolve-actor actor-name)
#let [stateT (` ((~ (code.symbol (product.both id A.state-name actor-name)))
- (~@ actor-params)))
+ (~+ actor-params)))
g!actionL (code.local-symbol (get@ #action-name declaration))
g!senderL (code.local-symbol (get@ #sender-name declaration))
g!spaceL (code.local-symbol (get@ #space-name declaration))
g!receiverL (code.local-symbol (get@ #receiver-name declaration))
g!event (get@ #event declaration)
g!state (get@ #state declaration)]]
- (wrap (list (` (def: (~@ (csw.export export)) ((~ g!actionL) [(~ g!event) (~ g!senderL) (~ g!spaceL)] (~ g!receiverL))
+ (wrap (list (` (def: (~+ (csw.export export)) ((~ g!actionL) [(~ g!event) (~ g!senderL) (~ g!spaceL)] (~ g!receiverL))
(~ (csw.annotations annotations))
- (All [(~@ (L/map code.local-symbol t-vars))]
+ (All [(~+ (L/map code.local-symbol t-vars))]
(..Action (~ eventT) (~ stateT)))
(T.from-promise
(_future
diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux
index 104dcf593..da2e11710 100644
--- a/stdlib/source/lux/control/concatenative.lux
+++ b/stdlib/source/lux/control/concatenative.lux
@@ -7,8 +7,8 @@
[monad])
(data [text]
text/format
- [maybe "m/" Monad<Maybe>]
- (coll [list "L/" Fold<List> Functor<List>]))
+ [maybe "maybe/" Monad<Maybe>]
+ (coll [list "list/" Fold<List> Functor<List>]))
[macro #+ with-gensyms Monad<Meta>]
(macro [code]
["s" syntax #+ syntax:]
@@ -43,10 +43,10 @@
(def: (stack-fold tops bottom)
(-> (List Code) Code Code)
- (L/fold (function [top bottom]
- (` [(~ bottom) (~ top)]))
- bottom
- tops))
+ (list/fold (function [top bottom]
+ (` [(~ bottom) (~ top)]))
+ bottom
+ tops))
(def: (singleton expander)
(-> (Meta (List Code)) (Meta Code))
@@ -58,18 +58,18 @@
_
(macro.fail (format "Cannot expand to more than a single AST/Code node:\n"
- (|> expansion (L/map %code) (text.join-with " ")))))))
+ (|> expansion (list/map %code) (text.join-with " ")))))))
(syntax: #export (=> [aliases aliases^]
[inputs stack^]
[outputs stack^])
(let [de-alias (function [aliased]
- (L/fold (function [[from to] pre]
- (code.replace (code.local-symbol from) to pre))
- aliased
- aliases))]
- (case [(|> inputs (get@ #bottom) (m/map (|>> code.nat (~) #.Bound (`))))
- (|> outputs (get@ #bottom) (m/map (|>> code.nat (~) #.Bound (`))))]
+ (list/fold (function [[from to] pre]
+ (code.replace (code.local-symbol from) to pre))
+ aliased
+ aliases))]
+ (case [(|> inputs (get@ #bottom) (maybe/map (|>> code.nat (~) #.Bound (`))))
+ (|> outputs (get@ #bottom) (maybe/map (|>> code.nat (~) #.Bound (`))))]
[(#.Some bottomI) (#.Some bottomO)]
(monad.do @
[inputC (singleton (macro.expand-all (stack-fold (get@ #top inputs) bottomI)))
@@ -80,9 +80,9 @@
[?bottomI ?bottomO]
(with-gensyms [g!stack]
(monad.do @
- [inputC (singleton (macro.expand-all (stack-fold (get@ #top inputs) (maybe.default g!stack ?bottomI))))
- outputC (singleton (macro.expand-all (stack-fold (get@ #top outputs) (maybe.default g!stack ?bottomO))))]
- (wrap (list (` (All [(~ g!stack)]
+ [inputC (singleton (macro.expand-all (stack-fold (get@ #top inputs) (maybe.default (code.symbol g!stack) ?bottomI))))
+ outputC (singleton (macro.expand-all (stack-fold (get@ #top outputs) (maybe.default (code.symbol g!stack) ?bottomO))))]
+ (wrap (list (` (All [(~@ g!stack)]
(-> (~ (de-alias inputC))
(~ (de-alias outputC))))))))))))
@@ -104,33 +104,34 @@
(` (..push (~ command)))
[_ (#.Tuple block)]
- (` (..push (|>> (~@ (L/map prepare block)))))
+ (` (..push (|>> (~+ (list/map prepare block)))))
_
command))
(syntax: #export (||> [commands (p.some s.any)])
- (wrap (list (` (|> ..begin! (~@ (L/map prepare commands)) ..end!)))))
+ (wrap (list (` (|> ..begin! (~+ (list/map prepare commands)) ..end!)))))
(syntax: #export (word: [export csr.export] [name s.local-symbol]
[annotations (p.default cs.empty-annotations csr.annotations)]
type
[commands (p.some s.any)])
- (wrap (list (` (def: (~@ (csw.export export)) (~ (code.local-symbol name))
+ (wrap (list (` (def: (~+ (csw.export export)) (~ (code.local-symbol name))
(~ (csw.annotations annotations))
(~ type)
- (|>> (~@ (L/map prepare commands))))))))
+ (|>> (~+ (list/map prepare commands))))))))
(syntax: #export (apply [arity (|> s.nat (p.filter (.n/> +0)))])
(with-gensyms [g!func g!stack g!output]
(monad.do @
- [g!inputs (|> (macro.gensym "input") (list.repeat arity) (monad.seq @))]
- (wrap (list (` (: (All [(~@ g!inputs) (~ g!output)]
- (-> (-> (~@ g!inputs) (~ g!output))
- (=> [(~@ g!inputs)] [(~ g!output)])))
- (function [(~ g!func)]
- (function [(~ (stack-fold g!inputs g!stack))]
- [(~ g!stack) ((~ g!func) (~@ g!inputs))])))))))))
+ [g!inputs (|> (macro.gensym "input") (list.repeat arity) (monad.seq @))
+ #let [g!inputs (list/map code.symbol g!inputs)]]
+ (wrap (list (` (: (All [(~+ g!inputs) (~@ g!output)]
+ (-> (-> (~+ g!inputs) (~@ g!output))
+ (=> [(~+ g!inputs)] [(~@ g!output)])))
+ (function [(~@ g!func)]
+ (function [(~ (stack-fold g!inputs (code.symbol g!stack)))]
+ [(~@ g!stack) ((~@ g!func) (~+ g!inputs))])))))))))
## [Primitives]
(def: #export apply1 (apply +1))
diff --git a/stdlib/source/lux/control/cont.lux b/stdlib/source/lux/control/cont.lux
index db0202e40..1f50fe547 100644
--- a/stdlib/source/lux/control/cont.lux
+++ b/stdlib/source/lux/control/cont.lux
@@ -57,9 +57,9 @@
(syntax: #export (pending expr)
{#.doc (doc "Turns any expression into a function that is pending a continuation."
- (pending (some-computation some-input)))}
+ (pending (some-function some-input)))}
(with-gensyms [g!k]
- (wrap (list (` (.function [(~ g!k)] ((~ g!k) (~ expr))))))))
+ (wrap (list (` (.function [(~@ g!k)] ((~@ g!k) (~ expr))))))))
(def: #export (portal init)
(All [i o z]
diff --git a/stdlib/source/lux/control/contract.lux b/stdlib/source/lux/control/contract.lux
index ac0ae5432..71d476517 100644
--- a/stdlib/source/lux/control/contract.lux
+++ b/stdlib/source/lux/control/contract.lux
@@ -31,7 +31,7 @@
(i/+ 2 2)))}
(do @
[g!output (macro.gensym "")]
- (wrap (list (` (let [(~ g!output) (~ expr)]
+ (wrap (list (` (let [(~@ g!output) (~ expr)]
(exec (assert! (~ (code.text (format "Post-condition failed: " (%code test))))
- ((~ test) (~ g!output)))
- (~ g!output))))))))
+ ((~ test) (~@ g!output)))
+ (~@ g!output))))))))
diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux
index d14158590..dcac4fc6d 100644
--- a/stdlib/source/lux/control/exception.lux
+++ b/stdlib/source/lux/control/exception.lux
@@ -74,6 +74,6 @@
[current-module macro.current-module-name
#let [descriptor ($_ text/compose "{" current-module "." name "}" "\n")
g!message (code.symbol ["" "message"])]]
- (wrap (list (` (def: (~@ (csw.export _ex-lev)) ((~ (code.symbol ["" name])) (~ g!message))
+ (wrap (list (` (def: (~+ (csw.export _ex-lev)) ((~ (code.symbol ["" name])) (~ g!message))
Exception
(_text/compose_ (~ (code.text descriptor)) (~ g!message))))))))
diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux
index f8208fee6..09b41b530 100644
--- a/stdlib/source/lux/control/pipe.lux
+++ b/stdlib/source/lux/control/pipe.lux
@@ -21,7 +21,7 @@
(new> 0 i/inc)))}
(case (list.reverse tokens)
(^ (list& _ r-body))
- (wrap (list (` (|> (~@ (list.reverse r-body))))))
+ (wrap (list (` (|> (~+ (list.reverse r-body))))))
_
(undefined)))
@@ -45,17 +45,17 @@
[(new> -1)])))}
(with-gensyms [g!temp]
(wrap (list (` (with-expansions
- [(~ g!temp) (~ prev)]
- (cond (~@ (do Monad<List>
+ [(~@ g!temp) (~ prev)]
+ (cond (~+ (do Monad<List>
[[test then] branches]
- (list (` (|> (~ g!temp) (~@ test)))
- (` (|> (~ g!temp) (~@ then))))))
+ (list (` (|> (~@ g!temp) (~+ test)))
+ (` (|> (~@ g!temp) (~+ then))))))
(~ (case ?else
(#.Some else)
- (` (|> (~ g!temp) (~@ else)))
+ (` (|> (~@ g!temp) (~+ else)))
_
- g!temp)))))))))
+ (code.symbol g!temp))))))))))
(syntax: #export (loop> [test body^] [then body^] prev)
{#.doc (doc "Loops for pipes."
@@ -64,10 +64,10 @@
(loop> [(i/< 10)]
[i/inc])))}
(with-gensyms [g!temp]
- (wrap (list (` (loop [(~ g!temp) (~ prev)]
- (if (|> (~ g!temp) (~@ test))
- ((~' recur) (|> (~ g!temp) (~@ then)))
- (~ g!temp))))))))
+ (wrap (list (` (loop [(~@ g!temp) (~ prev)]
+ (if (|> (~@ g!temp) (~+ test))
+ ((~' recur) (|> (~@ g!temp) (~+ then)))
+ (~@ g!temp))))))))
(syntax: #export (do> monad [steps (p.some body^)] prev)
{#.doc (doc "Monadic pipes."
@@ -82,11 +82,11 @@
(^ (list& last-step prev-steps))
(let [step-bindings (do Monad<List>
[step (list.reverse prev-steps)]
- (list g!temp (` (|> (~ g!temp) (~@ step)))))]
+ (list (code.symbol g!temp) (` (|> (~@ g!temp) (~+ step)))))]
(wrap (list (` (do (~ monad)
- [(~ g!temp) (~ prev)
- (~@ step-bindings)]
- (|> (~ g!temp) (~@ last-step)))))))
+ [(~@ g!temp) (~ prev)
+ (~+ step-bindings)]
+ (|> (~@ g!temp) (~+ last-step)))))))
_
(wrap (list prev)))))
@@ -97,11 +97,10 @@
(|> 5
(exec> [int-to-nat %n log!])
(i/* 10)))}
- (do @
- [g!temp (macro.gensym "")]
- (wrap (list (` (let [(~ g!temp) (~ prev)]
- (exec (|> (~ g!temp) (~@ body))
- (~ g!temp))))))))
+ (with-gensyms [g!temp]
+ (wrap (list (` (let [(~@ g!temp) (~ prev)]
+ (exec (|> (~@ g!temp) (~+ body))
+ (~@ g!temp))))))))
(syntax: #export (tuple> [paths (p.many body^)] prev)
{#.doc (doc "Parallel branching for pipes."
@@ -111,10 +110,9 @@
[i/dec (i// 2)]
[Int/encode]))
"Will become: [50 2 \"5\"]")}
- (do @
- [g!temp (macro.gensym "")]
- (wrap (list (` (let [(~ g!temp) (~ prev)]
- [(~@ (L/map (function [body] (` (|> (~ g!temp) (~@ body))))
+ (with-gensyms [g!temp]
+ (wrap (list (` (let [(~@ g!temp) (~ prev)]
+ [(~+ (L/map (function [body] (` (|> (~@ g!temp) (~+ body))))
paths))]))))))
(syntax: #export (case> [branches (p.many (p.seq s.any s.any))] prev)
@@ -133,5 +131,5 @@
9 "nine"
_ "???")))}
(wrap (list (` (case (~ prev)
- (~@ (L/join (L/map (function [[pattern body]] (list pattern body))
+ (~+ (L/join (L/map (function [[pattern body]] (list pattern body))
branches))))))))
diff --git a/stdlib/source/lux/data/coll/list.lux b/stdlib/source/lux/data/coll/list.lux
index 27f4e8bad..9709db465 100644
--- a/stdlib/source/lux/data/coll/list.lux
+++ b/stdlib/source/lux/data/coll/list.lux
@@ -359,27 +359,27 @@
(let [(^open) Functor<List>
indices (n/range +0 (n/dec num-lists))
type-vars (: (List Code) (map (|>> nat/encode symbol$) indices))
- zip-type (` (All [(~@ type-vars)]
- (-> (~@ (map (: (-> Code Code) (function [var] (` (List (~ var)))))
+ zip-type (` (All [(~+ type-vars)]
+ (-> (~+ (map (: (-> Code Code) (function [var] (` (List (~ var)))))
type-vars))
- (List [(~@ type-vars)]))))
+ (List [(~+ type-vars)]))))
vars+lists (|> indices
(map n/inc)
(map (function [idx]
(let [base (nat/encode idx)]
[(symbol$ base)
(symbol$ ("lux text concat" base "'"))]))))
- pattern (` [(~@ (map (function [[v vs]] (` (#.Cons (~ v) (~ vs))))
+ pattern (` [(~+ (map (function [[v vs]] (` (#.Cons (~ v) (~ vs))))
vars+lists))])
g!step (symbol$ "\tstep\t")
g!blank (symbol$ "\t_\t")
list-vars (map product.right vars+lists)
code (` (: (~ zip-type)
- (function (~ g!step) [(~@ list-vars)]
- (case [(~@ list-vars)]
+ (function (~ g!step) [(~+ list-vars)]
+ (case [(~+ list-vars)]
(~ pattern)
- (#.Cons [(~@ (map product.left vars+lists))]
- ((~ g!step) (~@ list-vars)))
+ (#.Cons [(~+ (map product.left vars+lists))]
+ ((~ g!step) (~+ list-vars)))
(~ g!blank)
#.Nil))))]
@@ -405,9 +405,9 @@
g!return-type (symbol$ "\treturn-type\t")
g!func (symbol$ "\tfunc\t")
type-vars (: (List Code) (map (|>> nat/encode symbol$) indices))
- zip-type (` (All [(~@ type-vars) (~ g!return-type)]
- (-> (-> (~@ type-vars) (~ g!return-type))
- (~@ (map (: (-> Code Code) (function [var] (` (List (~ var)))))
+ zip-type (` (All [(~+ type-vars) (~ g!return-type)]
+ (-> (-> (~+ type-vars) (~ g!return-type))
+ (~+ (map (: (-> Code Code) (function [var] (` (List (~ var)))))
type-vars))
(List (~ g!return-type)))))
vars+lists (|> indices
@@ -416,17 +416,17 @@
(let [base (nat/encode idx)]
[(symbol$ base)
(symbol$ ("lux text concat" base "'"))]))))
- pattern (` [(~@ (map (function [[v vs]] (` (#.Cons (~ v) (~ vs))))
+ pattern (` [(~+ (map (function [[v vs]] (` (#.Cons (~ v) (~ vs))))
vars+lists))])
g!step (symbol$ "\tstep\t")
g!blank (symbol$ "\t_\t")
list-vars (map product.right vars+lists)
code (` (: (~ zip-type)
- (function (~ g!step) [(~ g!func) (~@ list-vars)]
- (case [(~@ list-vars)]
+ (function (~ g!step) [(~ g!func) (~+ list-vars)]
+ (case [(~+ list-vars)]
(~ pattern)
- (#.Cons ((~ g!func) (~@ (map product.left vars+lists)))
- ((~ g!step) (~ g!func) (~@ list-vars)))
+ (#.Cons ((~ g!func) (~+ (map product.left vars+lists)))
+ ((~ g!step) (~ g!func) (~+ list-vars)))
(~ g!blank)
#.Nil))))]
diff --git a/stdlib/source/lux/data/coll/sequence.lux b/stdlib/source/lux/data/coll/sequence.lux
index e5d2717fc..bc9787adf 100644
--- a/stdlib/source/lux/data/coll/sequence.lux
+++ b/stdlib/source/lux/data/coll/sequence.lux
@@ -369,7 +369,7 @@
(syntax: #export (sequence [elems (p.some s.any)])
{#.doc (doc "Sequence literals."
(sequence 10 20 30 40))}
- (wrap (list (` (from-list (list (~@ elems)))))))
+ (wrap (list (` (from-list (list (~+ elems)))))))
## [Structures]
(struct: #export (Eq<Node> Eq<a>) (All [a] (-> (Eq a) (Eq (Node a))))
diff --git a/stdlib/source/lux/data/coll/stream.lux b/stdlib/source/lux/data/coll/stream.lux
index 0cfa549bb..d4ab696fd 100644
--- a/stdlib/source/lux/data/coll/stream.lux
+++ b/stdlib/source/lux/data/coll/stream.lux
@@ -6,7 +6,8 @@
[cont #+ pending Cont]
["p" parser])
[macro #+ with-gensyms]
- (macro ["s" syntax #+ syntax: Syntax])
+ (macro [code]
+ ["s" syntax #+ syntax: Syntax])
(data (coll [list "List/" Monad<List>])
bool)))
@@ -134,10 +135,10 @@
"Caveat emptor: Only use it for destructuring, and not for testing values within the streams."
(let [(^stream& x y z _tail) (some-stream-func 1 2 3)]
(func x y z)))}
- (with-gensyms [g!s]
- (let [body+ (` (let [(~@ (List/join (List/map (function [pattern]
- (list (` [(~ pattern) (~ g!s)])
- (` (cont.run (~ g!s)))))
+ (with-gensyms [g!stream]
+ (let [body+ (` (let [(~+ (List/join (List/map (function [pattern]
+ (list (` [(~ pattern) (~@ g!stream)])
+ (` (cont.run (~@ g!stream)))))
patterns)))]
(~ body)))]
- (wrap (list& g!s body+ branches)))))
+ (wrap (list& (code.symbol g!stream) body+ branches)))))
diff --git a/stdlib/source/lux/data/coll/tree/rose.lux b/stdlib/source/lux/data/coll/tree/rose.lux
index 077f68191..76f4f1894 100644
--- a/stdlib/source/lux/data/coll/tree/rose.lux
+++ b/stdlib/source/lux/data/coll/tree/rose.lux
@@ -51,7 +51,7 @@
40 {}}]))}
(wrap (list (` (~ (loop [[value children] root]
(` {#value (~ value)
- #children (list (~@ (L/map recur children)))})))))))
+ #children (list (~+ (L/map recur children)))})))))))
## [Structs]
(struct: #export (Eq<Tree> Eq<a>) (All [a] (-> (Eq a) (Eq (Tree a))))
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index 37d6f954f..2e9a1ec8a 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -75,7 +75,7 @@
(wrap (list (` (: JSON #Null))))
[_ (#.Tuple members)]
- (wrap (list (` (: JSON (#Array (sequence (~@ (list/map wrapper members))))))))
+ (wrap (list (` (: JSON (#Array (sequence (~+ (list/map wrapper members))))))))
[_ (#.Record pairs)]
(do Monad<Meta>
@@ -88,7 +88,7 @@
_
(macro.fail "Wrong syntax for JSON object.")))
pairs)]
- (wrap (list (` (: JSON (#Object (dict.from-list text.Hash<Text> (list (~@ pairs')))))))))
+ (wrap (list (` (: JSON (#Object (dict.from-list text.Hash<Text> (list (~+ pairs')))))))))
_
(wrap (list token))
diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux
index 27c60afa9..54be54080 100644
--- a/stdlib/source/lux/data/lazy.lux
+++ b/stdlib/source/lux/data/lazy.lux
@@ -5,7 +5,7 @@
[applicative #+ Applicative]
[monad #+ Monad do])
(concurrency [atom])
- [macro]
+ [macro #+ with-gensyms]
(macro ["s" syntax #+ syntax:])
(type abstract)))
@@ -30,9 +30,8 @@
((@repr l-value) [])))
(syntax: #export (freeze expr)
- (do @
- [g!_ (macro.gensym "_")]
- (wrap (list (` (freeze' (function [(~ g!_)] (~ expr))))))))
+ (with-gensyms [g!_]
+ (wrap (list (` (freeze' (function [(~@ g!_)] (~ expr))))))))
(struct: #export _ (Functor Lazy)
(def: (map f fa)
diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux
index e1c93bc5f..f70a109f8 100644
--- a/stdlib/source/lux/data/text/format.lux
+++ b/stdlib/source/lux/data/text/format.lux
@@ -26,7 +26,7 @@
(syntax: #export (format [fragments (p.many s.any)])
{#.doc (doc "Text interpolation."
(format "Static part " (%t static) " does not match URI: " uri))}
- (wrap (list (` ($_ _compose_ (~@ fragments))))))
+ (wrap (list (` ($_ _compose_ (~+ fragments))))))
## [Formatters]
(type: #export (Formatter a)
diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux
index 1f1a0a3c0..bee56b728 100644
--- a/stdlib/source/lux/data/text/regex.lux
+++ b/stdlib/source/lux/data/text/regex.lux
@@ -10,7 +10,7 @@
["e" error]
[maybe]
(coll [list "list/" Fold<List> Monad<List>]))
- [macro #- run]
+ [macro #+ with-gensyms]
(macro [code]
["s" syntax #+ syntax:])))
@@ -103,8 +103,8 @@
re-range^
re-options^))]
(wrap (case negate?
- (#.Some _) (` (l.not ($_ p.either (~@ parts))))
- #.None (` ($_ p.either (~@ parts)))))))
+ (#.Some _) (` (l.not ($_ p.either (~+ parts))))
+ #.None (` ($_ p.either (~+ parts)))))))
(def: re-user-class^
(l.Lexer Code)
@@ -308,8 +308,8 @@
+0)
(` (do p.Monad<Parser>
[(~ (' #let)) [(~ g!total) ""]
- (~@ (|> steps list.reverse list/join))]
- ((~ (' wrap)) [(~ g!total) (~@ (list.reverse names))])))])
+ (~+ (|> steps list.reverse list/join))]
+ ((~ (' wrap)) [(~ g!total) (~+ (list.reverse names))])))])
))
(def: #hidden (unflatten^ lexer)
@@ -367,7 +367,7 @@
(if (list.empty? tail)
(wrap head)
(wrap [(list/fold n/max (product.left head) (list/map product.left tail))
- (` ($_ (~ g!op) (~ (prep-alternative head)) (~@ (list/map prep-alternative tail))))]))))
+ (` ($_ (~ g!op) (~ (prep-alternative head)) (~+ (list/map prep-alternative tail))))]))))
(def: (re-scoped^ current-module)
(-> Text (l.Lexer [Re-Group Code]))
@@ -484,11 +484,10 @@
_
do-something-else))}
- (do @
- [g!temp (macro.gensym "temp")]
- (wrap (list& (` (^multi (~ g!temp)
- [(l.run (~ g!temp) (regex (~ (code.text pattern))))
- (#e.Success (~ (maybe.default g!temp
+ (with-gensyms [g!temp]
+ (wrap (list& (` (^multi (~@ g!temp)
+ [(l.run (~@ g!temp) (regex (~ (code.text pattern))))
+ (#e.Success (~ (maybe.default (code.symbol g!temp)
bindings)))]))
body
branches))))
diff --git a/stdlib/source/lux/host.js.lux b/stdlib/source/lux/host.js.lux
index 5e52cc283..fafaa81c7 100644
--- a/stdlib/source/lux/host.js.lux
+++ b/stdlib/source/lux/host.js.lux
@@ -77,8 +77,8 @@
(case shape
(#.Left [function args ?type])
(wrap (list (` (:! (~ (default (' ..Object) ?type))
- ("js call" (~ function) (~@ args))))))
+ ("js call" (~ function) (~+ args))))))
(#.Right [object field args ?type])
(wrap (list (` (:! (~ (default (' ..Object) ?type))
- ("js object-call" (~ object) (~ (code.text field)) (~@ args))))))))
+ ("js object-call" (~ object) (~ (code.text field)) (~+ args))))))))
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index a53ec1a5f..29937c041 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -290,7 +290,7 @@
[[name params] _ _]
(let [name (sanitize name)
=params (list/map (class->type' mode type-params in-array?) params)]
- (` (primitive (~ (code.text name)) [(~@ =params)])))))
+ (` (primitive (~ (code.text name)) [(~+ =params)])))))
(def: (class->type' mode type-params in-array? class)
(-> Primitive-Mode (List TypeParam) Bool GenericType Code)
@@ -341,7 +341,7 @@
(class->type #ManualPrM class-params bound1))))
class-params)]
(` (primitive (~ (code.text (sanitize class-name)))
- [(~@ =params)]))))
+ [(~+ =params)]))))
(def: empty-imports
Class-Imports
@@ -579,7 +579,7 @@
(s.form ($_ p.seq (s.this (' ::new!)) (s.tuple (p.exactly (list.size arg-decls) s.any)))))
#let [arg-decls' (: (List Text) (list/map (|>> product.right (simple-class$ params)) arg-decls))]]
(wrap (` ((~ (code.text (format "jvm new" ":" class-name ":" (text.join-with "," arg-decls'))))
- (~@ args))))))
+ (~+ args))))))
(def: (make-static-method-parser params class-name method-name arg-decls)
(-> (List TypeParam) Text Text (List ArgDecl) (Syntax Code))
@@ -589,7 +589,7 @@
(s.form ($_ p.seq (s.this (code.symbol ["" dotted-name])) (s.tuple (p.exactly (list.size arg-decls) s.any)))))
#let [arg-decls' (: (List Text) (list/map (|>> product.right (simple-class$ params)) arg-decls))]]
(wrap (`' ((~ (code.text (format "jvm invokestatic" ":" class-name ":" method-name ":" (text.join-with "," arg-decls'))))
- (~@ args))))))
+ (~+ args))))))
(do-template [<name> <jvm-op>]
[(def: (<name> params class-name method-name arg-decls)
@@ -600,7 +600,7 @@
(s.form ($_ p.seq (s.this (code.symbol ["" dotted-name])) (s.tuple (p.exactly (list.size arg-decls) s.any)))))
#let [arg-decls' (: (List Text) (list/map (|>> product.right (simple-class$ params)) arg-decls))]]
(wrap (`' ((~ (code.text (format <jvm-op> ":" class-name ":" method-name ":" (text.join-with "," arg-decls'))))
- (~' _jvm_this) (~@ args))))))]
+ (~' _jvm_this) (~+ args))))))]
[make-special-method-parser "jvm invokespecial"]
[make-virtual-method-parser "jvm invokevirtual"]
@@ -1206,7 +1206,7 @@
#let [arg-decls' (: (List Text) (list/map (|>> product.right (simple-class$ (list)))
arg-decls))]]
(wrap (`' ((~ (code.text (format "jvm invokespecial" ":" (get@ #super-class-name super-class) ":" name ":" (text.join-with "," arg-decls'))))
- (~' _jvm_this) (~@ args)))))))]
+ (~' _jvm_this) (~+ args)))))))]
(with-parens
(spaced (list "override"
(class-decl$ class-decl)
@@ -1259,9 +1259,9 @@
(generic-type$ return-type))))
))
-(def: (complete-call$ obj [method args])
- (-> Code Partial-Call Code)
- (` ((~ method) (~ args) (~ obj))))
+(def: (complete-call$ g!obj [method args])
+ (-> Ident Partial-Call Code)
+ (` ((~ method) (~ args) (~@ g!obj))))
## [Syntax]
(def: object-super-class
@@ -1402,10 +1402,10 @@
"=>"
(#.Some "YOLO"))}
(with-gensyms [g!temp]
- (wrap (list (` (let [(~ g!temp) (~ expr)]
- (if ("jvm null?" (~ g!temp))
+ (wrap (list (` (let [(~@ g!temp) (~ expr)]
+ (if ("jvm null?" (~@ g!temp))
#.None
- (#.Some (~ g!temp)))))))))
+ (#.Some (~@ g!temp)))))))))
(syntax: #export (!!! expr)
{#.doc (doc "Takes a (Maybe ObjectType) and returns a ObjectType."
@@ -1418,8 +1418,8 @@
"YOLO")}
(with-gensyms [g!value]
(wrap (list (` ("lux case" (~ expr)
- {(#.Some (~ g!value))
- (~ g!value)
+ {(#.Some (~@ g!value))
+ (~@ g!value)
#.None
("jvm null")}))))))
@@ -1430,7 +1430,7 @@
"If it fails, you get (#.Left error+stack-traces-as-text)."
(try (risky-computation input)))}
(with-gensyms [g!_]
- (wrap (list (`' ("lux try" (.function [(~ g!_)] (~ expr))))))))
+ (wrap (list (`' ("lux try" (.function [(~@ g!_)] (~ expr))))))))
(syntax: #export (instance? [#let [imports (class-imports *compiler*)]]
[class (generic-type^ imports (list))]
@@ -1446,8 +1446,8 @@
(do @
[g!obj (macro.gensym "obj")]
(wrap (list (` (: (-> (primitive "java.lang.Object") Bool)
- (function [(~ g!obj)]
- ((~ (code.text (format "jvm instanceof" ":" (simple-class$ (list) class)))) (~ g!obj))))))))
+ (function [(~@ g!obj)]
+ ((~ (code.text (format "jvm instanceof" ":" (simple-class$ (list) class)))) (~@ g!obj))))))))
))
(syntax: #export (synchronized lock body)
@@ -1464,9 +1464,9 @@
(ClassName::method1 [arg0 arg1 arg2])
(ClassName::method2 [arg3 arg4 arg5])))}
(with-gensyms [g!obj]
- (wrap (list (` (let [(~ g!obj) (~ obj)]
- (exec (~@ (list/map (complete-call$ g!obj) methods))
- (~ g!obj))))))))
+ (wrap (list (` (let [(~@ g!obj) (~ obj)]
+ (exec (~+ (list/map (complete-call$ g!obj) methods))
+ (~@ g!obj))))))))
(def: (class-import$ long-name? [full-name params])
(-> Bool ClassDecl Code)
@@ -1478,9 +1478,9 @@
{#.type? true
#..jvm-class (~ (code.text full-name))}
Type
- (All [(~@ params')]
+ (All [(~+ params')]
(primitive (~ (code.text (sanitize full-name)))
- [(~@ params')]))))))
+ [(~+ params')]))))))
(def: (member-type-vars class-tvars member)
(-> (List TypeParam) ImportMemberDecl (List TypeParam))
@@ -1509,9 +1509,10 @@
(: (-> [Bool GenericType] (Meta [Code Code]))
(function [[maybe? _]]
(with-gensyms [arg-name]
- (wrap [arg-name (if maybe?
- (` (!!! (~ arg-name)))
- arg-name)]))))
+ (let [arg-name (code.symbol arg-name)]
+ (wrap [arg-name (if maybe?
+ (` (!!! (~ arg-name)))
+ arg-name)])))))
import-member-args)
#let [arg-classes (: (List Text)
(list/map (|>> product.right (simple-class$ (list/compose type-params import-member-tvars)))
@@ -1550,11 +1551,11 @@
[(` (Maybe (~ return-type)))
(` (??? (~ return-term)))]
[return-type
- (let [g!temp (code.symbol ["" "Ω"])]
- (` (let [(~ g!temp) (~ return-term)]
+ (let [g!temp ["" "Ω"]]
+ (` (let [(~@ g!temp) (~ return-term)]
(if (not (null? (:! (primitive "java.lang.Object")
- (~ g!temp))))
- (~ g!temp)
+ (~@ g!temp))))
+ (~@ g!temp)
(error! "Cannot produce null references from method calls.")))))])
_
@@ -1634,7 +1635,7 @@
body
#AutoPrM
- (` (let [(~@ (|> inputs
+ (` (let [(~+ (|> inputs
(list/map auto-conv)
list/join))]
(~ body)))))
@@ -1653,19 +1654,19 @@
"float" (` (f2d (~ output)))
_ output)))
-(def: (with-mode-field-set mode class input)
- (-> Primitive-Mode GenericType Code Code)
+(def: (with-mode-field-set mode class g!input)
+ (-> Primitive-Mode GenericType Ident Code)
(case mode
#ManualPrM
- input
+ (code.symbol g!input)
#AutoPrM
(case (simple-class$ (list) class)
- "byte" (` (l2b (~ input)))
- "short" (` (l2s (~ input)))
- "int" (` (l2i (~ input)))
- "float" (` (d2f (~ input)))
- _ input)))
+ "byte" (` (l2b (~@ g!input)))
+ "short" (` (l2s (~@ g!input)))
+ "int" (` (l2i (~@ g!input)))
+ "float" (` (d2f (~@ g!input)))
+ _ (code.symbol g!input))))
(def: (member-def-interop type-params kind class [arg-function-inputs arg-method-inputs arg-classes arg-types] member method-prefix)
(-> (List TypeParam) ClassKind ClassDecl [(List Code) (List Code) (List Text) (List Code)] ImportMemberDecl Text (Meta (List Code)))
@@ -1686,7 +1687,7 @@
(let [=class-tvars (|> class-tvars
(list.filter free-type-param?)
(list/map type-param->type-arg))]
- (` (All [(~@ =class-tvars)] (primitive (~ (code.text full-name)) [(~@ =class-tvars)]))))))
+ (` (All [(~+ =class-tvars)] (primitive (~ (code.text full-name)) [(~+ =class-tvars)]))))))
getter-interop (: (-> Text Code)
(function [name]
(let [getter-name (code.symbol ["" (format method-prefix member-separator name)])]
@@ -1701,15 +1702,15 @@
#let [def-name (code.symbol ["" (format method-prefix member-separator (get@ #import-member-alias commons))])
def-params (list (code.tuple arg-function-inputs))
jvm-interop (|> (` ((~ (code.text (format "jvm new" ":" full-name ":" (text.join-with "," arg-classes))))
- (~@ arg-method-inputs)))
+ (~+ arg-method-inputs)))
(with-mode-inputs (get@ #import-member-mode commons)
(list.zip2 arg-classes arg-function-inputs)))
[return-type jvm-interop] (|> [return-type jvm-interop]
(decorate-return-maybe member)
(decorate-return-try member)
(decorate-return-io member))]]
- (wrap (list (` (def: ((~ def-name) (~@ def-params))
- (All [(~@ all-params)] (-> [(~@ arg-types)] (~ return-type)))
+ (wrap (list (` (def: ((~ def-name) (~+ def-params))
+ (All [(~+ all-params)] (-> [(~+ arg-types)] (~ return-type)))
(~ jvm-interop))))))
(#MethodDecl [commons method])
@@ -1730,19 +1731,19 @@
(case kind
#Class
["invokevirtual"
- (list g!obj)
+ (list (code.symbol g!obj))
(list (class-decl-type$ class))]
#Interface
["invokeinterface"
- (list g!obj)
+ (list (code.symbol g!obj))
(list (class-decl-type$ class))]
)))
def-params (#.Cons (code.tuple arg-function-inputs) obj-ast)
- def-param-types (#.Cons (` [(~@ arg-types)]) class-ast)
+ def-param-types (#.Cons (` [(~+ arg-types)]) class-ast)
jvm-interop (|> (` ((~ (code.text (format "jvm " jvm-op ":" full-name ":" import-method-name
":" (text.join-with "," arg-classes))))
- (~@ obj-ast) (~@ arg-method-inputs)))
+ (~+ obj-ast) (~+ arg-method-inputs)))
(with-mode-output (get@ #import-member-mode commons)
(get@ #import-method-return method))
(with-mode-inputs (get@ #import-member-mode commons)
@@ -1751,16 +1752,16 @@
(decorate-return-maybe member)
(decorate-return-try member)
(decorate-return-io member))]]
- (wrap (list (` (def: ((~ def-name) (~@ def-params))
- (All [(~@ all-params)] (-> (~@ def-param-types) (~ return-type)))
+ (wrap (list (` (def: ((~ def-name) (~+ def-params))
+ (All [(~+ all-params)] (-> (~+ def-param-types) (~ return-type)))
(~ jvm-interop)))))))
(#FieldAccessDecl fad)
(do Monad<Meta>
[#let [(^open) fad
base-gtype (class->type import-field-mode type-params import-field-type)
- g!class (class-decl-type$ class)
- g!type (if import-field-maybe?
+ classC (class-decl-type$ class)
+ typeC (if import-field-maybe?
(` (Maybe (~ base-gtype)))
base-gtype)
tvar-asts (: (List Code)
@@ -1772,19 +1773,19 @@
getter-interop (with-gensyms [g!obj]
(let [getter-call (if import-field-static?
getter-name
- (` ((~ getter-name) (~ g!obj))))
+ (` ((~ getter-name) (~@ g!obj))))
getter-type (if import-field-setter?
- (` (IO (~ g!type)))
- g!type)
+ (` (IO (~ typeC)))
+ typeC)
getter-type (if import-field-static?
getter-type
- (` (-> (~ g!class) (~ getter-type))))
- getter-type (` (All [(~@ tvar-asts)] (~ getter-type)))
+ (` (-> (~ classC) (~ getter-type))))
+ getter-type (` (All [(~+ tvar-asts)] (~ getter-type)))
getter-body (if import-field-static?
(with-mode-field-get import-field-mode import-field-type
(` ((~ (code.text (format "jvm getstatic" ":" full-name ":" import-field-name))))))
(with-mode-field-get import-field-mode import-field-type
- (` ((~ (code.text (format "jvm getfield" ":" full-name ":" import-field-name))) (~ g!obj)))))
+ (` ((~ (code.text (format "jvm getfield" ":" full-name ":" import-field-name))) (~@ g!obj)))))
getter-body (if import-field-maybe?
(` (??? (~ getter-body)))
getter-body)
@@ -1797,11 +1798,11 @@
setter-interop (if import-field-setter?
(with-gensyms [g!obj g!value]
(let [setter-call (if import-field-static?
- (` ((~ setter-name) (~ g!value)))
- (` ((~ setter-name) (~ g!value) (~ g!obj))))
+ (` ((~ setter-name) (~@ g!value)))
+ (` ((~ setter-name) (~@ g!value) (~@ g!obj))))
setter-type (if import-field-static?
- (` (All [(~@ tvar-asts)] (-> (~ g!type) (IO Unit))))
- (` (All [(~@ tvar-asts)] (-> (~ g!type) (~ g!class) (IO Unit)))))
+ (` (All [(~+ tvar-asts)] (-> (~ typeC) (IO Unit))))
+ (` (All [(~+ tvar-asts)] (-> (~ typeC) (~ classC) (IO Unit)))))
setter-value (with-mode-field-set import-field-mode import-field-type g!value)
setter-value (if import-field-maybe?
(` (!!! (~ setter-value)))
@@ -1980,8 +1981,8 @@
_
(with-gensyms [g!array]
- (wrap (list (` (let [(~ g!array) (~ array)]
- (..array-read (~ idx) (~ g!array)))))))))
+ (wrap (list (` (let [(~@ g!array) (~ array)]
+ (..array-read (~ idx) (~@ g!array)))))))))
(syntax: #export (array-write idx value array)
{#.doc (doc "Stores an element into an array."
@@ -2009,8 +2010,8 @@
_
(with-gensyms [g!array]
- (wrap (list (` (let [(~ g!array) (~ array)]
- (..array-write (~ idx) (~ value) (~ g!array)))))))))
+ (wrap (list (` (let [(~@ g!array) (~ array)]
+ (..array-write (~ idx) (~ value) (~@ g!array)))))))))
(def: simple-bindings^
(Syntax (List [Text Code]))
@@ -2033,10 +2034,10 @@
(` (try ("jvm invokevirtual:java.io.Closeable:close:" (~ (code.symbol ["" (product.left res)]))))))
bindings)]
(wrap (list (` (do Monad<IO>
- [(~@ inits)
- (~ g!output) (~ body)
- (~' #let) [(~ g!_) (exec (~@ (list.reverse closes)) [])]]
- ((~' wrap) (~ g!output)))))))))
+ [(~+ inits)
+ (~@ g!output) (~ body)
+ (~' #let) [(~@ g!_) (exec (~+ (list.reverse closes)) [])]]
+ ((~' wrap) (~@ g!output)))))))))
(syntax: #export (class-for [#let [imports (class-imports *compiler*)]]
[type (generic-type^ imports (list))])
diff --git a/stdlib/source/lux/lang/type.lux b/stdlib/source/lux/lang/type.lux
index ab680cb6c..43febdb8c 100644
--- a/stdlib/source/lux/lang/type.lux
+++ b/stdlib/source/lux/lang/type.lux
@@ -169,7 +169,7 @@
(case type
(#.Primitive name params)
(` (#.Primitive (~ (code.text name))
- (list (~@ (list/map to-ast params)))))
+ (list (~+ (list/map to-ast params)))))
(^template [<tag>]
<tag>
@@ -189,7 +189,7 @@
(^template [<tag> <macro> <flattener>]
(<tag> left right)
- (` (<macro> (~@ (list/map to-ast (<flattener> type))))))
+ (` (<macro> (~+ (list/map to-ast (<flattener> type))))))
([#.Sum | flatten-variant]
[#.Product & flatten-tuple])
@@ -198,7 +198,7 @@
(^template [<tag>]
(<tag> env body)
- (` (<tag> (list (~@ (list/map to-ast env)))
+ (` (<tag> (list (~+ (list/map to-ast env)))
(~ (to-ast body)))))
([#.UnivQ] [#.ExQ])
))
diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux
index 0b28598c8..384a723c9 100644
--- a/stdlib/source/lux/macro.lux
+++ b/stdlib/source/lux/macro.lux
@@ -361,10 +361,10 @@
{#.doc "Generates a unique identifier as an Code node (ready to be used in code templates).
A prefix can be given (or just be empty text \"\") to better identify the code for debugging purposes."}
- (-> Text (Meta Code))
+ (-> Text (Meta Ident))
(function [compiler]
(#e.Success [(update@ #.seed n/inc compiler)
- (code.symbol ["" ($_ text/compose "__gensym__" prefix (:: number.Codec<Text,Nat> encode (get@ #.seed compiler)))])])))
+ ["" ($_ text/compose "__gensym__" prefix (:: number.Codec<Text,Nat> encode (get@ #.seed compiler)))]])))
(def: (get-local-symbol ast)
(-> Code (Meta Text))
@@ -379,11 +379,11 @@
{#.doc (doc "Creates new symbols and offers them to the body expression."
(syntax: #export (synchronized lock body)
(with-gensyms [g!lock g!body g!_]
- (wrap (list (` (let [(~ g!lock) (~ lock)
- (~ g!_) ("jvm monitorenter" (~ g!lock))
- (~ g!body) (~ body)
- (~ g!_) ("jvm monitorexit" (~ g!lock))]
- (~ g!body)))))
+ (wrap (list (` (let [(~@ g!lock) (~ lock)
+ (~@ g!_) ("jvm monitorenter" (~ g!lock))
+ (~@ g!body) (~ body)
+ (~@ g!_) ("jvm monitorexit" (~ g!lock))]
+ (~@ g!body)))))
)))}
(case tokens
(^ (list [_ (#.Tuple symbols)] body))
@@ -393,7 +393,7 @@
(function [name] (list (code.symbol ["" name]) (` (gensym (~ (code.text name)))))))
symbol-names))]]
(wrap (list (` (do Monad<Meta>
- [(~@ symbol-defs)]
+ [(~+ symbol-defs)]
(~ body))))))
_
diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux
index 05a609e1b..118723709 100644
--- a/stdlib/source/lux/macro/poly.lux
+++ b/stdlib/source/lux/macro/poly.lux
@@ -200,7 +200,7 @@
(let [partialI (|> current-arg (n/* +2) (n/+ funcI))
partial-varI (n/inc partialI)
partial-varL (label partial-varI)
- partialC (` ((~ funcL) (~@ (|> (list.n/range +0 (n/dec num-args))
+ partialC (` ((~ funcL) (~+ (|> (list.n/range +0 (n/dec num-args))
(list/map (|>> (n/* +2) n/inc (n/+ funcI) label))
list.reverse))))]
(recur (n/inc current-arg)
@@ -336,7 +336,7 @@
(|> allT
(monad.map @ (function.const bound))
(local allT)))]
- (wrap (` ((~@ allC))))))
+ (wrap (` ((~+ allC))))))
(def: #export log
(All [a] (Poly a))
@@ -352,21 +352,21 @@
[name s.local-symbol]
body)
(with-gensyms [g!type g!output]
- (let [g!name (code.symbol ["" name])]
- (wrap (.list (` (syntax: (~@ (csw.export export)) ((~ g!name) [(~ g!type) s.symbol])
+ (let [g!name ["" name]]
+ (wrap (.list (` (syntax: (~+ (csw.export export)) ((~@ g!name) [(~@ g!type) s.symbol])
(do macro.Monad<Meta>
- [(~ g!type) (macro.find-type-def (~ g!type))]
+ [(~@ g!type) (macro.find-type-def (~@ g!type))]
(case (|> (~ body)
- (.function [(~ g!name)])
+ (.function [(~@ g!name)])
p.rec
(do p.Monad<Parser> [])
- (..run (~ g!type))
+ (..run (~@ g!type))
(: (.Either .Text .Code)))
- (#.Left (~ g!output))
- (macro.fail (~ g!output))
+ (#.Left (~@ g!output))
+ (macro.fail (~@ g!output))
- (#.Right (~ g!output))
- ((~' wrap) (.list (~ g!output))))))))))))
+ (#.Right (~@ g!output))
+ ((~' wrap) (.list (~@ g!output))))))))))))
(def: (common-poly-name? poly-func)
(-> Text Bool)
@@ -400,8 +400,8 @@
custom-impl
#.None
- (` ((~ (code.symbol poly-func)) (~@ (list/map code.symbol poly-args)))))]]
- (wrap (.list (` (def: (~@ (csw.export export))
+ (` ((~ (code.symbol poly-func)) (~+ (list/map code.symbol poly-args)))))]]
+ (wrap (.list (` (def: (~+ (csw.export export))
(~ (code.symbol ["" name]))
{#.struct? true}
(~ impl)))))))
@@ -412,7 +412,7 @@
(case type
(#.Primitive name params)
(` (#.Primitive (~ (code.text name))
- (list (~@ (list/map (to-ast env) params)))))
+ (list (~+ (list/map (to-ast env) params)))))
(^template [<tag>]
<tag>
@@ -444,7 +444,7 @@
(^template [<tag> <macro> <flattener>]
(<tag> left right)
- (` (<macro> (~@ (list/map (to-ast env) (<flattener> type))))))
+ (` (<macro> (~+ (list/map (to-ast env) (<flattener> type))))))
([#.Sum | type.flatten-variant]
[#.Product & type.flatten-tuple])
@@ -453,7 +453,7 @@
(^template [<tag>]
(<tag> scope body)
- (` (<tag> (list (~@ (list/map (to-ast env) scope)))
+ (` (<tag> (list (~+ (list/map (to-ast env) scope)))
(~ (to-ast env body)))))
([#.UnivQ] [#.ExQ])
))
diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux
index 46feab967..3550df0c0 100644
--- a/stdlib/source/lux/macro/poly/eq.lux
+++ b/stdlib/source/lux/macro/poly/eq.lux
@@ -100,7 +100,7 @@
(wrap (` (: (~ (@Eq inputT))
(function [(~ g!left) (~ g!right)]
(case [(~ g!left) (~ g!right)]
- (~@ (list/join (list/map (function [[tag g!eq]]
+ (~+ (list/join (list/map (function [[tag g!eq]]
(list (` [((~ (code.nat tag)) (~ g!left))
((~ (code.nat tag)) (~ g!right))])
(` ((~ g!eq) (~ g!left) (~ g!right)))))
@@ -114,8 +114,8 @@
g!lefts (list/map (|>> nat/encode (text/compose "left") code.local-symbol) indices)
g!rights (list/map (|>> nat/encode (text/compose "right") code.local-symbol) indices)]]
(wrap (` (: (~ (@Eq inputT))
- (function [[(~@ g!lefts)] [(~@ g!rights)]]
- (and (~@ (|> (list.zip3 g!eqs g!lefts g!rights)
+ (function [[(~+ g!lefts)] [(~+ g!rights)]]
+ (and (~+ (|> (list.zip3 g!eqs g!lefts g!rights)
(list/map (function [[g!eq g!left g!right]]
(` ((~ g!eq) (~ g!left) (~ g!right)))))))))))))
## Type recursion
@@ -128,16 +128,16 @@
## Type applications
(do @
[[funcC argsC] (poly.apply (p.seq Eq<?> (p.many Eq<?>)))]
- (wrap (` ((~ funcC) (~@ argsC)))))
+ (wrap (` ((~ funcC) (~+ argsC)))))
## Bound type-vars
poly.bound
## Polymorphism
(do @
[[funcC varsC bodyC] (poly.polymorphic Eq<?>)]
- (wrap (` (: (All [(~@ varsC)]
- (-> (~@ (list/map (|>> (~) eq.Eq (`)) varsC))
- (eq.Eq ((~ (poly.to-ast *env* inputT)) (~@ varsC)))))
- (function (~ funcC) [(~@ varsC)]
+ (wrap (` (: (All [(~+ varsC)]
+ (-> (~+ (list/map (|>> (~) eq.Eq (`)) varsC))
+ (eq.Eq ((~ (poly.to-ast *env* inputT)) (~+ varsC)))))
+ (function (~ funcC) [(~+ varsC)]
(~ bodyC))))))
poly.recursive-call
## If all else fails...
diff --git a/stdlib/source/lux/macro/poly/functor.lux b/stdlib/source/lux/macro/poly/functor.lux
index fbd8dcd03..79740c32c 100644
--- a/stdlib/source/lux/macro/poly/functor.lux
+++ b/stdlib/source/lux/macro/poly/functor.lux
@@ -30,8 +30,8 @@
(if (n/= +1 num-vars)
(` (functor.Functor (~ (poly.to-ast *env* unwrappedT))))
(let [paramsC (|> num-vars n/dec list.indices (L/map (|>> %n code.local-symbol)))]
- (` (All [(~@ paramsC)]
- (functor.Functor ((~ (poly.to-ast *env* unwrappedT)) (~@ paramsC)))))))))
+ (` (All [(~+ paramsC)]
+ (functor.Functor ((~ (poly.to-ast *env* unwrappedT)) (~+ paramsC)))))))))
Arg<?> (: (-> Code (poly.Poly Code))
(function Arg<?> [valueC]
($_ p.either
@@ -45,7 +45,7 @@
[_ (wrap [])
membersC (poly.variant (p.many (Arg<?> valueC)))]
(wrap (` (case (~ valueC)
- (~@ (L/join (L/map (function [[tag memberC]]
+ (~+ (L/join (L/map (function [[tag memberC]]
(list (` ((~ (code.nat tag)) (~ valueC)))
(` ((~ (code.nat tag)) (~ memberC)))))
(list.enumerate membersC))))))))
@@ -63,8 +63,8 @@
(L/compose pairsCC (list [slotC memberC])))))
(wrap pairsCC)))))]
(wrap (` (case (~ valueC)
- [(~@ (L/map product.left pairsCC))]
- [(~@ (L/map product.right pairsCC))]))))
+ [(~+ (L/map product.left pairsCC))]
+ [(~+ (L/map product.right pairsCC))]))))
## Functions
(do @
[_ (wrap [])
@@ -74,8 +74,8 @@
#let [inC+ (|> (list.size inT+) n/dec
(list.n/range +0)
(L/map (|>> %n (format "\u0000inC") code.local-symbol)))]]
- (wrap (` (function [(~@ inC+)]
- (let [(~ outL) ((~ valueC) (~@ inC+))]
+ (wrap (` (function [(~+ inC+)]
+ (let [(~ outL) ((~ valueC) (~+ inC+))]
(~ outC))))))
## Recursion
(do p.Monad<Parser>
diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux
index 3a5148377..a81ca1bb4 100644
--- a/stdlib/source/lux/macro/poly/json.lux
+++ b/stdlib/source/lux/macro/poly/json.lux
@@ -150,7 +150,7 @@
(wrap (` (: (~ (@JSON//encode inputT))
(function [(~ g!input)]
(case (~ g!input)
- (~@ (list/join (list/map (function [[tag g!encode]]
+ (~+ (list/join (list/map (function [[tag g!encode]]
(list (` ((~ (code.nat tag)) (~ g!input)))
(` (//.json [(~ (code.frac (..tag tag)))
((~ g!encode) (~ g!input))]))))
@@ -161,8 +161,8 @@
(list.n/range +0)
(list/map (|>> nat/encode code.local-symbol)))]]
(wrap (` (: (~ (@JSON//encode inputT))
- (function [[(~@ g!members)]]
- (//.json [(~@ (list/map (function [[g!member g!encode]]
+ (function [[(~+ g!members)]]
+ (//.json [(~+ (list/map (function [[g!member g!encode]]
(` ((~ g!encode) (~ g!member))))
(list.zip2 g!members g!encoders)))]))))))
## Type recursion
@@ -175,16 +175,16 @@
## Type applications
(do @
[partsC (poly.apply (p.many Codec<JSON,?>//encode))]
- (wrap (` ((~@ partsC)))))
+ (wrap (` ((~+ partsC)))))
## Polymorphism
(do @
[[funcC varsC bodyC] (poly.polymorphic Codec<JSON,?>//encode)]
- (wrap (` (: (All [(~@ varsC)]
- (-> (~@ (list/map (function [varC] (` (-> (~ varC) //.JSON)))
+ (wrap (` (: (All [(~+ varsC)]
+ (-> (~+ (list/map (function [varC] (` (-> (~ varC) //.JSON)))
varsC))
- (-> ((~ (poly.to-ast *env* inputT)) (~@ varsC))
+ (-> ((~ (poly.to-ast *env* inputT)) (~+ varsC))
//.JSON)))
- (function (~ funcC) [(~@ varsC)]
+ (function (~ funcC) [(~+ varsC)]
(~ bodyC))))))
poly.bound
poly.recursive-call
@@ -252,7 +252,7 @@
[members (poly.variant (p.many Codec<JSON,?>//decode))]
(wrap (` (: (~ (@JSON//decode inputT))
($_ p.alt
- (~@ (list/map (function [[tag memberC]]
+ (~+ (list/map (function [[tag memberC]]
(` (|> (~ memberC)
(p.after (//.number! (~ (code.frac (..tag tag)))))
//.array)))
@@ -260,7 +260,7 @@
(do @
[g!decoders (poly.tuple (p.many Codec<JSON,?>//decode))]
(wrap (` (: (~ (@JSON//decode inputT))
- (//.array ($_ p.seq (~@ g!decoders)))))))
+ (//.array ($_ p.seq (~+ g!decoders)))))))
## Type recursion
(do @
[[selfC bodyC] (poly.recursive Codec<JSON,?>//decode)]
@@ -271,14 +271,14 @@
## Type applications
(do @
[[funcC argsC] (poly.apply (p.seq Codec<JSON,?>//decode (p.many Codec<JSON,?>//decode)))]
- (wrap (` ((~ funcC) (~@ argsC)))))
+ (wrap (` ((~ funcC) (~+ argsC)))))
## Polymorphism
(do @
[[funcC varsC bodyC] (poly.polymorphic Codec<JSON,?>//decode)]
- (wrap (` (: (All [(~@ varsC)]
- (-> (~@ (list/map (|>> (~) //.Reader (`)) varsC))
- (//.Reader ((~ (poly.to-ast *env* inputT)) (~@ varsC)))))
- (function (~ funcC) [(~@ varsC)]
+ (wrap (` (: (All [(~+ varsC)]
+ (-> (~+ (list/map (|>> (~) //.Reader (`)) varsC))
+ (//.Reader ((~ (poly.to-ast *env* inputT)) (~+ varsC)))))
+ (function (~ funcC) [(~+ varsC)]
(~ bodyC))))))
poly.bound
poly.recursive-call
@@ -308,5 +308,5 @@
(with-gensyms [g!inputs]
(wrap (list (` (: (Codec //.JSON (~ inputT))
(struct (def: (~' encode) (Codec<JSON,?>//encode (~ inputT)))
- (def: ((~' decode) (~ g!inputs)) (//.run (~ g!inputs) (Codec<JSON,?>//decode (~ inputT))))
+ (def: ((~' decode) (~@ g!inputs)) (//.run (~@ g!inputs) (Codec<JSON,?>//decode (~ inputT))))
)))))))
diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux
index b18e0763f..48fd00a7c 100644
--- a/stdlib/source/lux/macro/syntax.lux
+++ b/stdlib/source/lux/macro/syntax.lux
@@ -200,7 +200,7 @@
(def: #hidden _Monad<Parser>_ p.Monad<Parser>)
(macro: #export (syntax: tokens)
- {#.doc (doc "A more advanced way to define macros than macro:."
+ {#.doc (doc "A more advanced way to define macros than \"macro:\"."
"The inputs to the macro can be parsed in complex ways through the use of syntax parsers."
"The macro body is also (implicitly) run in the Monad<Meta>, to save some typing."
"Also, the compiler state can be accessed through the *compiler* binding."
@@ -256,7 +256,7 @@
_
(macro.fail "Syntax pattern expects tuples or symbols."))))
args)
- #let [g!state (code.symbol ["" "*compiler*"])
+ #let [g!state ["" "*compiler*"]
error-msg (code.text (text/compose "Wrong syntax for " name))
export-ast (: (List Code) (case exported?
(#.Some #.Left)
@@ -267,20 +267,20 @@
_
(list)))]]
- (wrap (list (` (macro: (~@ export-ast) ((~ (code.symbol ["" name])) (~ g!tokens) (~ g!state))
+ (wrap (list (` (macro: (~+ export-ast) ((~ (code.symbol ["" name])) (~@ g!tokens) (~@ g!state))
(~ meta)
- ("lux case" (..run (~ g!tokens)
+ ("lux case" (..run (~@ g!tokens)
(: (Syntax (Meta (List Code)))
(do .._Monad<Parser>_
- [(~@ (join-pairs vars+parsers))]
+ [(~+ (join-pairs vars+parsers))]
((~' wrap) (do macro.Monad<Meta>
[]
(~ body))))))
- {(#E.Success (~ g!body))
- ((~ g!body) (~ g!state))
+ {(#E.Success (~@ g!body))
+ ((~@ g!body) (~@ g!state))
- (#E.Error (~ g!msg))
- (#E.Error (text/join-with ": " (list (~ error-msg) (~ g!msg))))})))))))
+ (#E.Error (~@ g!msg))
+ (#E.Error (text/join-with ": " (list (~ error-msg) (~@ g!msg))))})))))))
_
(macro.fail "Wrong syntax for syntax:"))))
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux
index 66bec5d9b..7c24e22d5 100644
--- a/stdlib/source/lux/test.lux
+++ b/stdlib/source/lux/test.lux
@@ -187,15 +187,15 @@
(|> x (+ y) (- y) (= x)))))))
)}
(with-gensyms [g!context g!test g!error]
- (wrap (list (` (def: #export (~ g!context)
+ (wrap (list (` (def: #export (~@ g!context)
{#..test (.._code/text_ (~ description))}
(IO Test)
(io (case ("lux try" [(io (do ..Monad<Random> [] (~ test)))])
- (#.Right (~ g!test))
- (~ g!test)
+ (#.Right (~@ g!test))
+ (~@ g!test)
- (#.Left (~ g!error))
- (..fail (~ g!error))))))))))
+ (#.Left (~@ g!error))
+ (..fail (~@ g!error))))))))))
(def: (exported-tests module-name)
(-> Text (Meta (List [Text Text Text])))
@@ -234,24 +234,24 @@
groups (list.split-all promise.concurrency-level tests+)]]
(wrap (list (` (: (IO Unit)
(io (exec (do Monad<Promise>
- [(~' #let) [(~ g!total-successes) +0
- (~ g!total-failures) +0]
- (~@ (list/join (list/map (function [group]
- (list (` [(~ g!successes) (~ g!failures)]) (` (run' (list (~@ group))))
- (' #let) (` [(~ g!total-successes) (n/+ (~ g!successes) (~ g!total-successes))
- (~ g!total-failures) (n/+ (~ g!failures) (~ g!total-failures))])))
+ [(~' #let) [(~@ g!total-successes) +0
+ (~@ g!total-failures) +0]
+ (~+ (list/join (list/map (function [group]
+ (list (` [(~@ g!successes) (~@ g!failures)]) (` (run' (list (~+ group))))
+ (' #let) (` [(~@ g!total-successes) (n/+ (~@ g!successes) (~@ g!total-successes))
+ (~@ g!total-failures) (n/+ (~@ g!failures) (~@ g!total-failures))])))
groups)))]
(exec (log! ($_ _composeT_
"Test-suite finished."
"\n"
- (_%i_ (nat-to-int (~ g!total-successes)))
+ (_%i_ (nat-to-int (~@ g!total-successes)))
" out of "
- (_%i_ (nat-to-int (n/+ (~ g!total-failures)
- (~ g!total-successes))))
+ (_%i_ (nat-to-int (n/+ (~@ g!total-failures)
+ (~@ g!total-successes))))
" tests passed."
"\n"
- (_%i_ (nat-to-int (~ g!total-failures))) " tests failed."))
- (promise.future (if (n/> +0 (~ g!total-failures))
+ (_%i_ (nat-to-int (~@ g!total-failures))) " tests failed."))
+ (promise.future (if (n/> +0 (~@ g!total-failures))
..die
..exit))))
[])))))))))
diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux
index 8d20c25c5..81f879f7b 100644
--- a/stdlib/source/lux/type/abstract.lux
+++ b/stdlib/source/lux/type/abstract.lux
@@ -63,8 +63,8 @@
(do macro.Monad<Meta>
[this-module (macro.find-module this-module-name)
#let [type-varsC (list/map code.local-symbol type-vars)
- abstract-declaration (` ((~ (code.local-symbol name)) (~@ type-varsC)))
- representation-declaration (` ((~ (code.local-symbol (representation-name name))) (~@ type-varsC)))
+ abstract-declaration (` ((~ (code.local-symbol name)) (~+ type-varsC)))
+ representation-declaration (` ((~ (code.local-symbol (representation-name name))) (~+ type-varsC)))
this-module (|> this-module
(update@ #.defs (put down-cast (: Def
[Macro macro-anns
@@ -72,7 +72,7 @@
(function [tokens]
(case tokens
(^ (list value))
- (wrap (list (` ((: (All [(~@ type-varsC)]
+ (wrap (list (` ((: (All [(~+ type-varsC)]
(-> (~ representation-declaration) (~ abstract-declaration)))
(|>> :!!))
(~ value)))))
@@ -85,7 +85,7 @@
(function [tokens]
(case tokens
(^ (list value))
- (wrap (list (` ((: (All [(~@ type-varsC)]
+ (wrap (list (` ((: (All [(~+ type-varsC)]
(-> (~ abstract-declaration) (~ representation-declaration)))
(|>> :!!))
(~ value)))))
@@ -154,13 +154,13 @@
[primitives (p.some s.any)])
(let [hidden-name (representation-name name)
type-varsC (list/map code.local-symbol type-vars)
- abstract-declaration (` ((~ (code.local-symbol name)) (~@ type-varsC)))
- representation-declaration (` ((~ (code.local-symbol hidden-name)) (~@ type-varsC)))]
- (wrap (list& (` (type: (~@ (csw.export export)) (~ abstract-declaration)
+ abstract-declaration (` ((~ (code.local-symbol name)) (~+ type-varsC)))
+ representation-declaration (` ((~ (code.local-symbol hidden-name)) (~+ type-varsC)))]
+ (wrap (list& (` (type: (~+ (csw.export export)) (~ abstract-declaration)
(~ (csw.annotations annotations))
- (primitive (~ (code.text hidden-name)) [(~@ type-varsC)])))
- (` (type: (~@ (csw.export export)) (~ representation-declaration)
+ (primitive (~ (code.text hidden-name)) [(~+ type-varsC)])))
+ (` (type: (~+ (csw.export export)) (~ representation-declaration)
(~ representation-type)))
- (` (install-casts (~ (code.local-symbol name)) [(~@ type-varsC)]))
+ (` (install-casts (~ (code.local-symbol name)) [(~+ type-varsC)]))
(list/compose primitives
(list (` (un-install-casts))))))))
diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux
index 39acf31ba..4d9fc797c 100644
--- a/stdlib/source/lux/type/implicit.lux
+++ b/stdlib/source/lux/type/implicit.lux
@@ -302,7 +302,7 @@
(code.symbol constructor)
_
- (` ((~ (code.symbol constructor)) (~@ (list/map instance$ dependencies))))))
+ (` ((~ (code.symbol constructor)) (~+ (list/map instance$ dependencies))))))
(syntax: #export (::: [member s.symbol]
[args (p.alt (p.seq (p.some s.symbol) s.end!)
@@ -344,7 +344,7 @@
(#.Cons chosen #.Nil)
(wrap (list (` (:: (~ (instance$ chosen))
(~ (code.local-symbol (product.right member)))
- (~@ (list/map code.symbol args))))))
+ (~+ (list/map code.symbol args))))))
_
(macro.fail (format "Too many options available: "
@@ -355,9 +355,9 @@
(#.Right [args _])
(do @
- [labels (monad.seq @ (list.repeat (list.size args)
- (macro.gensym "")))
- #let [retry (` (let [(~@ (|> (list.zip2 labels args) (list/map join-pair) list/join))]
- (..::: (~ (code.symbol member)) (~@ labels))))]]
+ [labels (|> (macro.gensym "") (list.repeat (list.size args)) (monad.seq @))
+ #let [labels (list/map code.symbol labels)
+ retry (` (let [(~+ (|> (list.zip2 labels args) (list/map join-pair) list/join))]
+ (..::: (~ (code.symbol member)) (~+ labels))))]]
(wrap (list retry)))
))
diff --git a/stdlib/source/lux/type/object.lux b/stdlib/source/lux/type/object.lux
index ba4b06384..03c3fb8a7 100644
--- a/stdlib/source/lux/type/object.lux
+++ b/stdlib/source/lux/type/object.lux
@@ -1,15 +1,15 @@
(.module:
lux
- (lux (control ["M" monad #+ do Monad]
+ (lux (control [monad #+ do Monad]
["p" parser "p/" Monad<Parser>])
(data [text]
text/format
[product]
[maybe]
- [ident #+ "Ident/" Eq<Ident>]
- (coll [list "L/" Functor<List> Fold<List> Monoid<List>]
+ [ident #+ "ident/" Eq<Ident>]
+ (coll [list "list/" Functor<List> Fold<List> Monoid<List>]
[set #+ Set]))
- [macro #+ Monad<Meta> "Macro/" Monad<Meta>]
+ [macro #+ Monad<Meta> "macro/" Monad<Meta>]
(macro [code]
["s" syntax #+ syntax:]
(syntax ["cs" common]
@@ -66,7 +66,7 @@
(|> (list.size ancestors)
n/dec
(list.n/range +0)
- (L/map (|>> %n (format "ancestor") code.local-symbol)))))
+ (list/map (|>> %n (format "ancestor") code.local-symbol)))))
## [Methods]
(type: Method
@@ -85,33 +85,33 @@
s.any)))
(def: (declarationM g!self (^open))
- (-> Code Method Code)
- (let [g!type-vars (L/map code.local-symbol type-vars)
+ (-> Ident Method Code)
+ (let [g!type-vars (list/map code.local-symbol type-vars)
g!method (code.local-symbol name)]
- (` (: (All [(~@ g!type-vars)]
- (-> (~@ inputs) (~ g!self) (~ output)))
+ (` (: (All [(~+ g!type-vars)]
+ (-> (~+ inputs) (~@ g!self) (~ output)))
(~ g!method)))))
(def: (definition export [interface parameters] g!self-object g!ext g!states (^open))
- (-> (Maybe cs.Export) Declaration Code Code (List Code) Method Code)
+ (-> (Maybe cs.Export) Declaration Code Ident (List Code) Method Code)
(let [g!method (code.local-symbol name)
- g!parameters (L/map code.local-symbol parameters)
- g!type-vars (L/map code.local-symbol type-vars)
+ g!parameters (list/map code.local-symbol parameters)
+ g!type-vars (list/map code.local-symbol type-vars)
g!_temp (code.symbol ["" "_temp"])
g!_object (code.symbol ["" "_object"])
g!_behavior (code.symbol ["" "_behavior"])
g!_state (code.symbol ["" "_state"])
g!_extension (code.symbol ["" "_extension"])
- g!_args (L/map (|>> product.left nat-to-int %i (format "_") code.local-symbol)
- (list.enumerate inputs))
- g!destructuring (L/fold (function [_ g!bottom] (` [(~ g!_temp) (~ g!_temp) (~ g!bottom)]))
- (` [(~ g!_behavior) (~ g!_state) (~ g!_extension)])
- (maybe.default g!states (list.tail g!states)))]
- (` (def: (~@ (csw.export export)) ((~ g!method) (~@ g!_args) (~ g!_object))
- (All [(~@ g!parameters) (~ g!ext) (~@ g!states) (~@ g!type-vars)]
- (-> (~@ inputs) (~ g!self-object) (~ output)))
+ g!_args (list/map (|>> product.left nat-to-int %i (format "_") code.local-symbol)
+ (list.enumerate inputs))
+ g!destructuring (list/fold (function [_ g!bottom] (` [(~ g!_temp) (~ g!_temp) (~ g!bottom)]))
+ (` [(~ g!_behavior) (~ g!_state) (~ g!_extension)])
+ (maybe.default g!states (list.tail g!states)))]
+ (` (def: (~+ (csw.export export)) ((~ g!method) (~+ g!_args) (~ g!_object))
+ (All [(~+ g!parameters) (~@ g!ext) (~+ g!states) (~+ g!type-vars)]
+ (-> (~+ inputs) (~ g!self-object) (~ output)))
(let [(~ g!destructuring) (~ g!_object)]
- (:: (~ g!_behavior) (~ g!method) (~@ g!_args) (~ g!_object)))))))
+ (:: (~ g!_behavior) (~ g!method) (~+ g!_args) (~ g!_object)))))))
## [Inheritance]
(type: Reference
@@ -121,7 +121,7 @@
(def: (no-parent? parent)
(-> Ident Bool)
- (Ident/= no-parent parent))
+ (ident/= no-parent parent))
(def: (with-interface parent interface)
(-> Ident Ident cs.Annotations cs.Annotations)
@@ -147,7 +147,7 @@
(case [(macro.get-tag-ann (ident-for <name-tag>) annotations)
(macro.get-tag-ann (ident-for <parent-tag>) annotations)]
[(#.Some real-name) (#.Some parent)]
- (if (Ident/= no-parent parent)
+ (if (ident/= no-parent parent)
(wrap [real-name (list)])
(do @
[[_ ancestors] (<name> parent)]
@@ -170,7 +170,7 @@
(#.Function inputT outputT)
(let [[stateT+ objectT] (type.flatten-function currentT)]
- (Macro/wrap [depth stateT+]))
+ (macro/wrap [depth stateT+]))
_
(macro.fail (format "Cannot extract inheritance from type: " (type.to-text newT))))))
@@ -184,11 +184,11 @@
size
(|> (n/dec size)
(list.n/range +0)
- (L/map (|>> (n/* +2) n/inc code.nat (~) #.Bound (`)))
+ (list/map (|>> (n/* +2) n/inc code.nat (~) #.Bound (`)))
(list.zip2 (list.reverse mappings))
- (L/fold (function [[mappingC boundC] genericC]
- (code.replace boundC mappingC genericC))
- typeC))))
+ (list/fold (function [[mappingC boundC] genericC]
+ (code.replace boundC mappingC genericC))
+ typeC))))
(def: referenceS
(s.Syntax Reference)
@@ -211,12 +211,12 @@
## Utils
(def: (nest ancestors bottom)
(-> (List Code) Code Code)
- (L/fold (function [[level _] g!bottom]
- (let [g!_behavior' (code.local-symbol (format "_behavior" (%n level)))
- g!_state' (code.local-symbol (format "_state" (%n level)))]
- (` [(~ g!_behavior') (~ g!_state') (~ g!bottom)])))
- bottom
- (list.enumerate ancestors)))
+ (list/fold (function [[level _] g!bottom]
+ (let [g!_behavior' (code.local-symbol (format "_behavior" (%n level)))
+ g!_state' (code.local-symbol (format "_state" (%n level)))]
+ (` [(~ g!_behavior') (~ g!_state') (~ g!bottom)])))
+ bottom
+ (list.enumerate ancestors)))
## Names
(do-template [<name> <category>]
@@ -242,7 +242,7 @@
)
(def: (getterN export interface g!parameters g!ext g!child ancestors)
- (-> (Maybe cs.Export) Text (List Code) Code Code (List Ident)
+ (-> (Maybe cs.Export) Text (List Code) Ident Ident (List Ident)
Code)
(let [g!get (code.local-symbol (getN interface))
g!interface (code.local-symbol interface)
@@ -251,17 +251,17 @@
g!_state (' _state)
g!_extension (' _extension)
g!ancestors (ancestor-inputs ancestors)
- g!object (` ((~ g!interface) (~@ g!parameters) (~ g!ext) (~@ g!ancestors) (~ g!child)))
+ g!object (` ((~ g!interface) (~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child)))
g!tear-down (nest g!ancestors
(` [(~ g!_behavior) (~ g!_state) (~ g!_extension)]))]
- (` (def: (~@ (csw.export export)) ((~ g!get) (~ g!_object))
- (All [(~@ g!parameters) (~ g!ext) (~@ g!ancestors) (~ g!child)]
- (-> (~ g!object) (~ g!child)))
+ (` (def: (~+ (csw.export export)) ((~ g!get) (~ g!_object))
+ (All [(~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child)]
+ (-> (~ g!object) (~@ g!child)))
(let [(~ g!tear-down) (~ g!_object)]
(~ g!_state))))))
(def: (setterN export interface g!parameters g!ext g!child ancestors)
- (-> (Maybe cs.Export) Text (List Code) Code Code (List Ident)
+ (-> (Maybe cs.Export) Text (List Code) Ident Ident (List Ident)
Code)
(let [g!set (code.local-symbol (setN interface))
g!interface (code.local-symbol interface)
@@ -271,20 +271,20 @@
g!_extension (' _extension)
g!_input (' _input)
g!ancestors (ancestor-inputs ancestors)
- g!object (` ((~ g!interface) (~@ g!parameters) (~ g!ext) (~@ g!ancestors) (~ g!child)))
+ g!object (` ((~ g!interface) (~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child)))
g!tear-down (nest g!ancestors
(` [(~ g!_behavior) (~ g!_state) (~ g!_extension)]))
g!build-up (nest g!ancestors
(` [(~ g!_behavior) (~ g!_input) (~ g!_extension)]))]
- (` (def: (~@ (csw.export export))
+ (` (def: (~+ (csw.export export))
((~ g!set) (~ g!_input) (~ g!_object))
- (All [(~@ g!parameters) (~ g!ext) (~@ g!ancestors) (~ g!child)]
- (-> (~ g!child) (~ g!object) (~ g!object)))
+ (All [(~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child)]
+ (-> (~@ g!child) (~ g!object) (~ g!object)))
(let [(~ g!tear-down) (~ g!_object)]
(~ g!build-up))))))
(def: (updaterN export interface g!parameters g!ext g!child ancestors)
- (-> (Maybe cs.Export) Text (List Code) Code Code (List Ident)
+ (-> (Maybe cs.Export) Text (List Code) Ident Ident (List Ident)
Code)
(let [g!update (code.local-symbol (updateN interface))
g!interface (code.local-symbol interface)
@@ -294,15 +294,15 @@
g!_extension (' _extension)
g!_change (' _change)
g!ancestors (ancestor-inputs ancestors)
- g!object (` ((~ g!interface) (~@ g!parameters) (~ g!ext) (~@ g!ancestors) (~ g!child)))
+ g!object (` ((~ g!interface) (~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child)))
g!tear-down (nest g!ancestors
(` [(~ g!_behavior) (~ g!_state) (~ g!_extension)]))
g!build-up (nest g!ancestors
(` [(~ g!_behavior) ((~ g!_change) (~ g!_state)) (~ g!_extension)]))]
- (` (def: (~@ (csw.export export))
+ (` (def: (~+ (csw.export export))
((~ g!update) (~ g!_change) (~ g!_object))
- (All [(~@ g!parameters) (~ g!ext) (~@ g!ancestors) (~ g!child)]
- (-> (-> (~ g!child) (~ g!child))
+ (All [(~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child)]
+ (-> (-> (~@ g!child) (~@ g!child))
(-> (~ g!object) (~ g!object))))
(let [(~ g!tear-down) (~ g!_object)]
(~ g!build-up))))))
@@ -313,34 +313,34 @@
(case type
(#.Primitive name params)
(do Monad<Meta>
- [paramsC+ (M.map @ type-to-code params)]
+ [paramsC+ (monad.map @ type-to-code params)]
(wrap (` (.primitive (~ (code.symbol ["" name]))
- (~@ paramsC+)))))
+ (~+ paramsC+)))))
#.Void
- (Macro/wrap (` (.|)))
+ (macro/wrap (` (.|)))
#.Unit
- (Macro/wrap (` (.&)))
+ (macro/wrap (` (.&)))
(^template [<tag> <macro> <flatten>]
(<tag> _)
(do Monad<Meta>
- [partsC+ (M.map @ type-to-code (<flatten> type))]
- (wrap (` (<macro> (~@ partsC+))))))
+ [partsC+ (monad.map @ type-to-code (<flatten> type))]
+ (wrap (` (<macro> (~+ partsC+))))))
([#.Sum .| type.flatten-variant]
[#.Product .& type.flatten-tuple])
(#.Function input output)
(do Monad<Meta>
[#let [[insT+ outT] (type.flatten-function type)]
- insC+ (M.map @ type-to-code insT+)
+ insC+ (monad.map @ type-to-code insT+)
outC (type-to-code outT)]
- (wrap (` (.-> (~@ insC+) (~ outC)))))
+ (wrap (` (.-> (~+ insC+) (~ outC)))))
(^template [<tag>]
(<tag> idx)
- (Macro/wrap (` (<tag> (~ (code.nat idx))))))
+ (macro/wrap (` (<tag> (~ (code.nat idx))))))
([#.Bound]
[#.Var]
[#.Ex])
@@ -349,11 +349,11 @@
(do Monad<Meta>
[#let [[funcT argsT+] (type.flatten-application type)]
funcC (type-to-code funcT)
- argsC+ (M.map @ type-to-code argsT+)]
- (wrap (` ((~ funcC) (~@ argsC+)))))
+ argsC+ (monad.map @ type-to-code argsT+)]
+ (wrap (` ((~ funcC) (~+ argsC+)))))
(#.Named name unnamedT)
- (Macro/wrap (code.symbol name))
+ (macro/wrap (code.symbol name))
_
(macro.fail (format "Cannot convert type to code: " (type.to-text type)))))
@@ -378,34 +378,34 @@
(wrap [parent (list& parent ancestors) mappings]))))
#let [g!signature (code.local-symbol (signatureN interface))
g!interface (code.local-symbol interface)
- g!parameters (L/map code.local-symbol parameters)
+ g!parameters (list/map code.local-symbol parameters)
g!self-ref (if (list.empty? g!parameters)
(list g!interface)
(list))
g!interface-def (if (no-parent? parent)
- (let [g!recur (` ((~ g!interface) (~@ g!parameters) (~ g!ext) (~ g!child)))]
- (` (Ex (~@ g!self-ref) [(~ g!ext) (~ g!child)]
- [((~ g!signature) (~@ g!parameters) (~ g!recur))
- (~ g!child)
- (~ g!ext)])))
+ (let [g!recur (` ((~ g!interface) (~+ g!parameters) (~@ g!ext) (~@ g!child)))]
+ (` (Ex (~+ g!self-ref) [(~@ g!ext) (~@ g!child)]
+ [((~ g!signature) (~+ g!parameters) (~ g!recur))
+ (~@ g!child)
+ (~@ g!ext)])))
(let [g!parent (code.symbol parent)
g!ancestors (ancestor-inputs ancestors)
- g!recur (` ((~ g!interface) (~@ g!parameters) (~ g!ext) (~@ g!ancestors) (~ g!child)))]
- (` (Ex (~@ g!self-ref) [(~ g!ext) (~@ g!ancestors) (~ g!child)]
- ((~ g!parent) (~@ mappings)
- [((~ g!signature) (~@ g!parameters) (~ g!recur))
- (~ g!child)
- (~ g!ext)]
- (~@ g!ancestors))))))]]
- (wrap (list& (` (sig: (~@ (csw.export export))
- ((~ g!signature) (~@ g!parameters) (~ g!self-class))
- (~@ (let [de-alias (code.replace (code.local-symbol alias) g!self-class)]
- (L/map (|>> (update@ #inputs (L/map de-alias))
- (update@ #output de-alias)
- (declarationM g!self-class))
- methods)))))
+ g!recur (` ((~ g!interface) (~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child)))]
+ (` (Ex (~+ g!self-ref) [(~@ g!ext) (~+ g!ancestors) (~@ g!child)]
+ ((~ g!parent) (~+ mappings)
+ [((~ g!signature) (~+ g!parameters) (~ g!recur))
+ (~@ g!child)
+ (~@ g!ext)]
+ (~+ g!ancestors))))))]]
+ (wrap (list& (` (sig: (~+ (csw.export export))
+ ((~ g!signature) (~+ g!parameters) (~@ g!self-class))
+ (~+ (let [de-alias (code.replace (code.local-symbol alias) (code.symbol g!self-class))]
+ (list/map (|>> (update@ #inputs (list/map de-alias))
+ (update@ #output de-alias)
+ (declarationM g!self-class))
+ methods)))))
- (` (type: (~@ (csw.export export)) ((~ g!interface) (~@ g!parameters))
+ (` (type: (~+ (csw.export export)) ((~ g!interface) (~+ g!parameters))
(~ (|> annotations
(with-interface parent [module interface])
csw.annotations))
@@ -416,13 +416,13 @@
(updaterN export interface g!parameters g!ext g!child ancestors)
(let [g!ancestors (ancestor-inputs ancestors)
- g!states (L/compose g!ancestors (list g!child))
- g!self-object (` ((~ g!interface) (~@ g!parameters) (~ g!ext) (~@ g!ancestors) (~ g!child)))
+ g!states (list/compose g!ancestors (list (code.symbol g!child)))
+ g!self-object (` ((~ g!interface) (~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child)))
de-alias (code.replace (code.symbol ["" alias]) g!self-object)]
- (L/map (|>> (update@ #inputs (L/map de-alias))
- (update@ #output de-alias)
- (definition export decl g!self-object g!ext g!states))
- methods))))
+ (list/map (|>> (update@ #inputs (list/map de-alias))
+ (update@ #output de-alias)
+ (definition export decl g!self-object g!ext g!states))
+ methods))))
)))
(syntax: #export (class: [export csr.export]
@@ -451,9 +451,9 @@
(do @
[newT (macro.find-def-type (product.both id newN parent))
[depth rawT+] (extract newT)
- codeT+ (M.map @ type-to-code rawT+)]
- (wrap (L/map (specialize parent-mappings) codeT+)))))
- #let [g!parameters (L/map code.local-symbol parameters)
+ codeT+ (monad.map @ type-to-code rawT+)]
+ (wrap (list/map (specialize parent-mappings) codeT+)))))
+ #let [g!parameters (list/map code.local-symbol parameters)
g!state (code.local-symbol (stateN instance))
g!struct (code.local-symbol (structN instance))
@@ -464,51 +464,51 @@
g!parent-structs (if (no-parent? parent)
(list)
- (L/map (|>> (product.both id structN) code.symbol) (list& parent ancestors)))]
- g!parent-inits (M.map @ (function [_] (macro.gensym "parent-init"))
- g!parent-structs)
- #let [g!full-init (L/fold (function [[parent-struct parent-state] child]
- (` [(~ parent-struct) (~ parent-state) (~ child)]))
- (` [(~ g!struct) (~ g!init) []])
- (list.zip2 g!parent-structs g!parent-inits))
+ (list/map (|>> (product.both id structN) code.symbol) (list& parent ancestors)))]
+ g!parent-inits (monad.map @ (function [_] (:: @ map code.symbol (macro.gensym "parent-init")))
+ g!parent-structs)
+ #let [g!full-init (list/fold (function [[parent-struct parent-state] child]
+ (` [(~ parent-struct) (~ parent-state) (~ child)]))
+ (` [(~ g!struct) (~@ g!init) []])
+ (list.zip2 g!parent-structs g!parent-inits))
g!new (code.local-symbol (newN instance))
- g!recur (` ((~ g!class) (~@ g!parameters) (~ g!extension)))
+ g!recur (` ((~ g!class) (~+ g!parameters) (~@ g!extension)))
g!rec (if (list.empty? g!parameters)
(list (' #rec))
(list))]]
- (wrap (list (` (type: (~@ (csw.export export))
- ((~ g!state) (~@ g!parameters))
+ (wrap (list (` (type: (~+ (csw.export export))
+ ((~ g!state) (~+ g!parameters))
(~ state-type)))
- (` (type: (~@ (csw.export export)) (~@ g!rec) ((~ g!class) (~@ g!parameters))
+ (` (type: (~+ (csw.export export)) (~+ g!rec) ((~ g!class) (~+ g!parameters))
(~ (|> annotations
(with-class interface parent [module instance])
csw.annotations))
- (Ex [(~ g!extension)]
+ (Ex [(~@ g!extension)]
(~ (if (no-parent? parent)
- (` ((~ g!interface) (~@ interface-mappings)
- (~ g!extension)
- ((~ g!state) (~@ g!parameters))))
+ (` ((~ g!interface) (~+ interface-mappings)
+ (~@ g!extension)
+ ((~ g!state) (~+ g!parameters))))
(let [g!parent (code.symbol parent)]
- (` ((~ g!parent) (~@ parent-mappings)
- [((~ g!signature) (~@ interface-mappings) (~ g!recur))
- ((~ g!state) (~@ g!parameters))
- (~ g!extension)]))))))))
-
- (` (struct: (~@ (csw.export export)) (~ g!struct)
- (All [(~@ g!parameters) (~ g!extension)]
- ((~ g!signature) (~@ interface-mappings)
- ((~ g!interface) (~@ interface-mappings)
- (~ g!extension)
- (~@ g!inheritance)
- ((~ g!state) (~@ g!parameters)))))
- (~@ impls)))
-
- (` (def: (~@ (csw.export export)) ((~ g!new) (~@ g!parent-inits) (~ g!init))
- (All [(~@ g!parameters)]
- (-> (~@ g!inheritance)
- ((~ g!state) (~@ g!parameters))
- ((~ g!class) (~@ g!parameters))))
+ (` ((~ g!parent) (~+ parent-mappings)
+ [((~ g!signature) (~+ interface-mappings) (~ g!recur))
+ ((~ g!state) (~+ g!parameters))
+ (~@ g!extension)]))))))))
+
+ (` (struct: (~+ (csw.export export)) (~ g!struct)
+ (All [(~+ g!parameters) (~@ g!extension)]
+ ((~ g!signature) (~+ interface-mappings)
+ ((~ g!interface) (~+ interface-mappings)
+ (~@ g!extension)
+ (~+ g!inheritance)
+ ((~ g!state) (~+ g!parameters)))))
+ (~+ impls)))
+
+ (` (def: (~+ (csw.export export)) ((~ g!new) (~+ g!parent-inits) (~@ g!init))
+ (All [(~+ g!parameters)]
+ (-> (~+ g!inheritance)
+ ((~ g!state) (~+ g!parameters))
+ ((~ g!class) (~+ g!parameters))))
(~ g!full-init)))
))
)))
diff --git a/stdlib/source/lux/type/unit.lux b/stdlib/source/lux/type/unit.lux
index 262ccf9e4..cf59e25d4 100644
--- a/stdlib/source/lux/type/unit.lux
+++ b/stdlib/source/lux/type/unit.lux
@@ -68,10 +68,10 @@
(syntax: #export (unit: [export csr.export]
[name s.local-symbol]
[annotations (p.default cs.empty-annotations csr.annotations)])
- (wrap (list (` (type: (~@ (csw.export export)) (~ (code.local-symbol name))
+ (wrap (list (` (type: (~+ (csw.export export)) (~ (code.local-symbol name))
(~ (csw.annotations annotations))
(primitive (~ (code.text (unit-name name))))))
- (` (def: (~@ (csw.export export)) (~ (code.local-symbol (format "@" name)))
+ (` (def: (~+ (csw.export export)) (~ (code.local-symbol (format "@" name)))
(~ (code.local-symbol name))
(:!! [])))
)))
@@ -92,10 +92,10 @@
[(^slots [#r.numerator #r.denominator]) ratio^]
[annotations (p.default cs.empty-annotations csr.annotations)])
(let [g!scale (code.local-symbol name)]
- (wrap (list (` (type: (~@ (csw.export export)) ((~ g!scale) (~' u))
+ (wrap (list (` (type: (~+ (csw.export export)) ((~ g!scale) (~' u))
(~ (csw.annotations annotations))
(primitive (~ (code.text (scale-name name))) [(~' u)])))
- (` (struct: (~@ (csw.export export)) (~ (code.local-symbol (format "@" name)))
+ (` (struct: (~+ (csw.export export)) (~ (code.local-symbol (format "@" name)))
(..Scale (~ g!scale))
(def: (~' scale)
(|>> ..out