From 5c4a26c9344898c4fa958946b47b55e1c84818bd Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 2 Dec 2017 13:55:48 -0400
Subject: - "gensym" went back to producing Code, instead of Ident.
---
new-luxc/source/luxc/lang/analysis/structure.lux | 7 +-
new-luxc/source/luxc/lang/translation/eval.jvm.lux | 2 +-
.../luxc/lang/translation/procedure/common.jvm.lux | 17 ++-
stdlib/source/lux.lux | 122 ++++++++++-----------
stdlib/source/lux/cli.lux | 14 +--
stdlib/source/lux/concurrency/actor.lux | 44 ++++----
stdlib/source/lux/control/concatenative.lux | 21 ++--
stdlib/source/lux/control/cont.lux | 2 +-
stdlib/source/lux/control/contract.lux | 9 +-
stdlib/source/lux/control/pipe.lux | 34 +++---
stdlib/source/lux/data/coll/stream.lux | 6 +-
stdlib/source/lux/data/lazy.lux | 2 +-
stdlib/source/lux/data/text/format.lux | 4 +-
stdlib/source/lux/data/text/regex.lux | 17 ++-
stdlib/source/lux/host.jvm.lux | 83 +++++++-------
stdlib/source/lux/macro.lux | 14 +--
stdlib/source/lux/macro/poly.lux | 18 +--
stdlib/source/lux/macro/poly/json.lux | 2 +-
stdlib/source/lux/macro/syntax.lux | 18 +--
stdlib/source/lux/test.lux | 34 +++---
stdlib/source/lux/type/implicit.lux | 8 +-
stdlib/source/lux/type/object.lux | 74 ++++++-------
22 files changed, 270 insertions(+), 282 deletions(-)
diff --git a/new-luxc/source/luxc/lang/analysis/structure.lux b/new-luxc/source/luxc/lang/analysis/structure.lux
index 4561388c9..ce678837e 100644
--- a/new-luxc/source/luxc/lang/analysis/structure.lux
+++ b/new-luxc/source/luxc/lang/analysis/structure.lux
@@ -156,12 +156,11 @@
## blurring the line between what was wanted (the separation)
## and what was analysed.
[tailT tailC]
- (do @
- [g!tail (macro.gensym "tail")]
+ (macro.with-gensyms [g!tail]
(&.with-type tailT
(analyse (` ("lux case" [(~+ tailC)]
- (~@ g!tail)
- (~@ g!tail))))))
+ (~ g!tail)
+ (~ g!tail))))))
))))
(def: #export (analyse-product analyse membersC)
diff --git a/new-luxc/source/luxc/lang/translation/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/eval.jvm.lux
index 2236815ea..9cce16a49 100644
--- a/new-luxc/source/luxc/lang/translation/eval.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/eval.jvm.lux
@@ -25,7 +25,7 @@
(-> $.Inst (Meta Top))
(do macro.Monad
[current-module macro.current-module-name
- [_ class-name] (macro.gensym (format current-module "/eval"))
+ class-name (:: @ map %code (macro.gensym (format current-module "/eval")))
#let [store-name (text.replace-all "/" "." class-name)
bytecode ($d.class #$.V1_6
#$.Public $.noneC
diff --git a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
index 91c5c5f95..336293dc4 100644
--- a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
@@ -84,24 +84,23 @@
(syntax: (arity: [name s.local-symbol] [arity s.nat])
(with-gensyms [g!proc g!name g!translate g!inputs]
(do @
- [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))
- #let [g!input+ (list/map code.symbol g!input+)]]
- (wrap (list (` (def: #export ((~ (code.local-symbol name)) (~@ g!proc))
+ [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))]
+ (wrap (list (` (def: #export ((~ (code.local-symbol name)) (~ g!proc))
(-> (-> (..Vector (~ (code.nat arity)) $.Inst) $.Inst)
(-> Text ..Proc))
- (function [(~@ g!name)]
- (function [(~@ g!translate) (~@ g!inputs)]
- (case (~@ g!inputs)
+ (function [(~ g!name)]
+ (function [(~ g!translate) (~ g!inputs)]
+ (case (~ g!inputs)
(^ (list (~+ g!input+)))
(do macro.Monad
[(~+ (|> g!input+
(list/map (function [g!input]
- (list g!input (` ((~@ g!translate) (~ g!input))))))
+ (list g!input (` ((~ g!translate) (~ g!input))))))
list.concat))]
- ((~' wrap) ((~@ g!proc) [(~+ g!input+)])))
+ ((~' wrap) ((~ g!proc) [(~+ g!input+)])))
(~' _)
- (macro.fail (wrong-arity (~@ g!name) +1 (list.size (~@ g!inputs))))))))))))))
+ (macro.fail (wrong-arity (~ g!name) +1 (list.size (~ g!inputs))))))))))))))
(arity: nullary +0)
(arity: unary +1)
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index e7dae30b1..d7b4164e2 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -1933,9 +1933,6 @@
(untemplate-text subst)
independent)))))))
- [true [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [ident #Nil])]))]]
- (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) ident))))
-
[true [_ (#Form (#Cons [[_ (#Symbol ["" "~'"])] (#Cons [keep-quoted #Nil])]))]]
(untemplate false subst keep-quoted)
@@ -2722,7 +2719,7 @@
(def:''' (gensym prefix state)
#Nil
- (-> Text ($' Meta Ident))
+ (-> Text ($' Meta Code))
("lux case" state
{{#info info #source source #current-module _ #modules modules
#scopes scopes #type-context types #host host
@@ -2734,7 +2731,7 @@
#seed (n/+ +1 seed) #expected expected
#cursor cursor
#scope-type-vars scope-type-vars}
- ["" ($_ text/compose "__gensym__" prefix (nat/encode seed))])}))
+ (symbol$ ["" ($_ text/compose "__gensym__" prefix (nat/encode seed))]))}))
(macro:' #export (Rec tokens)
(list [(tag$ ["lux" "doc"])
@@ -3039,18 +3036,19 @@
_
#None))
(#Some g!name head tail body)
- (let [g!blank ["" ""]
+ (let [g!blank (symbol$ ["" ""])
+ g!name (symbol$ g!name)
body+ (list/fold (: (-> Code Code Code)
(function' [arg body']
(if (symbol? arg)
- (` ("lux function" (~@ g!blank) (~ arg) (~ body')))
- (` ("lux function" (~@ g!blank) (~@ g!blank)
- (case (~@ g!blank) (~ arg) (~ body')))))))
+ (` ("lux function" (~ g!blank) (~ arg) (~ body')))
+ (` ("lux function" (~ g!blank) (~ g!blank)
+ (case (~ g!blank) (~ arg) (~ body')))))))
body
(list/reverse tail))]
(return (list (if (symbol? head)
- (` ("lux function" (~@ g!name) (~ head) (~ body+)))
- (` ("lux function" (~@ g!name) (~@ g!blank) (case (~@ g!blank) (~ head) (~ body+))))))))
+ (` ("lux function" (~ g!name) (~ head) (~ body+)))
+ (` ("lux function" (~ g!name) (~ g!blank) (case (~ g!blank) (~ head) (~ body+))))))))
#None
(fail "Wrong syntax for function")))
@@ -4400,12 +4398,12 @@
(^ (list& [_ (#Form (list))] body branches))
(do Monad
[g!temp (gensym "temp")]
- (wrap (list& (symbol$ g!temp) (` (..^open (~@ g!temp) "" (~ body))) branches)))
+ (wrap (list& g!temp (` (..^open (~ g!temp) "" (~ body))) branches)))
(^ (list& [_ (#Form (list [_ (#Text prefix)]))] body branches))
(do Monad
[g!temp (gensym "temp")]
- (wrap (list& (symbol$ g!temp) (` (..^open (~@ g!temp) (~ (text$ prefix)) (~ body))) branches)))
+ (wrap (list& g!temp (` (..^open (~ g!temp) (~ (text$ prefix)) (~ body))) branches)))
(^ (list [_ (#Symbol name)] [_ (#Text prefix)] body))
(do Monad
@@ -4502,11 +4500,11 @@
(let [pattern (record$ (list/map (: (-> [Ident [Nat Type]] [Code Code])
(function [[[r-prefix r-name] [r-idx r-type]]]
[(tag$ [r-prefix r-name])
- (symbol$ (if (n/= idx r-idx)
- g!output
- g!_))]))
+ (if (n/= idx r-idx)
+ g!output
+ g!_)]))
(zip2 tags (enumerate members))))]
- (return (list (` ("lux case" (~ record) {(~ pattern) (~@ g!output)})))))
+ (return (list (` ("lux case" (~ record) {(~ pattern) (~ g!output)})))))
_
(fail "get@ can only use records.")))
@@ -4521,7 +4519,7 @@
(^ (list selector))
(do Monad
[g!record (gensym "record")]
- (wrap (list (` (function [(~@ g!record)] (..get@ (~ selector) (~@ g!record)))))))
+ (wrap (list (` (function [(~ g!record)] (..get@ (~ selector) (~ g!record)))))))
_
(fail "Wrong syntax for get@")))
@@ -4590,7 +4588,7 @@
(list/map int/encode ))))"}
(do Monad
[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.
@@ -4602,7 +4600,7 @@
(list/map int/encode ))))"}
(do Monad
[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))
@@ -4817,7 +4815,7 @@
(function [[r-slot-name [r-idx r-type]]]
(do Monad
[g!slot (gensym "")]
- (return [r-slot-name r-idx (symbol$ g!slot)]))))
+ (return [r-slot-name r-idx g!slot]))))
(zip2 tags (enumerate members)))]
(let [pattern (record$ (list/map (: (-> [Ident Nat Code] [Code Code])
(function [[r-slot-name r-idx r-var]]
@@ -4844,20 +4842,19 @@
_
(do Monad
[bindings (monad/map Monad
- (: (-> Code (Meta Ident))
+ (: (-> Code (Meta Code))
(function [_] (gensym "temp")))
slots)
#let [pairs (zip2 slots bindings)
- update-expr (list/fold (: (-> [Code Ident] Code Code)
+ update-expr (list/fold (: (-> [Code Code] Code Code)
(function [[s b] v]
- (` (..set@ (~ s) (~ v) (~@ b)))))
+ (` (..set@ (~ s) (~ v) (~ b)))))
value
(list/reverse pairs))
- [_ accesses'] (list/fold (: (-> [Code Ident] [Code (List (List Code))] [Code (List (List Code))])
+ [_ accesses'] (list/fold (: (-> [Code Code] [Code (List (List Code))] [Code (List (List Code))])
(function [[new-slot new-binding] [old-record accesses']]
- (let [new-binding (symbol$ new-binding)]
- [(` (get@ (~ new-slot) (~ new-binding)))
- (#Cons (list new-binding old-record) accesses')])))
+ [(` (get@ (~ new-slot) (~ new-binding)))
+ (#Cons (list new-binding old-record) accesses')]))
[record (: (List (List Code)) #Nil)]
pairs)
accesses (list/join (list/reverse accesses'))]]
@@ -4867,13 +4864,13 @@
(^ (list selector value))
(do Monad
[g!record (gensym "record")]
- (wrap (list (` (function [(~@ g!record)] (..set@ (~ selector) (~ value) (~@ g!record)))))))
+ (wrap (list (` (function [(~ g!record)] (..set@ (~ selector) (~ value) (~ g!record)))))))
(^ (list selector))
(do Monad
[g!value (gensym "value")
g!record (gensym "record")]
- (wrap (list (` (function [(~@ g!value) (~@ g!record)] (..set@ (~ selector) (~@ g!value) (~@ g!record)))))))
+ (wrap (list (` (function [(~ g!value) (~ g!record)] (..set@ (~ selector) (~ g!value) (~ g!record)))))))
_
(fail "Wrong syntax for set@")))
@@ -4906,7 +4903,7 @@
(function [[r-slot-name [r-idx r-type]]]
(do Monad
[g!slot (gensym "")]
- (return [r-slot-name r-idx (symbol$ g!slot)]))))
+ (return [r-slot-name r-idx g!slot]))))
(zip2 tags (enumerate members)))]
(let [pattern (record$ (list/map (: (-> [Ident Nat Code] [Code Code])
(function [[r-slot-name r-idx r-var]]
@@ -4934,20 +4931,20 @@
(do Monad
[g!record (gensym "record")
g!temp (gensym "temp")]
- (wrap (list (` (let [(~@ g!record) (~ record)
- (~@ g!temp) (get@ [(~+ slots)] (~@ g!record))]
- (set@ [(~+ slots)] ((~ fun) (~@ g!temp)) (~@ g!record))))))))
+ (wrap (list (` (let [(~ g!record) (~ record)
+ (~ g!temp) (get@ [(~+ slots)] (~ g!record))]
+ (set@ [(~+ slots)] ((~ fun) (~ g!temp)) (~ g!record))))))))
(^ (list selector fun))
(do Monad
[g!record (gensym "record")]
- (wrap (list (` (function [(~@ g!record)] (..update@ (~ selector) (~ fun) (~@ g!record)))))))
+ (wrap (list (` (function [(~ g!record)] (..update@ (~ selector) (~ fun) (~ g!record)))))))
(^ (list selector))
(do Monad
[g!fun (gensym "fun")
g!record (gensym "record")]
- (wrap (list (` (function [(~@ g!fun) (~@ g!record)] (..update@ (~ selector) (~@ g!fun) (~@ g!record)))))))
+ (wrap (list (` (function [(~ g!fun) (~ g!record)] (..update@ (~ selector) (~ g!fun) (~ g!record)))))))
_
(fail "Wrong syntax for update@")))
@@ -5291,10 +5288,9 @@
(~+ inits))))))
(do Monad
[aliases (monad/map Monad
- (: (-> Code (Meta Ident))
+ (: (-> Code (Meta Code))
(function [_] (gensym "")))
- inits)
- #let [aliases (list/map symbol$ aliases)]]
+ inits)]
(return (list (` (let [(~+ (interleave aliases inits))]
(.loop [(~+ (interleave vars aliases))]
(~ body)))))))))
@@ -5335,7 +5331,7 @@
(let [tag (tag$ [module name])]
(case (get name slot-pairings)
(#Some binding) [tag binding]
- #None [tag (symbol$ g!_)]))))
+ #None [tag g!_]))))
tags))]]
(return (list& pattern body branches)))
@@ -5551,13 +5547,13 @@
(wrap [init extras']))))
(def: (multi-level-case$ g!_ [[init-pattern levels] body])
- (-> Ident [Multi-Level-Case Code] (List Code))
+ (-> Code [Multi-Level-Case Code] (List Code))
(let [inner-pattern-body (list/fold (function [[calculation pattern] success]
(` (case (~ calculation)
(~ pattern)
(~ success)
- (~@ g!_)
+ (~ g!_)
#.None)))
(` (#.Some (~ body)))
(: (List [Code Code]) (list/reverse levels)))]
@@ -5588,18 +5584,18 @@
[mlc (multi-level-case^ levels)
expected get-expected-type
g!temp (gensym "temp")]
- (let [output (list (symbol$ g!temp)
+ (let [output (list g!temp
(` ("lux case" ("lux check" (#.Apply (~ (type-to-code expected)) Maybe)
- (case (~@ g!temp)
+ (case (~ g!temp)
(~+ (multi-level-case$ g!temp [mlc body]))
- (~@ g!temp)
+ (~ g!temp)
#.None))
- {(#Some (~@ g!temp))
- (~@ g!temp)
+ {(#Some (~ g!temp))
+ (~ g!temp)
#None
- (case (~@ g!temp)
+ (case (~ g!temp)
(~+ next-branches))})))]
(wrap output)))
@@ -5695,9 +5691,9 @@
(to-list set))))}
(case tokens
(^ (list& [_meta (#Form (list [_ (#Symbol ["" name])] pattern))] body branches))
- (let [g!whole ["" name]]
- (return (list& (symbol$ g!whole)
- (` (case (~@ g!whole) (~ pattern) (~ body)))
+ (let [g!whole (symbol$ ["" name])]
+ (return (list& g!whole
+ (` (case (~ g!whole) (~ pattern) (~ body)))
branches)))
_
@@ -5710,9 +5706,9 @@
(foo value)))}
(case tokens
(^ (list& [_meta (#Form (list [_ (#Symbol ["" name])] [_ (#Tuple steps)]))] body branches))
- (let [g!name ["" name]]
- (return (list& (symbol$ g!name)
- (` (let [(~@ g!name) (|> (~@ g!name) (~+ steps))]
+ (let [g!name (symbol$ ["" name])]
+ (return (list& g!name
+ (` (let [(~ g!name) (|> (~ g!name) (~+ steps))]
(~ body)))
branches)))
@@ -5831,14 +5827,14 @@
[arg (` ((~' ~) (~ (symbol$ ["" arg]))))])
args)]]
(wrap (list (` (macro: (~+ (export export?))
- ((~ (symbol$ ["" name])) (~@ g!tokens) (~@ g!compiler))
+ ((~ (symbol$ ["" name])) (~ g!tokens) (~ g!compiler))
(~ anns)
- (case (~@ g!tokens)
+ (case (~ g!tokens)
(^ (list (~+ (list/map (|>> [""] symbol$) args))))
- (#.Right [(~@ g!compiler)
+ (#.Right [(~ g!compiler)
(list (` (~ (replace-syntax rep-env input-template))))])
- (~@ g!_)
+ (~ g!_)
(#.Left (~ (text$ (text/compose "Wrong syntax for " name))))
)))))
))
@@ -5923,7 +5919,7 @@
(^ [ann (#Form (list [_ (#Symbol ["" "~~"])] expansion))])
(do Monad
[g!expansion (gensym "g!expansion")]
- (wrap [(list [(symbol$ g!expansion) expansion]) (symbol$ g!expansion)]))
+ (wrap [(list [g!expansion expansion]) g!expansion]))
(^template []
[ann ( parts)]
@@ -5985,7 +5981,7 @@
[_ ( value)]
(do Monad
[g!meta (gensym "g!meta")]
- (wrap (` [(~@ g!meta) ( (~ ( value)))]))))
+ (wrap (` [(~ g!meta) ( (~ ( value)))]))))
([#Bool "Bool" bool$]
[#Nat "Nat" nat$]
[#Int "Int" int$]
@@ -6005,7 +6001,7 @@
(wrap (` [(~ =key) (~ =value)]))))
fields)
g!meta (gensym "g!meta")]
- (wrap (` [(~@ g!meta) (#.Record (~ (untemplate-list =fields)))])))
+ (wrap (` [(~ g!meta) (#.Record (~ (untemplate-list =fields)))])))
[_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))]
(return unquoted)
@@ -6021,13 +6017,13 @@
(do Monad
[=inits (monad/map Monad untemplate-pattern (list/reverse inits))
g!meta (gensym "g!meta")]
- (wrap (` [(~@ g!meta) ( (~ (untemplate-list& spliced =inits)))])))
+ (wrap (` [(~ g!meta) ( (~ (untemplate-list& spliced =inits)))])))
_
(do Monad
[=elems (monad/map Monad untemplate-pattern elems)
g!meta (gensym "g!meta")]
- (wrap (` [(~@ g!meta) ( (~ (untemplate-list =elems)))])))))
+ (wrap (` [(~ g!meta) ( (~ (untemplate-list =elems)))])))))
([#Tuple] [#Form])
))
diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux
index 0e283122d..5a3672a39 100644
--- a/stdlib/source/lux/cli.lux
+++ b/stdlib/source/lux/cli.lux
@@ -127,23 +127,23 @@
(#Parsed args)
(with-gensyms [g!args g!_ g!output g!message]
- (wrap (list (` ("lux program" (~@ g!args)
+ (wrap (list (` ("lux program" (~ g!args)
(case ((: (..CLI (io.IO Unit))
((~! do) (~! p.Monad)
[(~+ (|> args
(list/map (function [[binding parser]]
(list binding parser)))
list/join))
- (~@ g!_) ..end]
+ (~ g!_) ..end]
((~' wrap) ((~! do) (~! io.Monad)
[]
(~ body)))))
- (~@ g!args))
- (#E.Success [(~@ g!_) (~@ g!output)])
- (~@ g!output)
+ (~ g!args))
+ (#E.Success [(~ g!_) (~ g!output)])
+ (~ g!output)
- (#E.Error (~@ g!message))
- (error! (~@ g!message))
+ (#E.Error (~ g!message))
+ (error! (~ g!message))
)))
)))
))
diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux
index 694234d17..b326d0028 100644
--- a/stdlib/source/lux/concurrency/actor.lux
+++ b/stdlib/source/lux/concurrency/actor.lux
@@ -262,10 +262,10 @@
(do P.Monad
[]
(~ bodyC))))))}))
- (` (def: (~+ (csw.export export)) ((~ g!new) (~@ g!init))
+ (` (def: (~+ (csw.export export)) ((~ g!new) (~ g!init))
(All [(~+ g!vars)]
(-> ((~ g!type) (~+ g!vars)) (io.IO ((~ g!actor) (~+ g!vars)))))
- (..spawn (~ g!behavior) (~@ g!init))))))
+ (..spawn (~ g!behavior) (~ g!init))))))
)))
(type: Signature
@@ -342,27 +342,27 @@
(with-message actor-name)
csw.annotations))
(All [(~+ g!all-vars)] (-> (~+ g!inputsT) (~ actorC) (T.Task (~ (get@ #output signature)))))
- (let [(~@ g!task) (T.task (~ g!outputT))]
+ (let [(~ g!task) (T.task (~ g!outputT))]
(io.run (do io.Monad
- [(~@ g!sent?) (..send (function [(~ g!state) (~ g!self)]
- (do P.Monad
- [(~@ g!return) (: (T.Task [((~ g!type) (~+ g!actor-refs))
- (~ g!outputT)])
- (do T.Monad
- []
- (~ body)))]
- (case (~@ g!return)
- (#.Right [(~ g!state) (~@ g!return)])
- (exec (io.run (P.resolve (#.Right (~@ g!return)) (~@ g!task)))
- (T.return (~ g!state)))
-
- (#.Left (~@ g!error))
- (exec (io.run (P.resolve (#.Left (~@ g!error)) (~@ g!task)))
- (T.fail (~@ g!error))))
- ))
- (~ g!self))]
- (if (~@ g!sent?)
- ((~' wrap) (~@ g!task))
+ [(~ g!sent?) (..send (function [(~ g!state) (~ g!self)]
+ (do P.Monad
+ [(~ g!return) (: (T.Task [((~ g!type) (~+ g!actor-refs))
+ (~ g!outputT)])
+ (do T.Monad
+ []
+ (~ body)))]
+ (case (~ g!return)
+ (#.Right [(~ g!state) (~ g!return)])
+ (exec (io.run (P.resolve (#.Right (~ g!return)) (~ g!task)))
+ (T.return (~ g!state)))
+
+ (#.Left (~ g!error))
+ (exec (io.run (P.resolve (#.Left (~ g!error)) (~ g!task)))
+ (T.fail (~ g!error))))
+ ))
+ (~ g!self))]
+ (if (~ g!sent?)
+ ((~' wrap) (~ g!task))
((~' wrap) (T.throw ..Dead ""))))))))
))
)))
diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux
index d4716709b..bfc51550b 100644
--- a/stdlib/source/lux/control/concatenative.lux
+++ b/stdlib/source/lux/control/concatenative.lux
@@ -80,9 +80,9 @@
[?bottomI ?bottomO]
(with-gensyms [g!stack]
(monad.do @
- [inputC (singleton (macro.expand-all (stack-fold (get@ #top inputs) (maybe.default (code.symbol g!stack) ?bottomI))))
- outputC (singleton (macro.expand-all (stack-fold (get@ #top outputs) (maybe.default (code.symbol g!stack) ?bottomO))))]
- (wrap (list (` (All [(~@ g!stack)]
+ [inputC (singleton (macro.expand-all (stack-fold (get@ #top inputs) (maybe.default g!stack ?bottomI))))
+ outputC (singleton (macro.expand-all (stack-fold (get@ #top outputs) (maybe.default g!stack ?bottomO))))]
+ (wrap (list (` (All [(~ g!stack)]
(-> (~ (de-alias inputC))
(~ (de-alias outputC))))))))))))
@@ -124,14 +124,13 @@
(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 @))
- #let [g!inputs (list/map code.symbol g!inputs)]]
- (wrap (list (` (: (All [(~+ g!inputs) (~@ g!output)]
- (-> (-> (~+ g!inputs) (~@ g!output))
- (=> [(~+ g!inputs)] [(~@ g!output)])))
- (function [(~@ g!func)]
- (function [(~ (stack-fold g!inputs (code.symbol g!stack)))]
- [(~@ g!stack) ((~@ g!func) (~+ g!inputs))])))))))))
+ [g!inputs (|> (macro.gensym "input") (list.repeat arity) (monad.seq @))]
+ (wrap (list (` (: (All [(~+ g!inputs) (~ g!output)]
+ (-> (-> (~+ g!inputs) (~ g!output))
+ (=> [(~+ g!inputs)] [(~ g!output)])))
+ (function [(~ g!func)]
+ (function [(~ (stack-fold g!inputs g!stack))]
+ [(~ g!stack) ((~ g!func) (~+ g!inputs))])))))))))
## [Primitives]
(def: #export apply1 (apply +1))
diff --git a/stdlib/source/lux/control/cont.lux b/stdlib/source/lux/control/cont.lux
index 1f50fe547..c3be37b73 100644
--- a/stdlib/source/lux/control/cont.lux
+++ b/stdlib/source/lux/control/cont.lux
@@ -59,7 +59,7 @@
{#.doc (doc "Turns any expression into a function that is pending a continuation."
(pending (some-function some-input)))}
(with-gensyms [g!k]
- (wrap (list (` (.function [(~@ g!k)] ((~@ g!k) (~ expr))))))))
+ (wrap (list (` (.function [(~ g!k)] ((~ g!k) (~ expr))))))))
(def: #export (portal init)
(All [i o z]
diff --git a/stdlib/source/lux/control/contract.lux b/stdlib/source/lux/control/contract.lux
index 71d476517..72b4c0770 100644
--- a/stdlib/source/lux/control/contract.lux
+++ b/stdlib/source/lux/control/contract.lux
@@ -29,9 +29,8 @@
"Otherwise, an error is raised."
(post i/even?
(i/+ 2 2)))}
- (do @
- [g!output (macro.gensym "")]
- (wrap (list (` (let [(~@ g!output) (~ expr)]
+ (macro.with-gensyms [g!output]
+ (wrap (list (` (let [(~ g!output) (~ expr)]
(exec (assert! (~ (code.text (format "Post-condition failed: " (%code test))))
- ((~ test) (~@ g!output)))
- (~@ g!output))))))))
+ ((~ test) (~ g!output)))
+ (~ g!output))))))))
diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux
index 09b41b530..a5ba038f5 100644
--- a/stdlib/source/lux/control/pipe.lux
+++ b/stdlib/source/lux/control/pipe.lux
@@ -45,17 +45,17 @@
[(new> -1)])))}
(with-gensyms [g!temp]
(wrap (list (` (with-expansions
- [(~@ g!temp) (~ prev)]
+ [(~ g!temp) (~ prev)]
(cond (~+ (do Monad
[[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)))
_
- (code.symbol g!temp))))))))))
+ g!temp)))))))))
(syntax: #export (loop> [test body^] [then body^] prev)
{#.doc (doc "Loops for pipes."
@@ -64,10 +64,10 @@
(loop> [(i/< 10)]
[i/inc])))}
(with-gensyms [g!temp]
- (wrap (list (` (loop [(~@ g!temp) (~ prev)]
- (if (|> (~@ g!temp) (~+ test))
- ((~' recur) (|> (~@ g!temp) (~+ then)))
- (~@ g!temp))))))))
+ (wrap (list (` (loop [(~ g!temp) (~ prev)]
+ (if (|> (~ g!temp) (~+ test))
+ ((~' recur) (|> (~ g!temp) (~+ then)))
+ (~ g!temp))))))))
(syntax: #export (do> monad [steps (p.some body^)] prev)
{#.doc (doc "Monadic pipes."
@@ -82,11 +82,11 @@
(^ (list& last-step prev-steps))
(let [step-bindings (do Monad
[step (list.reverse prev-steps)]
- (list (code.symbol g!temp) (` (|> (~@ g!temp) (~+ step)))))]
+ (list g!temp (` (|> (~ g!temp) (~+ step)))))]
(wrap (list (` (do (~ monad)
- [(~@ g!temp) (~ prev)
+ [(~ g!temp) (~ prev)
(~+ step-bindings)]
- (|> (~@ g!temp) (~+ last-step)))))))
+ (|> (~ g!temp) (~+ last-step)))))))
_
(wrap (list prev)))))
@@ -98,9 +98,9 @@
(exec> [int-to-nat %n log!])
(i/* 10)))}
(with-gensyms [g!temp]
- (wrap (list (` (let [(~@ g!temp) (~ prev)]
- (exec (|> (~@ g!temp) (~+ body))
- (~@ g!temp))))))))
+ (wrap (list (` (let [(~ g!temp) (~ prev)]
+ (exec (|> (~ g!temp) (~+ body))
+ (~ g!temp))))))))
(syntax: #export (tuple> [paths (p.many body^)] prev)
{#.doc (doc "Parallel branching for pipes."
@@ -111,8 +111,8 @@
[Int/encode]))
"Will become: [50 2 \"5\"]")}
(with-gensyms [g!temp]
- (wrap (list (` (let [(~@ g!temp) (~ prev)]
- [(~+ (L/map (function [body] (` (|> (~@ g!temp) (~+ body))))
+ (wrap (list (` (let [(~ g!temp) (~ prev)]
+ [(~+ (L/map (function [body] (` (|> (~ g!temp) (~+ body))))
paths))]))))))
(syntax: #export (case> [branches (p.many (p.seq s.any s.any))] prev)
diff --git a/stdlib/source/lux/data/coll/stream.lux b/stdlib/source/lux/data/coll/stream.lux
index d4ab696fd..4bce6dd6b 100644
--- a/stdlib/source/lux/data/coll/stream.lux
+++ b/stdlib/source/lux/data/coll/stream.lux
@@ -137,8 +137,8 @@
(func x y z)))}
(with-gensyms [g!stream]
(let [body+ (` (let [(~+ (List/join (List/map (function [pattern]
- (list (` [(~ pattern) (~@ g!stream)])
- (` (cont.run (~@ g!stream)))))
+ (list (` [(~ pattern) (~ g!stream)])
+ (` ((~! cont.run) (~ g!stream)))))
patterns)))]
(~ body)))]
- (wrap (list& (code.symbol g!stream) body+ branches)))))
+ (wrap (list& g!stream body+ branches)))))
diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux
index eba490617..69f50b5f0 100644
--- a/stdlib/source/lux/data/lazy.lux
+++ b/stdlib/source/lux/data/lazy.lux
@@ -31,7 +31,7 @@
(syntax: #export (freeze expr)
(with-gensyms [g!_]
- (wrap (list (` ((~! freeze') (function [(~@ g!_)] (~ expr))))))))
+ (wrap (list (` ((~! freeze') (function [(~ g!_)] (~ expr))))))))
(struct: #export _ (Functor Lazy)
(def: (map f fa)
diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux
index 8068a3366..1c56f1cb9 100644
--- a/stdlib/source/lux/data/text/format.lux
+++ b/stdlib/source/lux/data/text/format.lux
@@ -23,8 +23,8 @@
{#.doc (doc "Text interpolation."
(format "Static part " (%t static) " does not match URI: " uri))}
(macro.with-gensyms [g!compose]
- (wrap (list (` (let [(~@ g!compose) (:: (~! text.Monoid) (~' compose))]
- ($_ (~@ g!compose) (~+ fragments))))))))
+ (wrap (list (` (let [(~ g!compose) (:: (~! text.Monoid) (~' 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 45f1f8f69..ab85158cf 100644
--- a/stdlib/source/lux/data/text/regex.lux
+++ b/stdlib/source/lux/data/text/regex.lux
@@ -357,14 +357,14 @@
[#let [sub^ (re-sequential^ capturing? re-scoped^ current-module)]
head sub^
tail (p.some (p.after (l.this "|") sub^))
- #let [g!op ["" " alt "]]]
+ #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))
- (` (let [(~@ g!op) (~ (if capturing?
- (` (~! |||^))
- (` (~! |||_^))))]
- ($_ (~@ g!op)
+ (` (let [(~ g!op) (~ (if capturing?
+ (` (~! |||^))
+ (` (~! |||_^))))]
+ ($_ (~ g!op)
(~ (prep-alternative head))
(~+ (list/map prep-alternative tail)))))]))))
@@ -484,9 +484,8 @@
_
do-something-else))}
(with-gensyms [g!temp]
- (wrap (list& (` (^multi (~@ g!temp)
- [((~! l.run) (~@ g!temp) (regex (~ (code.text pattern))))
- (#e.Success (~ (maybe.default (code.symbol g!temp)
- bindings)))]))
+ (wrap (list& (` (^multi (~ g!temp)
+ [((~! l.run) (~ g!temp) (regex (~ (code.text pattern))))
+ (#e.Success (~ (maybe.default g!temp bindings)))]))
body
branches))))
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index 29937c041..dbbc26fb8 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -1260,8 +1260,8 @@
))
(def: (complete-call$ g!obj [method args])
- (-> Ident Partial-Call Code)
- (` ((~ method) (~ args) (~@ g!obj))))
+ (-> Code Partial-Call Code)
+ (` ((~ method) (~ args) (~ g!obj))))
## [Syntax]
(def: object-super-class
@@ -1402,10 +1402,10 @@
"=>"
(#.Some "YOLO"))}
(with-gensyms [g!temp]
- (wrap (list (` (let [(~@ g!temp) (~ expr)]
- (if ("jvm null?" (~@ g!temp))
+ (wrap (list (` (let [(~ g!temp) (~ expr)]
+ (if ("jvm null?" (~ g!temp))
#.None
- (#.Some (~@ g!temp)))))))))
+ (#.Some (~ g!temp)))))))))
(syntax: #export (!!! expr)
{#.doc (doc "Takes a (Maybe ObjectType) and returns a ObjectType."
@@ -1418,8 +1418,8 @@
"YOLO")}
(with-gensyms [g!value]
(wrap (list (` ("lux case" (~ expr)
- {(#.Some (~@ g!value))
- (~@ g!value)
+ {(#.Some (~ g!value))
+ (~ g!value)
#.None
("jvm null")}))))))
@@ -1430,7 +1430,7 @@
"If it fails, you get (#.Left error+stack-traces-as-text)."
(try (risky-computation input)))}
(with-gensyms [g!_]
- (wrap (list (`' ("lux try" (.function [(~@ g!_)] (~ expr))))))))
+ (wrap (list (`' ("lux try" (.function [(~ g!_)] (~ expr))))))))
(syntax: #export (instance? [#let [imports (class-imports *compiler*)]]
[class (generic-type^ imports (list))]
@@ -1446,8 +1446,8 @@
(do @
[g!obj (macro.gensym "obj")]
(wrap (list (` (: (-> (primitive "java.lang.Object") Bool)
- (function [(~@ g!obj)]
- ((~ (code.text (format "jvm instanceof" ":" (simple-class$ (list) class)))) (~@ g!obj))))))))
+ (function [(~ g!obj)]
+ ((~ (code.text (format "jvm instanceof" ":" (simple-class$ (list) class)))) (~ g!obj))))))))
))
(syntax: #export (synchronized lock body)
@@ -1464,9 +1464,9 @@
(ClassName::method1 [arg0 arg1 arg2])
(ClassName::method2 [arg3 arg4 arg5])))}
(with-gensyms [g!obj]
- (wrap (list (` (let [(~@ g!obj) (~ obj)]
+ (wrap (list (` (let [(~ g!obj) (~ obj)]
(exec (~+ (list/map (complete-call$ g!obj) methods))
- (~@ g!obj))))))))
+ (~ g!obj))))))))
(def: (class-import$ long-name? [full-name params])
(-> Bool ClassDecl Code)
@@ -1509,10 +1509,9 @@
(: (-> [Bool GenericType] (Meta [Code Code]))
(function [[maybe? _]]
(with-gensyms [arg-name]
- (let [arg-name (code.symbol arg-name)]
- (wrap [arg-name (if maybe?
- (` (!!! (~ arg-name)))
- arg-name)])))))
+ (wrap [arg-name (if maybe?
+ (` (!!! (~ arg-name)))
+ arg-name)]))))
import-member-args)
#let [arg-classes (: (List Text)
(list/map (|>> product.right (simple-class$ (list/compose type-params import-member-tvars)))
@@ -1551,11 +1550,11 @@
[(` (Maybe (~ return-type)))
(` (??? (~ return-term)))]
[return-type
- (let [g!temp ["" "Ω"]]
- (` (let [(~@ g!temp) (~ return-term)]
+ (let [g!temp (code.symbol ["" " Ω "])]
+ (` (let [(~ g!temp) (~ return-term)]
(if (not (null? (:! (primitive "java.lang.Object")
- (~@ g!temp))))
- (~@ g!temp)
+ (~ g!temp))))
+ (~ g!temp)
(error! "Cannot produce null references from method calls.")))))])
_
@@ -1655,18 +1654,18 @@
_ output)))
(def: (with-mode-field-set mode class g!input)
- (-> Primitive-Mode GenericType Ident Code)
+ (-> Primitive-Mode GenericType Code Code)
(case mode
#ManualPrM
- (code.symbol g!input)
+ g!input
#AutoPrM
(case (simple-class$ (list) class)
- "byte" (` (l2b (~@ g!input)))
- "short" (` (l2s (~@ g!input)))
- "int" (` (l2i (~@ g!input)))
- "float" (` (d2f (~@ g!input)))
- _ (code.symbol g!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)))
@@ -1731,12 +1730,12 @@
(case kind
#Class
["invokevirtual"
- (list (code.symbol g!obj))
+ (list g!obj)
(list (class-decl-type$ class))]
#Interface
["invokeinterface"
- (list (code.symbol g!obj))
+ (list g!obj)
(list (class-decl-type$ class))]
)))
def-params (#.Cons (code.tuple arg-function-inputs) obj-ast)
@@ -1762,8 +1761,8 @@
base-gtype (class->type import-field-mode type-params import-field-type)
classC (class-decl-type$ class)
typeC (if import-field-maybe?
- (` (Maybe (~ base-gtype)))
- base-gtype)
+ (` (Maybe (~ base-gtype)))
+ base-gtype)
tvar-asts (: (List Code)
(|> class-tvars
(list.filter free-type-param?)
@@ -1773,7 +1772,7 @@
getter-interop (with-gensyms [g!obj]
(let [getter-call (if import-field-static?
getter-name
- (` ((~ getter-name) (~@ g!obj))))
+ (` ((~ getter-name) (~ g!obj))))
getter-type (if import-field-setter?
(` (IO (~ typeC)))
typeC)
@@ -1785,7 +1784,7 @@
(with-mode-field-get import-field-mode import-field-type
(` ((~ (code.text (format "jvm getstatic" ":" full-name ":" import-field-name))))))
(with-mode-field-get import-field-mode import-field-type
- (` ((~ (code.text (format "jvm getfield" ":" full-name ":" import-field-name))) (~@ g!obj)))))
+ (` ((~ (code.text (format "jvm getfield" ":" full-name ":" import-field-name))) (~ g!obj)))))
getter-body (if import-field-maybe?
(` (??? (~ getter-body)))
getter-body)
@@ -1798,8 +1797,8 @@
setter-interop (if import-field-setter?
(with-gensyms [g!obj g!value]
(let [setter-call (if import-field-static?
- (` ((~ setter-name) (~@ g!value)))
- (` ((~ setter-name) (~@ g!value) (~@ g!obj))))
+ (` ((~ setter-name) (~ g!value)))
+ (` ((~ setter-name) (~ g!value) (~ g!obj))))
setter-type (if import-field-static?
(` (All [(~+ tvar-asts)] (-> (~ typeC) (IO Unit))))
(` (All [(~+ tvar-asts)] (-> (~ typeC) (~ classC) (IO Unit)))))
@@ -1981,8 +1980,8 @@
_
(with-gensyms [g!array]
- (wrap (list (` (let [(~@ g!array) (~ array)]
- (..array-read (~ idx) (~@ g!array)))))))))
+ (wrap (list (` (let [(~ g!array) (~ array)]
+ (..array-read (~ idx) (~ g!array)))))))))
(syntax: #export (array-write idx value array)
{#.doc (doc "Stores an element into an array."
@@ -2010,8 +2009,8 @@
_
(with-gensyms [g!array]
- (wrap (list (` (let [(~@ g!array) (~ array)]
- (..array-write (~ idx) (~ value) (~@ g!array)))))))))
+ (wrap (list (` (let [(~ g!array) (~ array)]
+ (..array-write (~ idx) (~ value) (~ g!array)))))))))
(def: simple-bindings^
(Syntax (List [Text Code]))
@@ -2035,9 +2034,9 @@
bindings)]
(wrap (list (` (do Monad
[(~+ inits)
- (~@ g!output) (~ body)
- (~' #let) [(~@ g!_) (exec (~+ (list.reverse closes)) [])]]
- ((~' wrap) (~@ g!output)))))))))
+ (~ g!output) (~ body)
+ (~' #let) [(~ g!_) (exec (~+ (list.reverse closes)) [])]]
+ ((~' wrap) (~ g!output)))))))))
(syntax: #export (class-for [#let [imports (class-imports *compiler*)]]
[type (generic-type^ imports (list))])
diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux
index 859bfe3e3..aa2429ae7 100644
--- a/stdlib/source/lux/macro.lux
+++ b/stdlib/source/lux/macro.lux
@@ -360,10 +360,10 @@
{#.doc "Generates a unique identifier as an Code node (ready to be used in code templates).
A prefix can be given (or just be empty text \"\") to better identify the code for debugging purposes."}
- (-> Text (Meta Ident))
+ (-> Text (Meta Code))
(function [compiler]
(#e.Success [(update@ #.seed n/inc compiler)
- ["" ($_ text/compose "__gensym__" prefix (:: number.Codec encode (get@ #.seed compiler)))]])))
+ (code.symbol ["" ($_ text/compose "__gensym__" prefix (:: number.Codec encode (get@ #.seed compiler)))])])))
(def: (get-local-symbol ast)
(-> Code (Meta Text))
@@ -378,11 +378,11 @@
{#.doc (doc "Creates new symbols and offers them to the body expression."
(syntax: #export (synchronized lock body)
(with-gensyms [g!lock g!body g!_]
- (wrap (list (` (let [(~@ g!lock) (~ lock)
- (~@ g!_) ("jvm monitorenter" (~ g!lock))
- (~@ g!body) (~ body)
- (~@ g!_) ("jvm monitorexit" (~ g!lock))]
- (~@ g!body)))))
+ (wrap (list (` (let [(~ g!lock) (~ lock)
+ (~ g!_) ("jvm monitorenter" (~ g!lock))
+ (~ g!body) (~ body)
+ (~ g!_) ("jvm monitorexit" (~ g!lock))]
+ (~ g!body)))))
)))}
(case tokens
(^ (list [_ (#.Tuple symbols)] body))
diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux
index 118723709..a14e415b4 100644
--- a/stdlib/source/lux/macro/poly.lux
+++ b/stdlib/source/lux/macro/poly.lux
@@ -352,21 +352,21 @@
[name s.local-symbol]
body)
(with-gensyms [g!type g!output]
- (let [g!name ["" name]]
- (wrap (.list (` (syntax: (~+ (csw.export export)) ((~@ g!name) [(~@ g!type) s.symbol])
+ (let [g!name (code.symbol ["" name])]
+ (wrap (.list (` (syntax: (~+ (csw.export export)) ((~ g!name) [(~ g!type) s.symbol])
(do macro.Monad
- [(~@ g!type) (macro.find-type-def (~@ g!type))]
+ [(~ g!type) (macro.find-type-def (~ g!type))]
(case (|> (~ body)
- (.function [(~@ g!name)])
+ (.function [(~ g!name)])
p.rec
(do p.Monad [])
- (..run (~@ g!type))
+ (..run (~ g!type))
(: (.Either .Text .Code)))
- (#.Left (~@ g!output))
- (macro.fail (~@ g!output))
+ (#.Left (~ g!output))
+ (macro.fail (~ g!output))
- (#.Right (~@ g!output))
- ((~' wrap) (.list (~@ g!output))))))))))))
+ (#.Right (~ g!output))
+ ((~' wrap) (.list (~ g!output))))))))))))
(def: (common-poly-name? poly-func)
(-> Text Bool)
diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux
index 3455a6672..3cb1fac1a 100644
--- a/stdlib/source/lux/macro/poly/json.lux
+++ b/stdlib/source/lux/macro/poly/json.lux
@@ -304,5 +304,5 @@
(with-gensyms [g!inputs]
(wrap (list (` (: (Codec //.JSON (~ inputT))
(struct (def: (~' encode) ((~! Codec//encode) (~ inputT)))
- (def: ((~' decode) (~@ g!inputs)) (//.run (~@ g!inputs) ((~! Codec//decode) (~ inputT))))
+ (def: ((~' decode) (~ g!inputs)) (//.run (~ g!inputs) ((~! Codec//decode) (~ inputT))))
)))))))
diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux
index 5cd68ccb9..e31b8c876 100644
--- a/stdlib/source/lux/macro/syntax.lux
+++ b/stdlib/source/lux/macro/syntax.lux
@@ -233,7 +233,7 @@
#.None))]
(case ?parts
(#.Some [name args meta body])
- (with-gensyms [g!text/join-with g!tokens g!body g!msg]
+ (with-gensyms [g!text/join-with g!tokens g!body g!error]
(do macro.Monad
[vars+parsers (monad.map @
(: (-> Code (Meta [Code Code]))
@@ -248,27 +248,27 @@
_
(macro.fail "Syntax pattern expects tuples or symbols."))))
args)
- #let [g!state ["" "*compiler*"]
+ #let [g!state (code.symbol ["" "*compiler*"])
error-msg (code.text (text/compose "Wrong syntax for " name))
export-ast (: (List Code)
(if exported?
(list (' #export))
(list)))]]
- (wrap (list (` (macro: (~+ export-ast) ((~ (code.symbol ["" name])) (~@ g!tokens) (~@ g!state))
+ (wrap (list (` (macro: (~+ export-ast) ((~ (code.symbol ["" name])) (~ g!tokens) (~ g!state))
(~ meta)
- ("lux case" (..run (~@ g!tokens)
+ ("lux case" (..run (~ g!tokens)
(: (Syntax (Meta (List Code)))
(do (~! p.Monad)
[(~+ (join-pairs vars+parsers))]
((~' wrap) (do (~! macro.Monad)
[]
(~ body))))))
- {(#E.Success (~@ g!body))
- ((~@ g!body) (~@ g!state))
+ {(#E.Success (~ g!body))
+ ((~ g!body) (~ g!state))
- (#E.Error (~@ g!msg))
- (let [(~@ g!text/join-with) (~! text.join-with)]
- (#E.Error ((~@ g!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/test.lux b/stdlib/source/lux/test.lux
index 57d5ae2f3..864dadfb0 100644
--- a/stdlib/source/lux/test.lux
+++ b/stdlib/source/lux/test.lux
@@ -183,15 +183,15 @@
(|> x (+ y) (- y) (= x)))))))
)}
(with-gensyms [g!context g!test g!error]
- (wrap (list (` (def: #export (~@ g!context)
+ (wrap (list (` (def: #export (~ g!context)
{#..test ((~! code.text) (~ description))}
(IO Test)
(io (case ("lux try" [(io (do (~! r.Monad) [] (~ test)))])
- (#.Right (~@ g!test))
- (~@ g!test)
+ (#.Right (~ g!test))
+ (~ g!test)
- (#.Left (~@ g!error))
- (..fail (~@ g!error))))))))))
+ (#.Left (~ g!error))
+ (..fail (~ g!error))))))))))
(def: (exported-tests module-name)
(-> Text (Meta (List [Text Text Text])))
@@ -227,25 +227,25 @@
groups (list.split-all promise.concurrency-level tests+)]]
(wrap (list (` (: (IO Unit)
(io (exec (do Monad
- [(~' #let) [(~@ g!total-successes) +0
- (~@ g!total-failures) +0]
+ [(~' #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))])))
+ (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) (~' compose))]
- (log! ($_ (~@ g!text/compose)
+ (exec (let [(~ g!text/compose) (:: (~! text.Monoid) (~' compose))]
+ (log! ($_ (~ g!text/compose)
"Test-suite finished."
"\n"
- ((~! %i) (nat-to-int (~@ g!total-successes)))
+ ((~! %i) (nat-to-int (~ g!total-successes)))
" out of "
- ((~! %i) (nat-to-int (n/+ (~@ g!total-failures)
- (~@ g!total-successes))))
+ ((~! %i) (nat-to-int (n/+ (~ g!total-failures)
+ (~ g!total-successes))))
" tests passed."
"\n"
- ((~! %i) (nat-to-int (~@ g!total-failures))) " tests failed.")))
- (promise.future (if (n/> +0 (~@ g!total-failures))
+ ((~! %i) (nat-to-int (~ g!total-failures))) " tests failed.")))
+ (promise.future (if (n/> +0 (~ g!total-failures))
(~! ..die)
(~! ..exit)))))
[])))))))))
diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux
index 4d9fc797c..7fe8d02d9 100644
--- a/stdlib/source/lux/type/implicit.lux
+++ b/stdlib/source/lux/type/implicit.lux
@@ -355,9 +355,7 @@
(#.Right [args _])
(do @
- [labels (|> (macro.gensym "") (list.repeat (list.size args)) (monad.seq @))
- #let [labels (list/map code.symbol labels)
- retry (` (let [(~+ (|> (list.zip2 labels args) (list/map join-pair) list/join))]
- (..::: (~ (code.symbol member)) (~+ labels))))]]
- (wrap (list retry)))
+ [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 d46dd59d3..d7ebb1e8c 100644
--- a/stdlib/source/lux/type/object.lux
+++ b/stdlib/source/lux/type/object.lux
@@ -85,15 +85,15 @@
s.any)))
(def: (declarationM g!self (^open))
- (-> Ident Method Code)
+ (-> Code Method Code)
(let [g!type-vars (list/map code.local-symbol type-vars)
g!method (code.local-symbol name)]
(` (: (All [(~+ g!type-vars)]
- (-> (~+ inputs) (~@ g!self) (~ output)))
+ (-> (~+ inputs) (~ g!self) (~ output)))
(~ g!method)))))
(def: (definition export [interface parameters] g!self-object g!ext g!states (^open))
- (-> Bool Declaration Code Ident (List Code) Method Code)
+ (-> Bool Declaration Code Code (List Code) Method Code)
(let [g!method (code.local-symbol name)
g!parameters (list/map code.local-symbol parameters)
g!type-vars (list/map code.local-symbol type-vars)
@@ -108,7 +108,7 @@
(` [(~ 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)]
+ (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)))))))
@@ -242,7 +242,7 @@
)
(def: (getterN export interface g!parameters g!ext g!child ancestors)
- (-> Bool Text (List Code) Ident Ident (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)]
- (-> (~ g!object) (~@ g!child)))
+ (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)
- (-> Bool Text (List Code) Ident Ident (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))
((~ g!set) (~ g!_input) (~ g!_object))
- (All [(~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child)]
- (-> (~@ g!child) (~ g!object) (~ g!object)))
+ (All [(~+ g!parameters) (~ g!ext) (~+ g!ancestors) (~ g!child)]
+ (-> (~ g!child) (~ g!object) (~ g!object)))
(let [(~ g!tear-down) (~ g!_object)]
(~ g!build-up))))))
(def: (updaterN export interface g!parameters g!ext g!child ancestors)
- (-> Bool Text (List Code) Ident Ident (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,15 +294,15 @@
g!_extension (' _extension)
g!_change (' _change)
g!ancestors (ancestor-inputs ancestors)
- g!object (` ((~ g!interface) (~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child)))
+ g!object (` ((~ g!interface) (~+ g!parameters) (~ g!ext) (~+ g!ancestors) (~ g!child)))
g!tear-down (nest g!ancestors
(` [(~ g!_behavior) (~ g!_state) (~ g!_extension)]))
g!build-up (nest g!ancestors
(` [(~ g!_behavior) ((~ g!_change) (~ g!_state)) (~ g!_extension)]))]
(` (def: (~+ (csw.export export))
((~ g!update) (~ g!_change) (~ g!_object))
- (All [(~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child)]
- (-> (-> (~@ g!child) (~@ g!child))
+ (All [(~+ g!parameters) (~ g!ext) (~+ g!ancestors) (~ g!child)]
+ (-> (-> (~ g!child) (~ g!child))
(-> (~ g!object) (~ g!object))))
(let [(~ g!tear-down) (~ g!_object)]
(~ g!build-up))))))
@@ -383,23 +383,23 @@
(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)]
+ (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)])))
+ (~ 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!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!child)
+ (~ g!ext)]
(~+ g!ancestors))))))]]
(wrap (list& (` (sig: (~+ (csw.export export))
- ((~ g!signature) (~+ g!parameters) (~@ g!self-class))
- (~+ (let [de-alias (code.replace (code.local-symbol alias) (code.symbol g!self-class))]
+ ((~ 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))
@@ -416,8 +416,8 @@
(updaterN export interface g!parameters g!ext g!child ancestors)
(let [g!ancestors (ancestor-inputs ancestors)
- g!states (list/compose g!ancestors (list (code.symbol 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)]
(list/map (|>> (update@ #inputs (list/map de-alias))
(update@ #output de-alias)
@@ -465,14 +465,14 @@
g!parent-structs (if (no-parent? parent)
(list)
(list/map (|>> (product.both id structN) code.symbol) (list& parent ancestors)))]
- g!parent-inits (monad.map @ (function [_] (:: @ map code.symbol (macro.gensym "parent-init")))
+ g!parent-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) []])
+ (` [(~ 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))]]
@@ -484,27 +484,27 @@
(~ (|> annotations
(with-class interface parent [module instance])
csw.annotations))
- (Ex [(~@ g!extension)]
+ (Ex [(~ g!extension)]
(~ (if (no-parent? parent)
(` ((~ g!interface) (~+ interface-mappings)
- (~@ g!extension)
+ (~ g!extension)
((~ g!state) (~+ g!parameters))))
(let [g!parent (code.symbol parent)]
(` ((~ g!parent) (~+ parent-mappings)
[((~ g!signature) (~+ interface-mappings) (~ g!recur))
((~ g!state) (~+ g!parameters))
- (~@ g!extension)]))))))))
+ (~ g!extension)]))))))))
(` (struct: (~+ (csw.export export)) (~ g!struct)
- (All [(~+ g!parameters) (~@ g!extension)]
+ (All [(~+ g!parameters) (~ g!extension)]
((~ g!signature) (~+ interface-mappings)
((~ g!interface) (~+ interface-mappings)
- (~@ g!extension)
+ (~ g!extension)
(~+ g!inheritance)
((~ g!state) (~+ g!parameters)))))
(~+ impls)))
- (` (def: (~+ (csw.export export)) ((~ g!new) (~+ g!parent-inits) (~@ g!init))
+ (` (def: (~+ (csw.export export)) ((~ g!new) (~+ g!parent-inits) (~ g!init))
(All [(~+ g!parameters)]
(-> (~+ g!inheritance)
((~ g!state) (~+ g!parameters))
--
cgit v1.2.3