diff options
Diffstat (limited to '')
| -rw-r--r-- | lux-mode/lux-mode.el | 2 | ||||
| -rw-r--r-- | new-luxc/source/luxc/generator/expr.jvm.lux | 20 | ||||
| -rw-r--r-- | stdlib/source/lux.lux | 76 |
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"))) |