aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2017-10-30 23:55:33 -0400
committerEduardo Julian2017-10-30 23:55:33 -0400
commite35f31c170be160b30f22eae22871eba74db2767 (patch)
treeb73d58f00056c26996d5479370f82f485abdf827
parenta12eb1ae67e36ee12dd434da948a25b6b18e34d6 (diff)
- Added "^code" pattern-matching macro for easier handling of code.
-rw-r--r--lux-mode/lux-mode.el2
-rw-r--r--new-luxc/source/luxc/generator/expr.jvm.lux20
-rw-r--r--stdlib/source/lux.lux76
3 files changed, 87 insertions, 11 deletions
diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el
index ed440db65..558cf92f6 100644
--- a/lux-mode/lux-mode.el
+++ b/lux-mode/lux-mode.el
@@ -231,7 +231,7 @@ Called by `imenu--generic-function'."
"list" "list&" "io" "sequence" "tree"
"get@" "set@" "update@" "|>" "|>." "<|" "<|." "_$" "$_" "~" "~@" "~'" "::" ":::"
"|" "&" "->" "All" "Ex" "Rec" "primitive" "$" "type"
- "^" "^or" "^slots" "^multi" "^~" "^@" "^template" "^open" "^|>" "^stream&" "^regex"
+ "^" "^or" "^slots" "^multi" "^~" "^@" "^template" "^open" "^|>" "^code" "^stream&" "^regex"
"bin" "oct" "hex"
"pre" "post"
"sig" "struct" "derive"
diff --git a/new-luxc/source/luxc/generator/expr.jvm.lux b/new-luxc/source/luxc/generator/expr.jvm.lux
index b439ff17a..61120ef86 100644
--- a/new-luxc/source/luxc/generator/expr.jvm.lux
+++ b/new-luxc/source/luxc/generator/expr.jvm.lux
@@ -27,10 +27,10 @@
(def: #export (generate synthesis)
(-> ls;Synthesis (Meta $;Inst))
(case synthesis
- [_ (#;Tuple #;Nil)]
+ (^code [])
&primitive;generate-unit
- (^ [_ (#;Tuple (list singleton))])
+ (^code [(~ singleton)])
(generate singleton)
(^template [<tag> <generator>]
@@ -43,10 +43,10 @@
[#;Frac &primitive;generate-frac]
[#;Text &primitive;generate-text])
- (^ [_ (#;Form (list [_ (#;Nat tag)] [_ (#;Bool last?)] valueS))])
+ (^code ((~ [_ (#;Nat tag)]) (~ [_ (#;Bool last?)]) (~ valueS)))
(&structure;generate-variant generate tag last? valueS)
-
- [_ (#;Tuple members)]
+
+ (^code [(~@ members)])
(&structure;generate-tuple generate members)
(^ [_ (#;Form (list [_ (#;Int var)]))])
@@ -57,20 +57,20 @@
[_ (#;Symbol definition)]
(&reference;generate-definition definition)
- (^ [_ (#;Form (list [_ (#;Text "lux let")] [_ (#;Nat register)] inputS exprS))])
+ (^code ("lux let" (~ [_ (#;Nat register)]) (~ inputS) (~ exprS)))
(caseG;generate-let generate register inputS exprS)
- (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathPS))])
+ (^code ("lux case" (~ inputS) (~ pathPS)))
(caseG;generate-case generate inputS pathPS)
- (^multi (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat arity)] [_ (#;Tuple environment)] bodyS))])
+ (^multi (^code ("lux function" (~ [_ (#;Nat arity)]) [(~@ environment)] (~ bodyS)))
[(s;run environment (p;some s;int)) (#e;Success environment)])
(&function;generate-function generate environment arity bodyS)
- (^ [_ (#;Form (list& [_ (#;Text "lux call")] functionS argsS))])
+ (^code ("lux call" (~ functionS) (~@ argsS)))
(&function;generate-call generate functionS argsS)
- (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))])
+ (^code ((~ [_ (#;Text procedure)]) (~@ argsS)))
(&procedure;generate-procedure generate procedure argsS)
_
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index bf77ca259..e3a81cebd 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -5973,3 +5973,79 @@
_
(fail "Wrong syntax for ``")
))
+
+(def: (ident$ [module name])
+ (-> Ident Code)
+ (` [(~ (text$ module)) (~ (text$ name))]))
+
+(def: (untemplate-list& last inits)
+ (-> Code (List Code) Code)
+ (case inits
+ #Nil
+ last
+
+ (#Cons [init inits'])
+ (` (#;Cons (~ init) (~ (untemplate-list& last inits'))))))
+
+(def: (untemplate-pattern pattern)
+ (-> Code (Meta Code))
+ (case pattern
+ (^template [<tag> <name> <gen>]
+ [_ (<tag> value)]
+ (do Monad<Meta>
+ [g!meta (gensym "g!meta")]
+ (wrap (` [(~ g!meta) (<tag> (~ (<gen> value)))]))))
+ ([#Bool "Bool" bool$]
+ [#Nat "Nat" nat$]
+ [#Int "Int" int$]
+ [#Deg "Deg" deg$]
+ [#Frac "Frac" frac$]
+ [#Text "Text" text$]
+ [#Tag "Tag" ident$]
+ [#Symbol "Symbol" ident$])
+
+ [_ (#Record fields)]
+ (do Monad<Meta>
+ [=fields (mapM Monad<Meta>
+ (function [[key value]]
+ (do Monad<Meta>
+ [=key (untemplate-pattern key)
+ =value (untemplate-pattern value)]
+ (wrap (` [(~ =key) (~ =value)]))))
+ fields)
+ g!meta (gensym "g!meta")]
+ (wrap (` [(~ g!meta) (#;Record (~ (untemplate-list =fields)))])))
+
+ [_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))]
+ (:: Monad<Meta> wrap 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.")
+
+ (^template [<tag>]
+ [_ (<tag> elems)]
+ (case (reverse elems)
+ (#;Cons [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))]
+ inits)
+ (do Monad<Meta>
+ [=inits (mapM Monad<Meta> untemplate-pattern (reverse inits))
+ g!meta (gensym "g!meta")]
+ (wrap (` [(~ g!meta) (<tag> (~ (untemplate-list& spliced =inits)))])))
+
+ _
+ (do Monad<Meta>
+ [=elems (mapM Monad<Meta> untemplate-pattern elems)
+ g!meta (gensym "g!meta")]
+ (wrap (` [(~ g!meta) (<tag> (~ (untemplate-list =elems)))])))))
+ ([#;Tuple] [#;Form])
+ ))
+
+(macro: #export (^code tokens)
+ (case tokens
+ (^ (list& [_meta (#;Form (list template))] body branches))
+ (do Monad<Meta>
+ [pattern (untemplate-pattern template)]
+ (wrap (list& pattern body branches)))
+
+ _
+ (fail "Wrong syntax for ^code")))