aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux.lux659
-rw-r--r--stdlib/source/lux/cli.lux28
-rw-r--r--stdlib/source/lux/concurrency/actor.lux40
-rw-r--r--stdlib/source/lux/concurrency/frp.lux2
-rw-r--r--stdlib/source/lux/concurrency/promise.lux22
-rw-r--r--stdlib/source/lux/concurrency/space.lux10
-rw-r--r--stdlib/source/lux/concurrency/stm.lux2
-rw-r--r--stdlib/source/lux/concurrency/task.lux2
-rw-r--r--stdlib/source/lux/control/concatenative.lux46
-rw-r--r--stdlib/source/lux/control/cont.lux2
-rw-r--r--stdlib/source/lux/control/contract.lux3
-rw-r--r--stdlib/source/lux/control/exception.lux8
-rw-r--r--stdlib/source/lux/control/pipe.lux32
-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.lux6
-rw-r--r--stdlib/source/lux/data/lazy.lux9
-rw-r--r--stdlib/source/lux/data/number/ratio.lux8
-rw-r--r--stdlib/source/lux/data/text/format.lux8
-rw-r--r--stdlib/source/lux/data/text/regex.lux105
-rw-r--r--stdlib/source/lux/host.js.lux4
-rw-r--r--stdlib/source/lux/host.jvm.lux80
-rw-r--r--stdlib/source/lux/lang/type.lux6
-rw-r--r--stdlib/source/lux/macro.lux6
-rw-r--r--stdlib/source/lux/macro/poly.lux16
-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.lux76
-rw-r--r--stdlib/source/lux/macro/syntax.lux44
-rw-r--r--stdlib/source/lux/macro/syntax/common.lux4
-rw-r--r--stdlib/source/lux/macro/syntax/common/reader.lux16
-rw-r--r--stdlib/source/lux/macro/syntax/common/writer.lux18
-rw-r--r--stdlib/source/lux/test.lux92
-rw-r--r--stdlib/source/lux/type/abstract.lux28
-rw-r--r--stdlib/source/lux/type/implicit.lux12
-rw-r--r--stdlib/source/lux/type/object.lux224
-rw-r--r--stdlib/source/lux/type/unit.lux8
39 files changed, 801 insertions, 904 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 4ec6e1ea1..ebac83f40 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -898,11 +898,6 @@
(flag-meta "export?"))
(record$ #Nil))
-("lux def" hidden?-meta
- ("lux check" Code
- (flag-meta "hidden?"))
- (record$ #Nil))
-
("lux def" macro?-meta
("lux check" Code
(flag-meta "macro?"))
@@ -916,14 +911,6 @@
(#Cons tail #Nil))))))
(record$ #Nil))
-("lux def" with-hidden-meta
- ("lux check" (#Function Code Code)
- (function'' [tail]
- (form$ (#Cons (tag$ ["lux" "Cons"])
- (#Cons hidden?-meta
- (#Cons tail #Nil))))))
- (record$ #Nil))
-
("lux def" with-macro-meta
("lux check" (#Function Code Code)
(function'' [tail]
@@ -1064,7 +1051,7 @@
_
(fail "Wrong syntax for $'")}))
-(def:'' (map f xs)
+(def:'' (list/map f xs)
#Nil
(#UnivQ #Nil
(#UnivQ #Nil
@@ -1076,7 +1063,7 @@
#Nil
(#Cons x xs')
- (#Cons (f x) (map f xs'))}))
+ (#Cons (f x) (list/map f xs'))}))
(def:'' RepEnv
#Nil
@@ -1126,18 +1113,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 +1135,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}))
@@ -1549,9 +1536,7 @@
ys}))
(def:''' #export (splice-helper xs ys)
- (#Cons [(tag$ ["lux" "hidden?"])
- (bool$ true)]
- #Nil)
+ #Nil
(-> ($' List Code) ($' List Code) ($' List Code))
("lux case" xs
{(#Cons x xs')
@@ -1854,8 +1839,9 @@
(#Cons lastI inits)
(do Monad<Meta>
[lastO ("lux case" lastI
- {[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))]
- (wrap spliced)
+ {[_ (#Form (#Cons [[_ (#Symbol ["" "~+"])] (#Cons [spliced #Nil])]))]
+ (let' [[[_module-name _ _] _] spliced]
+ (wrap spliced))
_
(do Monad<Meta>
@@ -1864,10 +1850,11 @@
(monad/fold Monad<Meta>
(function' [leftI rightO]
("lux case" leftI
- {[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))]
- (wrap (form$ (list (symbol$ ["lux" "splice-helper"])
- spliced
- rightO)))
+ {[_ (#Form (#Cons [[_ (#Symbol ["" "~+"])] (#Cons [spliced #Nil])]))]
+ (let' [[[_module-name _ _] _] spliced]
+ (wrap (form$ (list (symbol$ ["lux" "splice-helper"])
+ spliced
+ rightO))))
_
(do Monad<Meta>
@@ -1880,6 +1867,11 @@
[=elems (monad/map Monad<Meta> untemplate elems)]
(wrap (untemplate-list =elems)))}))
+(def:''' (untemplate-text value)
+ #Nil
+ (-> Text Code)
+ (wrap-meta (form$ (list (tag$ ["lux" "Text"]) (text$ value)))))
+
(def:''' (untemplate replace? subst token)
#Nil
(-> Bool Text Code ($' Meta Code))
@@ -1933,6 +1925,14 @@
[true [_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))]]
(return unquoted)
+ [true [_ (#Form (#Cons [[_ (#Symbol ["" "~!"])] (#Cons [dependent #Nil])]))]]
+ (do Monad<Meta>
+ [independent (untemplate replace? subst dependent)]
+ (wrap (wrap-meta (form$ (list (tag$ ["lux" "Form"])
+ (untemplate-list (list (untemplate-text "lux in-module")
+ (untemplate-text subst)
+ independent)))))))
+
[true [_ (#Form (#Cons [[_ (#Symbol ["" "~'"])] (#Cons [keep-quoted #Nil])]))]]
(untemplate false subst keep-quoted)
@@ -1996,26 +1996,28 @@
(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)
(do Monad<Meta>
[current-module current-module-name
=template (untemplate true current-module template)]
- (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template)))))
+ (wrap (list (form$ (list (text$ "lux check")
+ (symbol$ ["lux" "Code"])
+ =template)))))
_
(fail "Wrong syntax for `")}))
(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 +2044,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 +2072,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 +2157,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 +2205,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 +2593,22 @@
(-> 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 [_ (#Text "lux in-module")]
+ (#Cons [_ (#Text module)]
+ (#Cons type'
+ #Nil))))]
+ (` ("lux in-module" (~ (text$ module)) (~ (walk-type type'))))
[_ (#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 +2685,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 +2694,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,13 +2712,13 @@
(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")}))
@@ -2795,7 +2803,7 @@
body
_
- (` (function' (~ name) [(~@ args)] (~ body)))})
+ (` (function' (~ name) [(~+ args)] (~ body)))})
body'' ("lux case" ?type
{(#Some type)
(` (: (~ type) (~ body')))
@@ -2849,21 +2857,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 +2905,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 +2982,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,9 +3041,9 @@
_
#None))
- (#Some ident head tail body)
+ (#Some g!name head tail body)
(let [g!blank (symbol$ ["" ""])
- g!name (symbol$ ident)
+ g!name (symbol$ g!name)
body+ (list/fold (: (-> Code Code Code)
(function' [arg body']
(if (symbol? arg)
@@ -3080,27 +3088,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,46 +3118,30 @@
_
(` (#.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))]}))
-
-(def:' Export-Level
- Type
- ($' Either
- Unit ## Exported
- Unit ## Hidden
- ))
+ (` {#.type-args [(~+ (list/map (function [arg] (text$ (code-to-text arg)))
+ args))]}))
-(def:' (export-level^ tokens)
- (-> (List Code) [(Maybe Export-Level) (List Code)])
+(def:' (export^ tokens)
+ (-> (List Code) [Bool (List Code)])
(case tokens
(#Cons [_ (#Tag [_ "export"])] tokens')
- [(#Some (#Left [])) tokens']
-
- (#Cons [_ (#Tag [_ "hidden"])] tokens')
- [(#Some (#Right [])) tokens']
+ [true tokens']
_
- [#None tokens]))
-
-(def:' (export-level ?el)
- (-> (Maybe Export-Level) (List Code))
- (case ?el
- #None
- (list)
+ [false tokens]))
- (#Some (#Left []))
+(def:' (export ?)
+ (-> Bool (List Code))
+ (if ?
(list (' #export))
-
- (#Some (#Right []))
- (list (' #hidden))))
+ (list)))
(macro:' #export (def: tokens)
(list [(tag$ ["lux" "doc"])
@@ -3162,7 +3154,7 @@
(def: branching-exponent
Int
5)")])
- (let [[export? tokens'] (export-level^ tokens)
+ (let [[export? tokens'] (export^ tokens)
parts (: (Maybe [Code (List Code) (Maybe Code) Code (List [Code Code])])
(case tokens'
(^ (list [_ (#Form (#Cons name args))] [_ (#Record meta-kvs)] type body))
@@ -3198,7 +3190,7 @@
body
_
- (` (function (~ name) [(~@ args)] (~ body))))
+ (` (function (~ name) [(~+ args)] (~ body))))
body (case ?type
(#Some type)
(` (: (~ type) (~ body)))
@@ -3210,18 +3202,9 @@
(~ body)
[(~ cursor-code)
(#Record (~ (with-func-args args
- (case export?
- #None
- =meta
-
- (#Some (#Left []))
+ (if export?
(with-export-meta =meta)
-
- (#Some (#Right []))
- (|> =meta
- with-export-meta
- with-hidden-meta)
- ))))])))))
+ =meta))))])))))
#None
(fail "Wrong syntax for def:"))))
@@ -3257,7 +3240,7 @@
_
(fail \"Wrong syntax for ident-for\")))")])
- (let [[exported? tokens] (export-level^ tokens)
+ (let [[exported? tokens] (export^ tokens)
name+args+meta+body?? (: (Maybe [Ident (List Code) Code Code])
(case tokens
(^ (list [_ (#Form (list& [_ (#Symbol name)] args))] body))
@@ -3279,8 +3262,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 exported?))
(~ def-sig)
(~ (meta-code-merge (` {#.macro? true})
meta))
@@ -3305,7 +3288,7 @@
>)
(: (-> a a Bool)
>=))"}
- (let [[exported? tokens'] (export-level^ tokens)
+ (let [[exported? tokens'] (export^ tokens)
?parts (: (Maybe [Ident (List Code) Code (List Code)])
(case tokens'
(^ (list& [_ (#Form (list& [_ (#Symbol name)] args))] [meta-rec-cursor (#Record meta-rec-parts)] sigs))
@@ -3340,10 +3323,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 +3334,8 @@
def-name
_
- (` ((~ def-name) (~@ args))))]]
- (return (list (` (..type: (~@ (export-level exported?)) (~ usage) (~ sig-meta) (~ sig-type))))))
+ (` ((~ def-name) (~+ args))))]]
+ (return (list (` (..type: (~+ (export exported?)) (~ usage) (~ sig-meta) (~ sig-type))))))
#None
(fail "Wrong syntax for sig:"))))
@@ -3678,8 +3661,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]
@@ -3715,7 +3698,7 @@
(def: (lux.>= test subject)
(or (lux.> test subject)
(lux.= test subject))))"}
- (let [[exported? tokens'] (export-level^ tokens)
+ (let [[exported? tokens'] (export^ tokens)
?parts (: (Maybe [Code (List Code) Code Code (List Code)])
(case tokens'
(^ (list& [_ (#Form (list& name args))] [meta-rec-cursor (#Record meta-rec-parts)] type defs))
@@ -3766,12 +3749,12 @@
name
_
- (` ((~ name) (~@ args))))]
- (return (list (` (..def: (~@ (export-level exported?)) (~ usage)
+ (` ((~ name) (~+ args))))]
+ (return (list (` (..def: (~+ (export 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 \"_\"!"))
@@ -3791,7 +3774,7 @@
(type: (List a)
#Nil
(#Cons a (List a)))"}
- (let [[exported? tokens'] (export-level^ tokens)
+ (let [[exported? tokens'] (export^ tokens)
[rec? tokens'] (case tokens'
(#Cons [_ (#Tag [_ "rec"])] tokens')
[true tokens']
@@ -3830,7 +3813,7 @@
type-meta (: Code
(case tags??
(#Some tags)
- (` {#.tags [(~@ (map text$ tags))]
+ (` {#.tags [(~+ (list/map text$ tags))]
#.type? true})
_
@@ -3849,10 +3832,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 exported?)) (~ type-name)
(~ ($_ meta-code-merge (with-type-args args)
(if rec? (' {#.type-rec? true}) (' {}))
type-meta
@@ -3986,14 +3969,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 +4005,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 +4037,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 +4170,17 @@
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)
+ (#Some [_ (#Bool true)])
+ (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 +4351,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 +4360,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,15 +4387,30 @@
(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] _)
($_ text/compose prefix "." name)
))
-(macro: #hidden (^open' tokens)
+(macro: #export (^open tokens)
+ {#.doc "## Same as the \"open\" macro, but meant to be used as a pattern-matching macro for generating local bindings.
+ ## Can optionally take a \"prefix\" text for the generated local bindings.
+ (def: #export (range (^open) from to)
+ (All [a] (-> (Enum a) a a (List a)))
+ (range' <= succ from to))"}
(case tokens
+ (^ (list& [_ (#Form (list))] body branches))
+ (do Monad<Meta>
+ [g!temp (gensym "temp")]
+ (wrap (list& g!temp (` (..^open (~ g!temp) "" (~ body))) branches)))
+
+ (^ (list& [_ (#Form (list [_ (#Text prefix)]))] body branches))
+ (do Monad<Meta>
+ [g!temp (gensym "temp")]
+ (wrap (list& g!temp (` (..^open (~ g!temp) (~ (text$ prefix)) (~ body))) branches)))
+
(^ (list [_ (#Symbol name)] [_ (#Text prefix)] body))
(do Monad<Meta>
[init-type (find-type name)
@@ -4426,10 +4423,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]
@@ -4452,24 +4449,6 @@
_
(fail "Wrong syntax for ^open")))
-(macro: #export (^open tokens)
- {#.doc "## Same as the \"open\" macro, but meant to be used as a pattern-matching macro for generating local bindings.
- ## Can optionally take a \"prefix\" text for the generated local bindings.
- (def: #export (range (^open) from to)
- (All [a] (-> (Enum a) a a (List a)))
- (range' <= succ from to))"}
- (case tokens
- (^ (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)))
-
- (^ (list& [_ (#Form (list))] body branches))
- (return (list& (` (..^open "")) body branches))
-
- _
- (fail "Wrong syntax for ^open")))
-
(macro: #export (cond tokens)
{#.doc "## Branching structures with multiple test conditions.
(cond (n/even? num) \"even\"
@@ -4524,12 +4503,13 @@
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))))]
+ (let [pattern (record$ (list/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)})))))
_
@@ -4606,27 +4586,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 +4640,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,24 +4675,24 @@
#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))
))
-(macro: #hidden (refer tokens)
+(macro: #export (refer tokens)
(case tokens
(^ (list& [_ (#Text module-name)] options))
(do Monad<Meta>
@@ -4730,21 +4710,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 +4763,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 +4788,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 ::")))
@@ -4843,16 +4823,18 @@
[g!slot (gensym "")]
(return [r-slot-name r-idx 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)}))))))
_
@@ -4882,7 +4864,7 @@
[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))
@@ -4929,16 +4911,18 @@
[g!slot (gensym "")]
(return [r-slot-name r-idx 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)}))))))
_
@@ -4954,8 +4938,8 @@
[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))))))))
+ (~ g!temp) (get@ [(~+ slots)] (~ g!record))]
+ (set@ [(~+ slots)] ((~ fun) (~ g!temp)) (~ g!record))))))))
(^ (list selector fun))
(do Monad<Meta>
@@ -5015,9 +4999,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 +5041,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 +5133,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 +5182,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 +5204,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 +5226,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 +5252,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 +5277,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 +5287,18 @@
#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))
(function [_] (gensym "")))
inits)]
- (return (list (` (let [(~@ (interleave aliases inits))]
- (.loop [(~@ (interleave vars aliases))]
+ (return (list (` (let [(~+ (interleave aliases inits))]
+ (.loop [(~+ (interleave vars aliases))]
(~ body)))))))))
_
@@ -5345,16 +5329,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 g!_]))))
+ tags))]]
(return (list& pattern body branches)))
_
@@ -5430,8 +5414,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)
@@ -5609,7 +5593,7 @@
(let [output (list g!temp
(` ("lux case" ("lux check" (#.Apply (~ (type-to-code expected)) Maybe)
(case (~ g!temp)
- (~@ (multi-level-case$ g!temp [mlc body]))
+ (~+ (multi-level-case$ g!temp [mlc body]))
(~ g!temp)
#.None))
@@ -5618,7 +5602,7 @@
#None
(case (~ g!temp)
- (~@ next-branches))})))]
+ (~+ next-branches))})))]
(wrap output)))
_
@@ -5730,7 +5714,7 @@
(^ (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) (|> (~ g!name) (~+ steps))]
(~ body)))
branches)))
@@ -5778,36 +5762,6 @@
_
(fail "Wrong syntax for type-of")))
-(type: #hidden Export-Level'
- #Export
- #Hidden)
-
-(def: (parse-export-level tokens)
- (-> (List Code) (Meta [(Maybe Export-Level') (List Code)]))
- (case tokens
- (^ (list& [_ (#Tag ["" "export"])] tokens'))
- (return [(#Some #Export) tokens'])
-
- (^ (list& [_ (#Tag ["" "hidden"])] tokens'))
- (return [(#Some #Hidden) tokens'])
-
- _
- (return [#None tokens])
- ))
-
-(def: (gen-export-level ?export-level)
- (-> (Maybe Export-Level') (List Code))
- (case ?export-level
- #None
- (list)
-
- (#Some #Export)
- (list (' #export))
-
- (#Some #Hidden)
- (list (' #hidden))
- ))
-
(def: (parse-complex-declaration tokens)
(-> (List Code) (Meta [[Text (List Text)] (List Code)]))
(case tokens
@@ -5864,8 +5818,7 @@
(template: (square x)
(i/* x x)))}
(do Monad<Meta>
- [?export-level|tokens (parse-export-level tokens)
- #let [[?export-level tokens] ?export-level|tokens]
+ [#let [[export? tokens] (export^ tokens)]
name+args|tokens (parse-complex-declaration tokens)
#let [[[name args] tokens] name+args|tokens]
anns|tokens (parse-anns tokens)
@@ -5876,14 +5829,14 @@
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))
+ #let [rep-env (list/map (function [arg]
+ [arg (` ((~' ~) (~ (symbol$ ["" arg]))))])
+ args)]]
+ (wrap (list (` (macro: (~+ (export export?))
((~ (symbol$ ["" name])) (~ g!tokens) (~ g!compiler))
(~ anns)
(case (~ g!tokens)
- (^ (list (~@ (map (|>> [""] symbol$) args))))
+ (^ (list (~+ (list/map (|>> [""] symbol$) args))))
(#.Right [(~ g!compiler)
(list (` (~ (replace-syntax rep-env input-template))))])
@@ -5978,8 +5931,8 @@
[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 +5946,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 +5958,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))))))
@@ -6059,13 +6012,13 @@
[_ (#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))
diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux
index 328d717ce..b0f1285fa 100644
--- a/stdlib/source/lux/cli.lux
+++ b/stdlib/source/lux/cli.lux
@@ -102,8 +102,6 @@
(wrap [(code.symbol ["" name]) (` any)]))
(s.tuple (p.seq s.any s.any)))))))
-(def: #hidden _Monad<CLI>_ p.Monad<Parser>)
-
(syntax: #export (program: [args program-args^] body)
{#.doc (doc "Defines the entry-point to a program (similar to the \"main\" function/method in other programming languages)."
"Can take a list of all the input parameters to the program, or can destructure them using CLI-option combinators from the lux/cli module."
@@ -123,23 +121,23 @@
(case args
(#Raw args)
(wrap (list (` ("lux program" (~ (code.symbol ["" args]))
- (do io.Monad<IO>
- []
- (~ body))))))
+ ((~! do) (~! io.Monad<IO>)
+ []
+ (~ body))))))
(#Parsed args)
(with-gensyms [g!args g!_ g!output g!message]
(wrap (list (` ("lux program" (~ g!args)
- (case ((: (..CLI (io.IO Unit))
- (do .._Monad<CLI>_
- [(~@ (|> args
- (list/map (function [[binding parser]]
- (list binding parser)))
- list/join))
- (~ g!_) ..end]
- ((~' wrap) (do io.Monad<IO>
- []
- (~ body)))))
+ (case ((: (~! (..CLI (io.IO Unit)))
+ ((~! do) (~! p.Monad<Parser>)
+ [(~+ (|> args
+ (list/map (function [[binding parser]]
+ (list binding parser)))
+ list/join))
+ (~ g!_) ..end]
+ ((~' wrap) ((~! do) (~! io.Monad<IO>)
+ []
+ (~ body)))))
(~ g!args))
(#E.Success [(~ g!_) (~ g!output)])
(~ g!output)
diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux
index a079d2d28..b326d0028 100644
--- a/stdlib/source/lux/concurrency/actor.lux
+++ b/stdlib/source/lux/concurrency/actor.lux
@@ -52,8 +52,10 @@
(io (let [[handle end] behavior
self (: (Actor ($ +0))
(@abstract {#mailbox (stm.var (:! (Message ($ +0)) []))
- #kill-switch (P.promise Unit)
- #obituary (P.promise (Obituary ($ +0)))}))
+ #kill-switch (: (P.Promise Unit)
+ (P.promise #.None))
+ #obituary (: (P.Promise (Obituary ($ +0)))
+ (P.promise #.None))}))
mailbox-channel (io.run (stm.follow (get@ #mailbox (@repr self))))
|mailbox| (stm.var mailbox-channel)
_ (P/map (function [_]
@@ -144,12 +146,12 @@
## [Syntax]
(do-template [<with> <resolve> <tag> <desc>]
- [(def: #hidden (<with> name)
+ [(def: #export (<with> name)
(-> Ident cs.Annotations cs.Annotations)
(|>> (#.Cons [(ident-for <tag>)
(code.tag name)])))
- (def: #hidden (<resolve> name)
+ (def: #export (<resolve> name)
(-> Ident (Meta Ident))
(do Monad<Meta>
[[_ annotations _] (macro.find-def name)]
@@ -170,7 +172,7 @@
(p.seq s.local-symbol (:: p.Monad<Parser> wrap (list)))))
(do-template [<name> <desc>]
- [(def: #hidden <name>
+ [(def: #export <name>
(-> Text Text)
(|>> (format <desc> "@")))]
@@ -221,7 +223,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 +231,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,9 +262,9 @@
(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)))))
+ (` (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))))))
)))
@@ -313,7 +315,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,16 +337,16 @@
(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)))))
+ (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!return) (: (T.Task [((~ g!type) (~+ g!actor-refs))
(~ g!outputT)])
(do T.Monad<Task>
[]
diff --git a/stdlib/source/lux/concurrency/frp.lux b/stdlib/source/lux/concurrency/frp.lux
index 541b6530a..230eca335 100644
--- a/stdlib/source/lux/concurrency/frp.lux
+++ b/stdlib/source/lux/concurrency/frp.lux
@@ -24,7 +24,7 @@
{#.doc (doc "Makes an uninitialized Channel (in this case, of Nat)."
(channel Nat))}
(wrap (list (` (: (Channel (~ type))
- (&.promise' #.None))))))
+ (&.promise #.None))))))
## [Values]
(def: #export (filter p xs)
diff --git a/stdlib/source/lux/concurrency/promise.lux b/stdlib/source/lux/concurrency/promise.lux
index 0762694f9..2de5fa2c8 100644
--- a/stdlib/source/lux/concurrency/promise.lux
+++ b/stdlib/source/lux/concurrency/promise.lux
@@ -25,17 +25,11 @@
{#.doc "Represents values produced by asynchronous computations (unlike IO, which is synchronous)."}
(Atom (Promise-State a)))
-(def: #hidden (promise' ?value)
+(def: #export (promise ?value)
(All [a] (-> (Maybe a) (Promise a)))
(atom {#value ?value
#observers (list)}))
-(syntax: #export (promise [type s.any])
- {#.doc (doc "Makes an uninitialized Promise (in this example, of Unit)."
- (promise Unit))}
- (wrap (list (` (: (Promise (~ type))
- (promise' #.None))))))
-
(def: #export (poll promise)
{#.doc "Polls a Promise's value."}
(All [a] (-> (Promise a) (Maybe a)))
@@ -88,7 +82,7 @@
(struct: #export _ (F.Functor Promise)
(def: (map f fa)
- (let [fb (promise ($ +1))
+ (let [fb (: (Promise ($ +1)) (promise #.None))
## fb (promise' #.None)
]
(exec (await (function [a] (resolve (f a) fb))
@@ -103,7 +97,7 @@
#observers (list)}))
(def: (apply ff fa)
- (let [fb (promise ($ +1))
+ (let [fb (: (Promise ($ +1)) (promise #.None))
## fb (promise' #.None)
]
(exec (await (function [f]
@@ -117,7 +111,7 @@
(def: applicative Applicative<Promise>)
(def: (join mma)
- (let [ma (promise ($ +0))
+ (let [ma (: (Promise ($ +0)) (promise #.None))
## ma (promise' #.None)
]
(exec (await (function [ma']
@@ -137,7 +131,7 @@
(def: #export (alt left right)
{#.doc "Heterogeneous alternative combinator."}
(All [a b] (-> (Promise a) (Promise b) (Promise (| a b))))
- (let [a|b (promise (| ($ +0) ($ +1)))
+ (let [a|b (: (Promise (| ($ +0) ($ +1))) (promise #.None))
## a|b (promise' #.None)
]
(with-expansions
@@ -154,7 +148,7 @@
(def: #export (either left right)
{#.doc "Homogeneous alternative combinator."}
(All [a] (-> (Promise a) (Promise a) (Promise a)))
- (let [left||right (promise ($ +0))
+ (let [left||right (: (Promise ($ +0)) (promise #.None))
## left||right (promise' #.None)
]
(`` (exec (~~ (do-template [<promise>]
@@ -168,7 +162,7 @@
(def: #export (future computation)
{#.doc "Runs an I/O computation on its own process and returns an Promise that will eventually host its result."}
(All [a] (-> (IO a) (Promise a)))
- (let [!out (promise ($ +0))
+ (let [!out (: (Promise ($ +0)) (promise #.None))
## !out (promise' #.None)
]
(exec ("lux process future" (io (io.run (resolve (io.run computation)
@@ -178,7 +172,7 @@
(def: #export (wait time)
{#.doc "Returns a Promise that will be resolved after the specified amount of milliseconds."}
(-> Nat (Promise Unit))
- (let [!out (promise Unit)]
+ (let [!out (: (Promise Unit) (promise #.None))]
(exec ("lux process schedule" time (resolve [] !out))
!out)))
diff --git a/stdlib/source/lux/concurrency/space.lux b/stdlib/source/lux/concurrency/space.lux
index 1ba795b24..fb7f199f8 100644
--- a/stdlib/source/lux/concurrency/space.lux
+++ b/stdlib/source/lux/concurrency/space.lux
@@ -105,8 +105,6 @@
(p.either (s.tuple (p.some s.local-symbol))
(:: p.Monad<Parser> wrap (list))))
-(def: #hidden _future P.future)
-
(syntax: #export (on: [export csr.export]
[t-vars type-vars^]
[[actor-name actor-params] reference^]
@@ -133,19 +131,19 @@
(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
+ ((~! P.future)
(A.send (function [(~ g!state) (~ g!receiverL)]
(: (T.Task (~ stateT))
(monad.do T.Monad<Task>
diff --git a/stdlib/source/lux/concurrency/stm.lux b/stdlib/source/lux/concurrency/stm.lux
index f7c7664f1..cc39ae0c3 100644
--- a/stdlib/source/lux/concurrency/stm.lux
+++ b/stdlib/source/lux/concurrency/stm.lux
@@ -264,7 +264,7 @@
For this reason, it's important to note that transactions must be free from side-effects, such as I/O."}
(All [a] (-> (STM a) (P.Promise a)))
- (let [output (P.promise ($ +0))]
+ (let [output (: (P.Promise ($ +0)) (P.promise #.None))]
(exec (io.run init-processor!)
(io.run (write! [stm-proc output] pending-commits))
output)))
diff --git a/stdlib/source/lux/concurrency/task.lux b/stdlib/source/lux/concurrency/task.lux
index 7f1322bf4..a740d7398 100644
--- a/stdlib/source/lux/concurrency/task.lux
+++ b/stdlib/source/lux/concurrency/task.lux
@@ -72,7 +72,7 @@
{#.doc (doc "Makes an uninitialized Task (in this example, of Unit)."
(task Unit))}
(wrap (list (` (: (..Task (~ type))
- (P.promise' #.None))))))
+ (P.promise #.None))))))
(def: #export (from-promise promise)
(All [a] (-> (P.Promise a) (Task a)))
diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux
index 104dcf593..bfc51550b 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)))
@@ -86,9 +86,9 @@
(-> (~ (de-alias inputC))
(~ (de-alias outputC))))))))))))
-(def: #hidden begin! Unit [])
+(def: begin! Unit [])
-(def: #hidden end!
+(def: end!
(All [a] (-> [Unit a] a))
(function [[_ top]]
top))
@@ -104,33 +104,33 @@
(` (..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)])))
+ (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!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..c3be37b73 100644
--- a/stdlib/source/lux/control/cont.lux
+++ b/stdlib/source/lux/control/cont.lux
@@ -57,7 +57,7 @@
(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))))))))
diff --git a/stdlib/source/lux/control/contract.lux b/stdlib/source/lux/control/contract.lux
index ac0ae5432..72b4c0770 100644
--- a/stdlib/source/lux/control/contract.lux
+++ b/stdlib/source/lux/control/contract.lux
@@ -29,8 +29,7 @@
"Otherwise, an error is raised."
(post i/even?
(i/+ 2 2)))}
- (do @
- [g!output (macro.gensym "")]
+ (macro.with-gensyms [g!output]
(wrap (list (` (let [(~ g!output) (~ expr)]
(exec (assert! (~ (code.text (format "Post-condition failed: " (%code test))))
((~ test) (~ g!output)))
diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux
index d14158590..fcee396e1 100644
--- a/stdlib/source/lux/control/exception.lux
+++ b/stdlib/source/lux/control/exception.lux
@@ -17,10 +17,6 @@
(-> Text Text))
## [Values]
-(def: #hidden _text/compose_
- (-> Text Text Text)
- text/compose)
-
(def: #export (match? exception error)
(-> Exception Text Bool)
(text.starts-with? (exception "") error))
@@ -74,6 +70,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))))))))
+ ((~! 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..a5ba038f5 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)))
@@ -46,13 +46,13 @@
(with-gensyms [g!temp]
(wrap (list (` (with-expansions
[(~ g!temp) (~ prev)]
- (cond (~@ (do Monad<List>
+ (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)))))))))
@@ -65,8 +65,8 @@
[i/inc])))}
(with-gensyms [g!temp]
(wrap (list (` (loop [(~ g!temp) (~ prev)]
- (if (|> (~ g!temp) (~@ test))
- ((~' recur) (|> (~ g!temp) (~@ then)))
+ (if (|> (~ g!temp) (~+ test))
+ ((~' recur) (|> (~ g!temp) (~+ then)))
(~ g!temp))))))))
(syntax: #export (do> monad [steps (p.some body^)] prev)
@@ -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 g!temp (` (|> (~ g!temp) (~+ step)))))]
(wrap (list (` (do (~ monad)
[(~ g!temp) (~ prev)
- (~@ step-bindings)]
- (|> (~ g!temp) (~@ last-step)))))))
+ (~+ step-bindings)]
+ (|> (~ g!temp) (~+ last-step)))))))
_
(wrap (list prev)))))
@@ -97,10 +97,9 @@
(|> 5
(exec> [int-to-nat %n log!])
(i/* 10)))}
- (do @
- [g!temp (macro.gensym "")]
+ (with-gensyms [g!temp]
(wrap (list (` (let [(~ g!temp) (~ prev)]
- (exec (|> (~ g!temp) (~@ body))
+ (exec (|> (~ g!temp) (~+ body))
(~ g!temp))))))))
(syntax: #export (tuple> [paths (p.many body^)] prev)
@@ -111,10 +110,9 @@
[i/dec (i// 2)]
[Int/encode]))
"Will become: [50 2 \"5\"]")}
- (do @
- [g!temp (macro.gensym "")]
+ (with-gensyms [g!temp]
(wrap (list (` (let [(~ g!temp) (~ prev)]
- [(~@ (L/map (function [body] (` (|> (~ g!temp) (~@ body))))
+ [(~+ (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..4bce6dd6b 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& 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..49a739b4f 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))
@@ -356,7 +356,7 @@
############################################################
############################################################
-(def: #hidden (show-null _) (-> Null Text) "null")
+(def: (show-null _) (-> Null Text) "null")
(do-template [<name> <type> <codec>]
[(def: <name> (-> <type> Text) <codec>)]
diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux
index 27c60afa9..69f50b5f0 100644
--- a/stdlib/source/lux/data/lazy.lux
+++ b/stdlib/source/lux/data/lazy.lux
@@ -5,14 +5,14 @@
[applicative #+ Applicative]
[monad #+ Monad do])
(concurrency [atom])
- [macro]
+ [macro #+ with-gensyms]
(macro ["s" syntax #+ syntax:])
(type abstract)))
(abstract: #export (Lazy a)
(-> [] a)
- (def: #hidden (freeze' generator)
+ (def: (freeze' generator)
(All [a] (-> (-> [] a) (Lazy a)))
(let [cache (atom.atom (: (Maybe ($ +0)) #.None))]
(@abstract (function [_]
@@ -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/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux
index 6f5b64f5e..8342c9d28 100644
--- a/stdlib/source/lux/data/number/ratio.lux
+++ b/stdlib/source/lux/data/number/ratio.lux
@@ -21,7 +21,7 @@
{#numerator Nat
#denominator Nat})
-(def: #hidden (normalize (^slots [#numerator #denominator]))
+(def: (normalize (^slots [#numerator #denominator]))
(-> Ratio Ratio)
(let [common (math.gcd numerator denominator)]
{#numerator (n// common numerator)
@@ -155,6 +155,6 @@
(ratio numerator denominator)
"The denominator can be omitted if it's 1."
(ratio numerator))}
- (wrap (list (` (normalize {#..numerator (~ numerator)
- #..denominator (~ (maybe.default (' +1)
- ?denominator))})))))
+ (wrap (list (` ((~! normalize) {#..numerator (~ numerator)
+ #..denominator (~ (maybe.default (' +1)
+ ?denominator))})))))
diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux
index e1c93bc5f..1c56f1cb9 100644
--- a/stdlib/source/lux/data/text/format.lux
+++ b/stdlib/source/lux/data/text/format.lux
@@ -19,14 +19,12 @@
))
## [Syntax]
-(def: #hidden _compose_
- (-> Text Text Text)
- (:: text.Monoid<Text> compose))
-
(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))))))
+ (macro.with-gensyms [g!compose]
+ (wrap (list (` (let [(~ g!compose) (:: (~! text.Monoid<Text>) (~' compose))]
+ ($_ (~ g!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..ab85158cf 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:])))
@@ -27,23 +27,23 @@
l.any
regex-char^)))
-(def: #hidden (refine^ refinement^ base^)
+(def: (refine^ refinement^ base^)
(All [a] (-> (l.Lexer a) (l.Lexer Text) (l.Lexer Text)))
(do p.Monad<Parser>
[output base^
_ (l.local output refinement^)]
(wrap output)))
-(def: #hidden word^
+(def: word^
(l.Lexer Text)
(p.either l.alpha-num
(l.one-of "_")))
-(def: #hidden (copy reference)
+(def: (copy reference)
(-> Text (l.Lexer Text))
(p.after (l.this reference) (p/wrap reference)))
-(def: #hidden (join-text^ part^)
+(def: (join-text^ part^)
(-> (l.Lexer (List Text)) (l.Lexer Text))
(do p.Monad<Parser>
[parts part^]
@@ -87,7 +87,7 @@
(l.Lexer Code)
(do p.Monad<Parser>
[char escaped-char^]
- (wrap (` (..copy (~ (code.text char)))))))
+ (wrap (` ((~! ..copy) (~ (code.text char)))))))
(def: re-options^
(l.Lexer Code)
@@ -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)
@@ -113,32 +113,32 @@
init re-user-class^'
rest (p.some (p.after (l.this "&&") (l.enclosed ["[" "]"] re-user-class^')))]
(wrap (list/fold (function [refinement base]
- (` (refine^ (~ refinement) (~ base))))
+ (` ((~! refine^) (~ refinement) (~ base))))
init
rest))))
-(def: #hidden blank^
+(def: blank^
(l.Lexer Text)
(l.one-of " \t"))
-(def: #hidden ascii^
+(def: ascii^
(l.Lexer Text)
(l.range (char "\u0000") (char "\u007F")))
-(def: #hidden control^
+(def: control^
(l.Lexer Text)
(p.either (l.range (char "\u0000") (char "\u001F"))
(l.one-of "\u007F")))
-(def: #hidden punct^
+(def: punct^
(l.Lexer Text)
(l.one-of "!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~"))
-(def: #hidden graph^
+(def: graph^
(l.Lexer Text)
(p.either punct^ l.alpha-num))
-(def: #hidden print^
+(def: print^
(l.Lexer Text)
(p.either graph^
(l.one-of "\u0020")))
@@ -153,8 +153,8 @@
(p.after (l.this "\\D") (wrap (` (l.not l.decimal))))
(p.after (l.this "\\s") (wrap (` l.space)))
(p.after (l.this "\\S") (wrap (` (l.not l.space))))
- (p.after (l.this "\\w") (wrap (` word^)))
- (p.after (l.this "\\W") (wrap (` (l.not word^))))
+ (p.after (l.this "\\w") (wrap (` (~! word^))))
+ (p.after (l.this "\\W") (wrap (` (l.not (~! word^)))))
(p.after (l.this "\\p{Lower}") (wrap (` l.lower)))
(p.after (l.this "\\p{Upper}") (wrap (` l.upper)))
@@ -164,12 +164,12 @@
(p.after (l.this "\\p{Space}") (wrap (` l.space)))
(p.after (l.this "\\p{HexDigit}") (wrap (` l.hexadecimal)))
(p.after (l.this "\\p{OctDigit}") (wrap (` l.octal)))
- (p.after (l.this "\\p{Blank}") (wrap (` blank^)))
- (p.after (l.this "\\p{ASCII}") (wrap (` ascii^)))
- (p.after (l.this "\\p{Contrl}") (wrap (` control^)))
- (p.after (l.this "\\p{Punct}") (wrap (` punct^)))
- (p.after (l.this "\\p{Graph}") (wrap (` graph^)))
- (p.after (l.this "\\p{Print}") (wrap (` print^)))
+ (p.after (l.this "\\p{Blank}") (wrap (` (~! blank^))))
+ (p.after (l.this "\\p{ASCII}") (wrap (` (~! ascii^))))
+ (p.after (l.this "\\p{Contrl}") (wrap (` (~! control^))))
+ (p.after (l.this "\\p{Punct}") (wrap (` (~! punct^))))
+ (p.after (l.this "\\p{Graph}") (wrap (` (~! graph^))))
+ (p.after (l.this "\\p{Print}") (wrap (` (~! print^))))
)))
(def: re-class^
@@ -188,12 +188,12 @@
(p.either (do p.Monad<Parser>
[_ (l.this "\\")
id number^]
- (wrap (` (..copy (~ (code.symbol ["" (int/encode (nat-to-int id))]))))))
+ (wrap (` ((~! ..copy) (~ (code.symbol ["" (int/encode (nat-to-int id))]))))))
(do p.Monad<Parser>
[_ (l.this "\\k<")
captured-name identifier-part^
_ (l.this ">")]
- (wrap (` (..copy (~ (code.symbol ["" captured-name]))))))))
+ (wrap (` ((~! ..copy) (~ (code.symbol ["" captured-name]))))))))
(def: (re-simple^ current-module)
(-> Text (l.Lexer Code))
@@ -214,11 +214,11 @@
(wrap (` (p.default "" (~ base))))
"*"
- (wrap (` (join-text^ (p.some (~ base)))))
+ (wrap (` ((~! join-text^) (p.some (~ base)))))
## "+"
_
- (wrap (` (join-text^ (p.many (~ base)))))
+ (wrap (` ((~! join-text^) (p.many (~ base)))))
)))
(def: (re-counted-quantified^ current-module)
@@ -229,18 +229,18 @@
($_ p.either
(do @
[[from to] (p.seq number^ (p.after (l.this ",") number^))]
- (wrap (` (join-text^ (p.between (~ (code.nat from))
- (~ (code.nat to))
- (~ base))))))
+ (wrap (` ((~! join-text^) (p.between (~ (code.nat from))
+ (~ (code.nat to))
+ (~ base))))))
(do @
[limit (p.after (l.this ",") number^)]
- (wrap (` (join-text^ (p.at-most (~ (code.nat limit)) (~ base))))))
+ (wrap (` ((~! join-text^) (p.at-most (~ (code.nat limit)) (~ base))))))
(do @
[limit (p.before (l.this ",") number^)]
- (wrap (` (join-text^ (p.at-least (~ (code.nat limit)) (~ base))))))
+ (wrap (` ((~! join-text^) (p.at-least (~ (code.nat limit)) (~ base))))))
(do @
[limit number^]
- (wrap (` (join-text^ (p.exactly (~ (code.nat limit)) (~ base))))))))))
+ (wrap (` ((~! join-text^) (p.exactly (~ (code.nat limit)) (~ base))))))))))
(def: (re-quantified^ current-module)
(-> Text (l.Lexer Code))
@@ -253,10 +253,6 @@
(re-quantified^ current-module)
(re-simple^ current-module)))
-(def: #hidden _text/compose_
- (-> Text Text Text)
- (:: text.Monoid<Text> compose))
-
(type: Re-Group
#Non-Capturing
(#Capturing [(Maybe Text) Nat]))
@@ -280,7 +276,7 @@
[idx
names
(list& (list g!temp complex
- (' #let) (` [(~ g!total) (_text/compose_ (~ g!total) (~ g!temp))]))
+ (' #let) (` [(~ g!total) (:: (~! text.Monoid<Text>) (~' compose) (~ g!total) (~ g!temp))]))
steps)]
(#e.Success [(#Capturing [?name num-captures]) scoped])
@@ -296,7 +292,7 @@
[idx!
(list& name! names)
(list& (list name! scoped
- (' #let) (` [(~ g!total) (_text/compose_ (~ g!total) (~ access))]))
+ (' #let) (` [(~ g!total) (:: (~! text.Monoid<Text>) (~' compose) (~ g!total) (~ access))]))
steps)])
)))
[0
@@ -308,15 +304,15 @@
+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)
+(def: (unflatten^ lexer)
(-> (l.Lexer Text) (l.Lexer [Text Unit]))
(p.seq lexer (:: p.Monad<Parser> wrap [])))
-(def: #hidden (|||^ left right)
+(def: (|||^ left right)
(All [l r] (-> (l.Lexer [Text l]) (l.Lexer [Text r]) (l.Lexer [Text (| l r)])))
(function [input]
(case (left input)
@@ -331,7 +327,7 @@
(#e.Error error)
(#e.Error error)))))
-(def: #hidden (|||_^ left right)
+(def: (|||_^ left right)
(All [l r] (-> (l.Lexer [Text l]) (l.Lexer [Text r]) (l.Lexer Text)))
(function [input]
(case (left input)
@@ -350,7 +346,7 @@
(-> [Nat Code] Code)
(if (n/> +0 num-captures)
alt
- (` (unflatten^ (~ alt)))))
+ (` ((~! unflatten^) (~ alt)))))
(def: (re-alternative^ capturing? re-scoped^ current-module)
(-> Bool
@@ -361,13 +357,16 @@
[#let [sub^ (re-sequential^ capturing? re-scoped^ current-module)]
head sub^
tail (p.some (p.after (l.this "|") sub^))
- #let [g!op (if capturing?
- (` |||^)
- (` |||_^))]]
+ #let [g!op (code.symbol ["" " alt "])]]
(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))))]))))
+ (` (let [(~ g!op) (~ (if capturing?
+ (` (~! |||^))
+ (` (~! |||_^))))]
+ ($_ (~ g!op)
+ (~ (prep-alternative head))
+ (~+ (list/map prep-alternative tail)))))]))))
(def: (re-scoped^ current-module)
(-> Text (l.Lexer [Re-Group Code]))
@@ -484,11 +483,9 @@
_
do-something-else))}
- (do @
- [g!temp (macro.gensym "temp")]
+ (with-gensyms [g!temp]
(wrap (list& (` (^multi (~ g!temp)
- [(l.run (~ g!temp) (regex (~ (code.text pattern))))
- (#e.Success (~ (maybe.default g!temp
- bindings)))]))
+ [((~! l.run) (~ g!temp) (regex (~ (code.text pattern))))
+ (#e.Success (~ (maybe.default 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..dbbc26fb8 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])
+(def: (complete-call$ g!obj [method args])
(-> Code Partial-Call Code)
- (` ((~ method) (~ args) (~ obj))))
+ (` ((~ method) (~ args) (~ g!obj))))
## [Syntax]
(def: object-super-class
@@ -1465,7 +1465,7 @@
(ClassName::method2 [arg3 arg4 arg5])))}
(with-gensyms [g!obj]
(wrap (list (` (let [(~ g!obj) (~ obj)]
- (exec (~@ (list/map (complete-call$ g!obj) methods))
+ (exec (~+ (list/map (complete-call$ g!obj) methods))
(~ g!obj))))))))
(def: (class-import$ long-name? [full-name params])
@@ -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))
@@ -1550,7 +1550,7 @@
[(` (Maybe (~ return-type)))
(` (??? (~ return-term)))]
[return-type
- (let [g!temp (code.symbol ["" "Ω"])]
+ (let [g!temp (code.symbol ["" " Ω "])]
(` (let [(~ g!temp) (~ return-term)]
(if (not (null? (:! (primitive "java.lang.Object")
(~ g!temp))))
@@ -1634,7 +1634,7 @@
body
#AutoPrM
- (` (let [(~@ (|> inputs
+ (` (let [(~+ (|> inputs
(list/map auto-conv)
list/join))]
(~ body)))))
@@ -1653,19 +1653,19 @@
"float" (` (f2d (~ output)))
_ output)))
-(def: (with-mode-field-set mode class input)
+(def: (with-mode-field-set mode class g!input)
(-> Primitive-Mode GenericType Code Code)
(case mode
#ManualPrM
- input
+ 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)))
+ _ 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 +1686,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 +1701,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])
@@ -1739,10 +1739,10 @@
(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,18 +1751,18 @@
(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?
- (` (Maybe (~ base-gtype)))
- base-gtype)
+ classC (class-decl-type$ class)
+ typeC (if import-field-maybe?
+ (` (Maybe (~ base-gtype)))
+ base-gtype)
tvar-asts (: (List Code)
(|> class-tvars
(list.filter free-type-param?)
@@ -1774,12 +1774,12 @@
getter-name
(` ((~ 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))))))
@@ -1800,8 +1800,8 @@
(` ((~ 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)))
@@ -2033,9 +2033,9 @@
(` (try ("jvm invokevirtual:java.io.Closeable:close:" (~ (code.symbol ["" (product.left res)]))))))
bindings)]
(wrap (list (` (do Monad<IO>
- [(~@ inits)
+ [(~+ inits)
(~ g!output) (~ body)
- (~' #let) [(~ g!_) (exec (~@ (list.reverse closes)) [])]]
+ (~' #let) [(~ g!_) (exec (~+ (list.reverse closes)) [])]]
((~' wrap) (~ g!output)))))))))
(syntax: #export (class-for [#let [imports (class-imports *compiler*)]]
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..aa2429ae7 100644
--- a/stdlib/source/lux/macro.lux
+++ b/stdlib/source/lux/macro.lux
@@ -197,7 +197,6 @@
(flag-set? (ident-for <tag>)))]
[export? #.export? "exported"]
- [hidden? #.hidden? "hidden"]
[macro? #.macro? "a macro"]
[type? #.type? "a type"]
[struct? #.struct? "a structure"]
@@ -393,7 +392,7 @@
(function [name] (list (code.symbol ["" name]) (` (gensym (~ (code.text name)))))))
symbol-names))]]
(wrap (list (` (do Monad<Meta>
- [(~@ symbol-defs)]
+ [(~+ symbol-defs)]
(~ body))))))
_
@@ -524,8 +523,7 @@
(do Monad<Meta>
[defs (defs module-name)]
(wrap (list.filter (function [[name [def-type def-anns def-value]]]
- (and (export? def-anns)
- (not (hidden? def-anns))))
+ (export? def-anns))
defs))))
(def: #export modules
diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux
index 05a609e1b..a14e415b4 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))
@@ -353,7 +353,7 @@
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])
+ (wrap (.list (` (syntax: (~+ (csw.export export)) ((~ g!name) [(~ g!type) s.symbol])
(do macro.Monad<Meta>
[(~ g!type) (macro.find-type-def (~ g!type))]
(case (|> (~ body)
@@ -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..3cb1fac1a 100644
--- a/stdlib/source/lux/macro/poly/json.lux
+++ b/stdlib/source/lux/macro/poly/json.lux
@@ -28,15 +28,11 @@
(lang [type])
))
-(def: #hidden _map_
- (All [a b] (-> (-> a b) (List a) (List b)))
- list/map)
-
(def: tag
(-> Nat Frac)
(|>> nat-to-int int-to-frac))
-(def: #hidden (rec-encode non-rec)
+(def: (rec-encode non-rec)
(All [a] (-> (-> (-> a JSON)
(-> a JSON))
(-> a JSON)))
@@ -46,7 +42,7 @@
(def: low-mask Nat (|> +1 (bit.shift-left +32) n/dec))
(def: high-mask Nat (|> low-mask (bit.shift-left +32)))
-(struct: #hidden _ (Codec JSON Nat)
+(struct: _ (Codec JSON Nat)
(def: (encode input)
(let [high (|> input (bit.and high-mask) (bit.shift-right +32))
low (bit.and low-mask input)]
@@ -60,12 +56,12 @@
(wrap (n/+ (|> high frac-to-int int-to-nat (bit.shift-left +32))
(|> low frac-to-int int-to-nat))))))
-(struct: #hidden _ (Codec JSON Int)
+(struct: _ (Codec JSON Int)
(def: encode (|>> int-to-nat (:: Codec<JSON,Nat> encode)))
(def: decode
(|>> (:: Codec<JSON,Nat> decode) (:: e.Functor<Error> map nat-to-int))))
-(def: #hidden (nullable writer)
+(def: (nullable writer)
{#.doc "Builds a JSON generator for potentially inexistent values."}
(All [a] (-> (-> a JSON) (-> (Maybe a) JSON)))
(function [elem]
@@ -73,14 +69,14 @@
#.None #//.Null
(#.Some value) (writer value))))
-(struct: #hidden (Codec<JSON,Qty> carrier)
+(struct: (Codec<JSON,Qty> carrier)
(All [unit] (-> unit (Codec JSON (unit.Qty unit))))
(def: encode
(|>> unit.out (:: Codec<JSON,Int> encode)))
(def: decode
(|>> (:: Codec<JSON,Int> decode) (:: e.Functor<Error> map (unit.in carrier)))))
-(poly: #hidden Codec<JSON,?>//encode
+(poly: Codec<JSON,?>//encode
(with-expansions
[<basic> (do-template [<type> <matcher> <encoder>]
[(do @
@@ -90,8 +86,8 @@
[Unit poly.unit (function [(~ (code.symbol ["" "0"]))] #//.Null)]
[Bool poly.bool (|>> #//.Boolean)]
- [Nat poly.nat (:: ..Codec<JSON,Nat> (~' encode))]
- [Int poly.int (:: ..Codec<JSON,Int> (~' encode))]
+ [Nat poly.nat (:: (~! ..Codec<JSON,Nat>) (~' encode))]
+ [Int poly.int (:: (~! ..Codec<JSON,Int>) (~' encode))]
[Frac poly.frac (|>> #//.Number)]
[Text poly.text (|>> #//.String)])
<time> (do-template [<type> <codec>]
@@ -118,7 +114,7 @@
[unitT (poly.apply (p.after (poly.this unit.Qty)
poly.any))]
(wrap (` (: (~ (@JSON//encode inputT))
- (:: (Codec<JSON,Qty> (:! (~ (poly.to-ast *env* unitT)) [])) (~' encode))))))
+ (:: ((~! Codec<JSON,Qty>) (:! (~ (poly.to-ast *env* unitT)) [])) (~' encode))))))
(do @
[#let [g!key (code.local-symbol "\u0000key")
g!val (code.local-symbol "\u0000val")]
@@ -128,8 +124,8 @@
Codec<JSON,?>//encode))]
(wrap (` (: (~ (@JSON//encode inputT))
(|>> d.entries
- (.._map_ (function [[(~ g!key) (~ g!val)]]
- [(~ g!key) ((~ =val=) (~ g!val))]))
+ ((~! list/map) (function [[(~ g!key) (~ g!val)]]
+ [(~ g!key) ((~ =val=) (~ g!val))]))
(d.from-list text.Hash<Text>)
#//.Object)))))
(do @
@@ -137,20 +133,20 @@
(poly.this .Maybe)
Codec<JSON,?>//encode))]
(wrap (` (: (~ (@JSON//encode inputT))
- (..nullable (~ =sub=))))))
+ ((~! ..nullable) (~ =sub=))))))
(do @
[[_ =sub=] (poly.apply ($_ p.seq
(poly.this .List)
Codec<JSON,?>//encode))]
(wrap (` (: (~ (@JSON//encode inputT))
- (|>> (.._map_ (~ =sub=)) sequence.from-list #//.Array)))))
+ (|>> ((~! list/map) (~ =sub=)) sequence.from-list #//.Array)))))
(do @
[#let [g!input (code.local-symbol "\u0000input")]
members (poly.variant (p.many Codec<JSON,?>//encode))]
(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,30 +157,30 @@
(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
(do @
[[selfC non-recC] (poly.recursive Codec<JSON,?>//encode)]
(wrap (` (: (~ (@JSON//encode inputT))
- (..rec-encode (.function [(~ selfC)]
- (~ non-recC)))))))
+ ((~! ..rec-encode) (.function [(~ selfC)]
+ (~ non-recC)))))))
poly.recursive-self
## 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
@@ -192,7 +188,7 @@
(p.fail (text/compose "Cannot create JSON encoder for: " (type.to-text inputT)))
))))
-(poly: #hidden Codec<JSON,?>//decode
+(poly: Codec<JSON,?>//decode
(with-expansions
[<basic> (do-template [<type> <matcher> <decoder>]
[(do @
@@ -202,8 +198,8 @@
[Unit poly.unit //.null]
[Bool poly.bool //.boolean]
- [Nat poly.nat (p.codec ..Codec<JSON,Nat> //.any)]
- [Int poly.int (p.codec ..Codec<JSON,Int> //.any)]
+ [Nat poly.nat (p.codec (~! ..Codec<JSON,Nat>) //.any)]
+ [Int poly.int (p.codec (~! ..Codec<JSON,Int>) //.any)]
[Frac poly.frac //.number]
[Text poly.text //.string])
<time> (do-template [<type> <codec>]
@@ -230,7 +226,7 @@
[unitT (poly.apply (p.after (poly.this unit.Qty)
poly.any))]
(wrap (` (: (~ (@JSON//decode inputT))
- (p.codec (Codec<JSON,Qty> (:! (~ (poly.to-ast *env* unitT)) [])) //.any)))))
+ (p.codec ((~! Codec<JSON,Qty>) (:! (~ (poly.to-ast *env* unitT)) [])) //.any)))))
(do @
[[_ _ valC] (poly.apply ($_ p.seq
(poly.this d.Dict)
@@ -252,7 +248,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 +256,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 +267,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
@@ -307,6 +303,6 @@
(derived: (Codec<JSON,?> Record)))}
(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))))
+ (struct (def: (~' encode) ((~! Codec<JSON,?>//encode) (~ 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..e31b8c876 100644
--- a/stdlib/source/lux/macro/syntax.lux
+++ b/stdlib/source/lux/macro/syntax.lux
@@ -194,13 +194,8 @@
(wrap [real value]))))
## [Syntax]
-(def: #hidden text/join-with text.join-with)
-
-(def: #hidden _run_ p.run)
-(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."
@@ -216,16 +211,13 @@
(with-brackets (spaced (list/map constructor-arg$ constructor-args)))
(with-brackets (spaced (list/map (method-def$ id) methods))))))]
(wrap (list (` ((~ (code.text def-code)))))))))}
- (let [[exported? tokens] (: [(Maybe (Either Unit Unit)) (List Code)]
+ (let [[exported? tokens] (: [Bool (List Code)]
(case tokens
- (^ (list& [_ (#.Tag ["" "hidden"])] tokens'))
- [(#.Some #.Left) tokens']
-
(^ (list& [_ (#.Tag ["" "export"])] tokens'))
- [(#.Some #.Right) tokens']
+ [true tokens']
_
- [#.None tokens]))
+ [false tokens]))
?parts (: (Maybe [Text (List Code) Code Code])
(case tokens
(^ (list [_ (#.Form (list& [_ (#.Symbol ["" name])] args))]
@@ -241,7 +233,7 @@
#.None))]
(case ?parts
(#.Some [name args meta body])
- (with-gensyms [g!tokens g!body g!msg]
+ (with-gensyms [g!text/join-with g!tokens g!body g!error]
(do macro.Monad<Meta>
[vars+parsers (monad.map @
(: (-> Code (Meta [Code Code]))
@@ -258,29 +250,25 @@
args)
#let [g!state (code.symbol ["" "*compiler*"])
error-msg (code.text (text/compose "Wrong syntax for " name))
- export-ast (: (List Code) (case exported?
- (#.Some #.Left)
- (list (' #hidden))
-
- (#.Some #.Right)
- (list (' #export))
-
- _
- (list)))]]
- (wrap (list (` (macro: (~@ export-ast) ((~ (code.symbol ["" name])) (~ g!tokens) (~ g!state))
+ export-ast (: (List Code)
+ (if exported?
+ (list (' #export))
+ (list)))]]
+ (wrap (list (` (macro: (~+ export-ast) ((~ (code.symbol ["" name])) (~ g!tokens) (~ g!state))
(~ meta)
("lux case" (..run (~ g!tokens)
(: (Syntax (Meta (List Code)))
- (do .._Monad<Parser>_
- [(~@ (join-pairs vars+parsers))]
- ((~' wrap) (do macro.Monad<Meta>
+ (do (~! p.Monad<Parser>)
+ [(~+ (join-pairs vars+parsers))]
+ ((~' wrap) (do (~! macro.Monad<Meta>)
[]
(~ body))))))
{(#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!error))
+ (let [(~ g!text/join-with) (~! text.join-with)]
+ (#E.Error ((~ g!text/join-with) ": " (list (~ error-msg) (~ g!error)))))})))))))
_
(macro.fail "Wrong syntax for syntax:"))))
diff --git a/stdlib/source/lux/macro/syntax/common.lux b/stdlib/source/lux/macro/syntax/common.lux
index 8c684537e..9de36fe5d 100644
--- a/stdlib/source/lux/macro/syntax/common.lux
+++ b/stdlib/source/lux/macro/syntax/common.lux
@@ -3,10 +3,6 @@
The goal is to be able to reuse common syntax in macro definitions across libraries."}
lux)
-(type: #export Export
- #Exported
- #Hidden)
-
(type: #export Declaration
{#declaration-name Text
#declaration-args (List Text)})
diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux
index ac6d876c3..0e8b5df9a 100644
--- a/stdlib/source/lux/macro/syntax/common/reader.lux
+++ b/stdlib/source/lux/macro/syntax/common/reader.lux
@@ -1,7 +1,7 @@
(.module: {#.doc "Commons syntax readers."}
lux
(lux (control monad
- ["p" parser])
+ ["p" parser "p/" Monad<Parser>])
(data (coll [list])
[ident "ident/" Eq<Ident>]
[product]
@@ -12,13 +12,9 @@
## Exports
(def: #export export
- {#.doc (doc "A reader for export levels."
- "Such as:"
- #export
- #hidden)}
- (Syntax (Maybe Export))
- (p.maybe (p.alt (s.this (' #export))
- (s.this (' #hidden)))))
+ (Syntax Bool)
+ (p.either (p.after (s.this (' #export)) (p/wrap true))
+ (p/wrap false)))
## Declarations
(def: #export declaration
@@ -28,7 +24,7 @@
(foo bar baz))}
(Syntax Declaration)
(p.either (p.seq s.local-symbol
- (:: p.Monad<Parser> wrap (list)))
+ (p/wrap (list)))
(s.form (p.seq s.local-symbol
(p.many s.local-symbol)))))
@@ -46,7 +42,7 @@
type s.any
value s.any]
(wrap [(#.Some type) value])))
- (p.seq (:: p.Monad<Parser> wrap #.None)
+ (p.seq (p/wrap #.None)
s.any)))
(def: _definition-anns-tag^
diff --git a/stdlib/source/lux/macro/syntax/common/writer.lux b/stdlib/source/lux/macro/syntax/common/writer.lux
index d5ad8cb61..5b5ab9ab5 100644
--- a/stdlib/source/lux/macro/syntax/common/writer.lux
+++ b/stdlib/source/lux/macro/syntax/common/writer.lux
@@ -1,24 +1,18 @@
(.module: {#.doc "Commons syntax writers."}
lux
- (lux (data (coll [list "L/" Functor<List>])
+ (lux (data (coll [list "list/" Functor<List>])
[product])
(macro [code]))
[// #*])
## Exports
-(def: #export (export ?el)
- (-> (Maybe Export) (List Code))
- (case ?el
- #.None
- (list)
-
- (#.Some #//.Exported)
+(def: #export (export exported?)
+ (-> Bool (List Code))
+ (if exported?
(list (' #export))
-
- (#.Some #//.Hidden)
- (list (' #hidden))))
+ (list)))
## Annotations
(def: #export (annotations anns)
(-> Annotations Code)
- (|> anns (L/map (product.both code.tag id)) code.record))
+ (|> anns (list/map (product.both code.tag id)) code.record))
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux
index 66bec5d9b..b755299cd 100644
--- a/stdlib/source/lux/test.lux
+++ b/stdlib/source/lux/test.lux
@@ -5,7 +5,7 @@
[code])
(control [monad #+ do Monad]
["p" parser])
- (concurrency [promise #+ Promise Monad<Promise>])
+ (concurrency [promise #+ Promise])
(data (coll [list "list/" Monad<List> Fold<List>])
[product]
[maybe]
@@ -19,7 +19,7 @@
## [Host]
(do-template [<name> <signal>]
- [(def: #hidden <name> (IO Bottom)
+ [(def: <name> (IO Bottom)
(io ("lux io exit" <signal>)))]
[exit 0]
@@ -39,8 +39,6 @@
(def: pcg-32-magic-inc Nat +12345)
## [Values]
-(def: #hidden Monad<Random> (Monad r.Random) r.Monad<Random>)
-
(def: success Counters [+1 +0])
(def: failure Counters [+0 +1])
(def: start Counters [+0 +0])
@@ -52,24 +50,24 @@
(def: #export (fail message)
(All [a] (-> Text Test))
(|> [failure (format " [Error] " message)]
- (:: Monad<Promise> wrap)
+ (:: promise.Monad<Promise> wrap)
(:: r.Monad<Random> wrap)))
(def: #export (assert message condition)
{#.doc "Check that a condition is true, and fail with the given message otherwise."}
(-> Text Bool (Promise [Counters Text]))
(if condition
- (:: Monad<Promise> wrap [success (format "[Success] " message)])
- (:: Monad<Promise> wrap [failure (format " [Error] " message)])))
+ (:: promise.Monad<Promise> wrap [success (format "[Success] " message)])
+ (:: promise.Monad<Promise> wrap [failure (format " [Error] " message)])))
(def: #export (test message condition)
{#.doc "Check that a condition is true, and fail with the given message otherwise."}
(-> Text Bool Test)
(:: r.Monad<Random> wrap (assert message condition)))
-(def: #hidden (run' tests)
+(def: (run' tests)
(-> (List [Text (IO Test) Text]) (Promise Counters))
- (do Monad<Promise>
+ (do promise.Monad<Promise>
[test-runs (|> tests
(list/map (: (-> [Text (IO Test) Text] (Promise Counters))
(function [[module test description]]
@@ -113,15 +111,13 @@
[seed r.nat]
(function [prng]
(let [[prng' instance] (r.run (r.pcg-32 [pcg-32-magic-inc seed]) test)]
- [prng' (do Monad<Promise>
+ [prng' (do promise.Monad<Promise>
[[counters documentation] instance]
(if (failed? counters)
(wrap [counters (format "Failed with this seed: " (%n seed) "\n" documentation)])
(product.right (r.run prng' (times (n/dec amount) test)))))])))))
## [Syntax]
-(def: #hidden _code/text_ code.text)
-
(syntax: #export (context: description test)
{#.doc (doc "Macro for definint tests."
(context: "Simple macros and constructs"
@@ -188,14 +184,17 @@
)}
(with-gensyms [g!context g!test g!error]
(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)
+ {#..test ((~! code.text) (~ description))}
+ (~! (IO Test))
+ ((~! io) (case ("lux try" ((~! io) ((~! do)
+ (~! r.Monad<Random>)
+ []
+ (~ 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])))
@@ -212,13 +211,10 @@
(list.filter product.left)
(list/map product.right)))))
-(def: #hidden _composeT_ (-> Text Text Text) (:: text.Monoid<Text> compose))
-(def: #hidden _%i_ (-> Int Text) %i)
-
(syntax: #export (run)
{#.doc (doc "Runs all the tests defined on the current module, and in all imported modules."
(run))}
- (with-gensyms [g!successes g!failures g!total-successes g!total-failures]
+ (with-gensyms [g!successes g!failures g!total-successes g!total-failures g!text/compose]
(do @
[current-module macro.current-module-name
modules (macro.imported-modules current-module)
@@ -232,29 +228,31 @@
tests)
num-tests (list.size tests+)
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))])))
- groups)))]
- (exec (log! ($_ _composeT_
- "Test-suite finished."
- "\n"
- (_%i_ (nat-to-int (~ g!total-successes)))
- " out of "
- (_%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))
- ..die
- ..exit))))
- [])))))))))
+ (wrap (list (` (: (~! (IO Unit))
+ ((~! io) (exec ((~! do) (~! promise.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))])))
+ groups)))]
+ (exec (let [(~ g!text/compose) (:: (~! text.Monoid<Text>) (~' compose))]
+ (log! ($_ (~ g!text/compose)
+ "Test-suite finished."
+ "\n"
+ ((~! %i) (nat-to-int (~ g!total-successes)))
+ " out of "
+ ((~! %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))
+ (~! ..die)
+ (~! ..exit)))))
+ [])))))))))
(def: #export (seq left right)
{#.doc "Sequencing combinator."}
@@ -262,7 +260,7 @@
(do r.Monad<Random>
[left left
right right]
- (wrap (do Monad<Promise>
+ (wrap (do promise.Monad<Promise>
[[l-counter l-documentation] left
[r-counter r-documentation] right]
(wrap [(add-counters l-counter r-counter)
diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux
index 8d20c25c5..cf6f1b4e4 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)))))
@@ -107,8 +107,8 @@
(#E.Success [(update@ #.modules (put this-module-name this-module) compiler)
[]]))))
-(syntax: #hidden (install-casts [name s.local-symbol]
- [type-vars (s.tuple (p.some s.local-symbol))])
+(syntax: (install-casts [name s.local-symbol]
+ [type-vars (s.tuple (p.some s.local-symbol))])
(do @
[this-module-name macro.current-module-name
?down-cast (macro.find-macro [this-module-name down-cast])
@@ -125,7 +125,7 @@
down-cast " & " up-cast
") because definitions like that already exist.")))))
-(syntax: #hidden (un-install-casts)
+(syntax: (un-install-casts)
(do macro.Monad<Meta>
[this-module-name macro.current-module-name
?down-cast (macro.find-macro [this-module-name down-cast])
@@ -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))))))))
+ (list (` ((~! un-install-casts)))))))))
diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux
index 39acf31ba..7fe8d02d9 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,7 @@
(#.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))))]]
- (wrap (list retry)))
+ [labels (|> (macro.gensym "") (list.repeat (list.size args)) (monad.seq @))]
+ (wrap (list (` (let [(~+ (|> (list.zip2 labels args) (list/map join-pair) list/join))]
+ (..::: (~ (code.symbol member)) (~+ labels)))))))
))
diff --git a/stdlib/source/lux/type/object.lux b/stdlib/source/lux/type/object.lux
index ba4b06384..d7ebb1e8c 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
@@ -86,32 +86,32 @@
(def: (declarationM g!self (^open))
(-> Code Method Code)
- (let [g!type-vars (L/map code.local-symbol type-vars)
+ (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)
+ (-> Bool Declaration Code Code (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)
+ (-> Bool Text (List Code) Code Code (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)]
+ (` (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)
+ (-> Bool Text (List Code) Code Code (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)]
+ (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)
+ (-> Bool Text (List Code) Code Code (List Ident)
Code)
(let [g!update (code.local-symbol (updateN interface))
g!interface (code.local-symbol interface)
@@ -294,14 +294,14 @@
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)]
+ (All [(~+ g!parameters) (~ g!ext) (~+ g!ancestors) (~ g!child)]
(-> (-> (~ g!child) (~ g!child))
(-> (~ g!object) (~ g!object))))
(let [(~ g!tear-down) (~ g!_object)]
@@ -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))
+ (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!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!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)]
+ (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 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 [_] (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)]
(~ (if (no-parent? parent)
- (` ((~ g!interface) (~@ interface-mappings)
+ (` ((~ g!interface) (~+ interface-mappings)
(~ g!extension)
- ((~ g!state) (~@ g!parameters))))
+ ((~ 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!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)
+ (` (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!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