From f92c4dc2f813b40f14d240491daa665942165e7e Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 2 Dec 2017 01:06:34 -0400
Subject: - Adjusted new-luxc to new macro-templating syntax.
---
new-luxc/source/luxc/lang/analysis.lux | 2 +-
new-luxc/source/luxc/lang/analysis/case.lux | 8 ++++----
.../source/luxc/lang/analysis/case/coverage.lux | 2 +-
new-luxc/source/luxc/lang/analysis/expression.lux | 2 +-
new-luxc/source/luxc/lang/analysis/function.lux | 2 +-
new-luxc/source/luxc/lang/analysis/structure.lux | 12 +++++------
new-luxc/source/luxc/lang/synthesis/case.lux | 2 +-
new-luxc/source/luxc/lang/synthesis/expression.lux | 20 +++++++++----------
new-luxc/source/luxc/lang/synthesis/loop.lux | 18 ++++++++---------
new-luxc/source/luxc/lang/translation.lux | 2 +-
new-luxc/source/luxc/lang/translation/eval.jvm.lux | 2 +-
.../luxc/lang/translation/expression.jvm.lux | 8 ++++----
.../luxc/lang/translation/procedure/common.jvm.lux | 23 +++++++++++-----------
.../source/luxc/lang/translation/structure.jvm.lux | 2 +-
14 files changed, 53 insertions(+), 52 deletions(-)
(limited to 'new-luxc/source')
diff --git a/new-luxc/source/luxc/lang/analysis.lux b/new-luxc/source/luxc/lang/analysis.lux
index 107d4979e..e33f51927 100644
--- a/new-luxc/source/luxc/lang/analysis.lux
+++ b/new-luxc/source/luxc/lang/analysis.lux
@@ -75,7 +75,7 @@
(def: #export (procedure name args)
(-> Text (List Analysis) Analysis)
- (` ((~ (code.text name)) (~@ args))))
+ (` ((~ (code.text name)) (~+ args))))
(def: #export (var idx)
(-> Variable Analysis)
diff --git a/new-luxc/source/luxc/lang/analysis/case.lux b/new-luxc/source/luxc/lang/analysis/case.lux
index 16f775907..c40bb2ac3 100644
--- a/new-luxc/source/luxc/lang/analysis/case.lux
+++ b/new-luxc/source/luxc/lang/analysis/case.lux
@@ -214,7 +214,7 @@
[nextA next]
(wrap [(list) nextA]))
(list.reverse matches))]
- (wrap [(` ("lux case tuple" [(~@ memberP+)]))
+ (wrap [(` ("lux case tuple" [(~+ memberP+)]))
thenA])))
_
@@ -250,12 +250,12 @@
(do macro.Monad
[[testP nextA] (analyse-pattern #.None
(type.variant (list.drop (n/dec num-cases) flat-sum))
- (` [(~@ values)])
+ (` [(~+ values)])
next)]
(wrap [(` ("lux case variant" (~ (code.nat idx)) (~ (code.nat num-cases)) (~ testP)))
nextA]))
(do macro.Monad
- [[testP nextA] (analyse-pattern #.None case-type (` [(~@ values)]) next)]
+ [[testP nextA] (analyse-pattern #.None case-type (` [(~+ values)]) next)]
(wrap [(` ("lux case variant" (~ (code.nat idx)) (~ (code.nat num-cases)) (~ testP)))
nextA])))
@@ -274,7 +274,7 @@
[idx group variantT] (macro.resolve-tag tag)
_ (&.with-type-env
(tc.check inputT variantT))]
- (analyse-pattern (#.Some (list.size group)) inputT (` ((~ (code.nat idx)) (~@ values))) next)))
+ (analyse-pattern (#.Some (list.size group)) inputT (` ((~ (code.nat idx)) (~+ values))) next)))
_
(&.throw Unrecognized-Pattern-Syntax (%code pattern))
diff --git a/new-luxc/source/luxc/lang/analysis/case/coverage.lux b/new-luxc/source/luxc/lang/analysis/case/coverage.lux
index 5d34387b4..ae72b47e4 100644
--- a/new-luxc/source/luxc/lang/analysis/case/coverage.lux
+++ b/new-luxc/source/luxc/lang/analysis/case/coverage.lux
@@ -71,7 +71,7 @@
## Tuple patterns can be exhaustive if there is exhaustiveness for all of
## their sub-patterns.
- (^code ("lux case tuple" [(~@ subs)]))
+ (^code ("lux case tuple" [(~+ subs)]))
(loop [subs subs]
(case subs
#.Nil
diff --git a/new-luxc/source/luxc/lang/analysis/expression.lux b/new-luxc/source/luxc/lang/analysis/expression.lux
index 0f3cdcf6e..1463e7ec5 100644
--- a/new-luxc/source/luxc/lang/analysis/expression.lux
+++ b/new-luxc/source/luxc/lang/analysis/expression.lux
@@ -74,7 +74,7 @@
( analyse tag value)
_
- ( analyse tag (` [(~@ values)]))))
+ ( analyse tag (` [(~+ values)]))))
([#.Nat structureA.analyse-sum]
[#.Tag structureA.analyse-tagged-sum])
diff --git a/new-luxc/source/luxc/lang/analysis/function.lux b/new-luxc/source/luxc/lang/analysis/function.lux
index 758acd681..a502a9d19 100644
--- a/new-luxc/source/luxc/lang/analysis/function.lux
+++ b/new-luxc/source/luxc/lang/analysis/function.lux
@@ -74,7 +74,7 @@
(#.Function inputT outputT)
(<| (:: @ map (function [[scope bodyA]]
- (` ("lux function" [(~@ (list/map code.int (variableL.environment scope)))]
+ (` ("lux function" [(~+ (list/map code.int (variableL.environment scope)))]
(~ bodyA)))))
&.with-scope
## Functions have access not only to their argument, but
diff --git a/new-luxc/source/luxc/lang/analysis/structure.lux b/new-luxc/source/luxc/lang/analysis/structure.lux
index fb521d02e..4561388c9 100644
--- a/new-luxc/source/luxc/lang/analysis/structure.lux
+++ b/new-luxc/source/luxc/lang/analysis/structure.lux
@@ -159,9 +159,9 @@
(do @
[g!tail (macro.gensym "tail")]
(&.with-type tailT
- (analyse (` ("lux case" [(~@ tailC)]
- (~ g!tail)
- (~ g!tail))))))
+ (analyse (` ("lux case" [(~+ tailC)]
+ (~@ g!tail)
+ (~@ g!tail))))))
))))
(def: #export (analyse-product analyse membersC)
@@ -170,7 +170,7 @@
[expectedT macro.expected-type]
(&.with-stacked-errors
(function [_] (Cannot-Analyse-Tuple (format " Type: " (%type expectedT) "\n"
- "Expression: " (%code (` [(~@ membersC)])))))
+ "Expression: " (%code (` [(~+ membersC)])))))
(case expectedT
(#.Product _)
(analyse-typed-product analyse membersC)
@@ -219,7 +219,7 @@
_
(&.throw Invalid-Tuple-Type (format " Type: " (%type expectedT) "\n"
- "Expression: " (%code (` [(~@ membersC)]))))))
+ "Expression: " (%code (` [(~+ membersC)]))))))
_
(case (type.apply (list inputT) funT)
@@ -232,7 +232,7 @@
_
(&.throw Invalid-Tuple-Type (format " Type: " (%type expectedT) "\n"
- "Expression: " (%code (` [(~@ membersC)]))))
+ "Expression: " (%code (` [(~+ membersC)]))))
))))
(def: #export (analyse-tagged-sum analyse tag valueC)
diff --git a/new-luxc/source/luxc/lang/synthesis/case.lux b/new-luxc/source/luxc/lang/synthesis/case.lux
index ab4820b30..3e57de337 100644
--- a/new-luxc/source/luxc/lang/synthesis/case.lux
+++ b/new-luxc/source/luxc/lang/synthesis/case.lux
@@ -16,7 +16,7 @@
(def: (path' arity num-locals pattern)
(-> ls.Arity Nat la.Pattern [Nat (List ls.Path)])
(case pattern
- (^code ("lux case tuple" [(~@ membersP)]))
+ (^code ("lux case tuple" [(~+ membersP)]))
(case membersP
#.Nil
[num-locals
diff --git a/new-luxc/source/luxc/lang/synthesis/expression.lux b/new-luxc/source/luxc/lang/synthesis/expression.lux
index d3fbfcb58..b31a146a1 100644
--- a/new-luxc/source/luxc/lang/synthesis/expression.lux
+++ b/new-luxc/source/luxc/lang/synthesis/expression.lux
@@ -40,7 +40,7 @@
(def: (function$ arity environment body)
(-> ls.Arity (List Variable) ls.Synthesis ls.Synthesis)
(` ("lux function" (~ (code.nat arity))
- [(~@ (list/map code.int environment))]
+ [(~+ (list/map code.int environment))]
(~ body))))
(def: (variant$ tag last? valueS)
@@ -53,11 +53,11 @@
(def: (procedure$ name argsS)
(-> Text (List ls.Synthesis) ls.Synthesis)
- (` ((~ (code.text name)) (~@ argsS))))
+ (` ((~ (code.text name)) (~+ argsS))))
(def: (call$ funcS argsS)
(-> ls.Synthesis (List ls.Synthesis) ls.Synthesis)
- (` ("lux call" (~ funcS) (~@ argsS))))
+ (` ("lux call" (~ funcS) (~+ argsS))))
(def: (synthesize-case arity num-locals synthesize inputA branchesA)
(-> ls.Arity Nat (-> Nat la.Analysis ls.Synthesis)
@@ -100,14 +100,14 @@
funcS (synthesize funcA)
argsS (list/map synthesize argsA)]
(case funcS
- (^multi (^code ("lux function" (~ [_ (#.Nat _arity)]) [(~@ _env)] (~ _bodyS)))
+ (^multi (^code ("lux function" (~ [_ (#.Nat _arity)]) [(~+ _env)] (~ _bodyS)))
(and (n/= _arity (list.size argsS))
(not (loopS.contains-self-reference? _bodyS)))
[(s.run _env (p.some s.int)) (#e.Success _env)])
- (` ("lux loop" (~ (code.nat (n/inc num-locals))) [(~@ argsS)]
+ (` ("lux loop" (~ (code.nat (n/inc num-locals))) [(~+ argsS)]
(~ (loopS.adjust _env num-locals _bodyS))))
- (^code ("lux call" (~ funcS') (~@ argsS')))
+ (^code ("lux call" (~ funcS') (~+ argsS')))
(call$ funcS' (list/compose argsS' argsS))
_
@@ -122,7 +122,7 @@
expressionA expressionA]
(case expressionA
(^code [(~ _left) (~ _right)])
- (` [(~@ (list/map (recur arity resolver false num-locals)
+ (` [(~+ (list/map (recur arity resolver false num-locals)
(la.unfold-tuple expressionA)))])
(^or (^code ("lux sum left" (~ _)))
@@ -143,7 +143,7 @@
(^code ("lux case" (~ inputA) (~ [_ (#.Record branchesA)])))
(synthesize-case arity num-locals (recur arity resolver false) inputA branchesA)
- (^multi (^code ("lux function" [(~@ scope)] (~ bodyA)))
+ (^multi (^code ("lux function" [(~+ scope)] (~ bodyA)))
[(s.run scope (p.some s.int)) (#e.Success raw-env)])
(let [function-arity (if direct?
(n/inc arity)
@@ -186,10 +186,10 @@
bodyS
(function$ +1 env (prepare-body function-arity +1 bodyS))))
- (^code ("lux apply" (~@ _)))
+ (^code ("lux apply" (~+ _)))
(synthesize-apply (recur arity resolver false num-locals) num-locals expressionA)
- (^code ((~ [_ (#.Text name)]) (~@ args)))
+ (^code ((~ [_ (#.Text name)]) (~+ args)))
(procedure$ name (list/map (recur arity resolver false num-locals) args))
_
diff --git a/new-luxc/source/luxc/lang/synthesis/loop.lux b/new-luxc/source/luxc/lang/synthesis/loop.lux
index 0510e2377..762032a59 100644
--- a/new-luxc/source/luxc/lang/synthesis/loop.lux
+++ b/new-luxc/source/luxc/lang/synthesis/loop.lux
@@ -96,7 +96,7 @@
[_ (#.Form (list [_ (#.Int 0)]))]
argsS))])
(n/= arity (list.size argsS)))
- (` ("lux recur" (~@ argsS)))
+ (` ("lux recur" (~+ argsS)))
(^ [_ (#.Form (list [_ (#.Text "lux let")] register inputS bodyS))])
(` ("lux let" (~ register) (~ inputS) (~ (recur bodyS))))
@@ -119,8 +119,8 @@
(^code ((~ [_ (#.Nat tag)]) (~ last?) (~ valueS)))
(` ((~ (code.nat tag)) (~ last?) (~ (recur valueS))))
- (^code [(~@ members)])
- (` [(~@ (list/map recur members))])
+ (^code [(~+ members)])
+ (` [(~+ (list/map recur members))])
(^code ("lux case" (~ inputS) (~ pathS)))
(` ("lux case" (~ (recur inputS))
@@ -142,9 +142,9 @@
_
pathS))))))
- (^code ("lux function" (~ arity) [(~@ environment)] (~ bodyS)))
+ (^code ("lux function" (~ arity) [(~+ environment)] (~ bodyS)))
(` ("lux function" (~ arity)
- [(~@ (list/map (function [_var]
+ [(~+ (list/map (function [_var]
(case _var
(^ [_ (#.Form (list [_ (#.Int var)]))])
(` ((~ (code.int (resolve-captured var)))))
@@ -155,10 +155,10 @@
(~ bodyS)))
(^ [_ (#.Form (list& [_ (#.Text "lux call")] funcS argsS))])
- (` ("lux call" (~ (recur funcS)) (~@ (list/map recur argsS))))
+ (` ("lux call" (~ (recur funcS)) (~+ (list/map recur argsS))))
(^ [_ (#.Form (list& [_ (#.Text "lux recur")] argsS))])
- (` ("lux recur" (~@ (list/map recur argsS))))
+ (` ("lux recur" (~+ (list/map recur argsS))))
(^code ("lux let" (~ [_ (#.Nat register)]) (~ inputS) (~ bodyS)))
(` ("lux let" (~ (code.nat (n/+ offset register)))
@@ -172,7 +172,7 @@
(^ [_ (#.Form (list [_ (#.Text "lux loop")] [_ (#.Nat loop-offset)] [_ (#.Tuple initsS)] bodyS))])
(` ("lux loop" (~ (code.nat (n/+ offset loop-offset)))
- [(~@ (list/map recur initsS))]
+ [(~+ (list/map recur initsS))]
(~ (recur bodyS))))
(^ [_ (#.Form (list [_ (#.Int var)]))])
@@ -181,7 +181,7 @@
(` ((~ (code.int (|> offset nat-to-int (i/+ var)))))))
(^ [_ (#.Form (list& [_ (#.Text procedure)] argsS))])
- (` ((~ (code.text procedure)) (~@ (list/map recur argsS))))
+ (` ((~ (code.text procedure)) (~+ (list/map recur argsS))))
_
exprS
diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux
index 07f1fe533..71bef93a2 100644
--- a/new-luxc/source/luxc/lang/translation.lux
+++ b/new-luxc/source/luxc/lang/translation.lux
@@ -72,7 +72,7 @@
(def: #export (translate translate-module aliases code)
(-> (-> Text Compiler (Process Compiler)) Aliases Code (Meta Aliases))
(case code
- (^code ((~ [_ (#.Symbol macro-name)]) (~@ args)))
+ (^code ((~ [_ (#.Symbol macro-name)]) (~+ args)))
(do macro.Monad
[?macro (&.with-error-tracking
(macro.find-macro macro-name))]
diff --git a/new-luxc/source/luxc/lang/translation/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/eval.jvm.lux
index 9cce16a49..2236815ea 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 (:: @ map %code (macro.gensym (format current-module "/eval")))
+ [_ class-name] (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/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/expression.jvm.lux
index c75ef0a19..4496de784 100644
--- a/new-luxc/source/luxc/lang/translation/expression.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/expression.jvm.lux
@@ -44,7 +44,7 @@
(^code ((~ [_ (#.Nat tag)]) (~ [_ (#.Bool last?)]) (~ valueS)))
(structureT.translate-variant translate tag last? valueS)
- (^code [(~@ members)])
+ (^code [(~+ members)])
(structureT.translate-tuple translate members)
(^ [_ (#.Form (list [_ (#.Int var)]))])
@@ -61,14 +61,14 @@
(^code ("lux case" (~ inputS) (~ pathPS)))
(caseT.translate-case translate inputS pathPS)
- (^multi (^code ("lux function" (~ [_ (#.Nat arity)]) [(~@ environment)] (~ bodyS)))
+ (^multi (^code ("lux function" (~ [_ (#.Nat arity)]) [(~+ environment)] (~ bodyS)))
[(s.run environment (p.some s.int)) (#e.Success environment)])
(functionT.translate-function translate environment arity bodyS)
- (^code ("lux call" (~ functionS) (~@ argsS)))
+ (^code ("lux call" (~ functionS) (~+ argsS)))
(functionT.translate-call translate functionS argsS)
- (^code ((~ [_ (#.Text procedure)]) (~@ argsS)))
+ (^code ((~ [_ (#.Text procedure)]) (~+ argsS)))
(procedureT.translate-procedure translate procedure argsS)
_
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 41d9b91ab..91c5c5f95 100644
--- a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
@@ -47,7 +47,7 @@
(Dict Text Proc))
(syntax: (Vector [size s.nat] elemT)
- (wrap (list (` [(~@ (list.repeat size elemT))]))))
+ (wrap (list (` [(~+ (list.repeat size elemT))]))))
(type: #export Nullary (-> (Vector +0 $.Inst) $.Inst))
(type: #export Unary (-> (Vector +1 $.Inst) $.Inst))
@@ -84,23 +84,24 @@
(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")))]
- (wrap (list (` (def: #export ((~ (code.local-symbol name)) (~ g!proc))
+ [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))
(-> (-> (..Vector (~ (code.nat arity)) $.Inst) $.Inst)
(-> Text ..Proc))
- (function [(~ g!name)]
- (function [(~ g!translate) (~ g!inputs)]
- (case (~ g!inputs)
- (^ (list (~@ g!input+)))
+ (function [(~@ g!name)]
+ (function [(~@ g!translate) (~@ g!inputs)]
+ (case (~@ g!inputs)
+ (^ (list (~+ g!input+)))
(do macro.Monad
- [(~@ (|> g!input+
+ [(~+ (|> 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/new-luxc/source/luxc/lang/translation/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/structure.jvm.lux
index 9a78be78e..f7cdb524f 100644
--- a/new-luxc/source/luxc/lang/translation/structure.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/structure.jvm.lux
@@ -24,7 +24,7 @@
(-> (-> ls.Synthesis (Meta $.Inst)) (List ls.Synthesis) (Meta $.Inst))
(do macro.Monad
[#let [size (list.size members)]
- _ (&.assert Not-A-Tuple (%code (` [(~@ members)]))
+ _ (&.assert Not-A-Tuple (%code (` [(~+ members)]))
(n/>= +2 size))
membersI (|> members
list.enumerate
--
cgit v1.2.3