diff options
author | Eduardo Julian | 2015-07-19 22:24:48 -0400 |
---|---|---|
committer | Eduardo Julian | 2015-07-19 22:24:48 -0400 |
commit | 50366bad3ecf961fdfdbb1e4d8436794d97ae763 (patch) | |
tree | 3c911205244647bb923b2b1868cc8b1d36a083a4 /input/lux.lux | |
parent | eb424eeb33d8fc9bb7ad2acda0c58fcb037717d3 (diff) |
- Some bug fixes.
- More additions to the standard library.
Diffstat (limited to '')
-rw-r--r-- | input/lux.lux | 293 |
1 files changed, 158 insertions, 135 deletions
diff --git a/input/lux.lux b/input/lux.lux index 2bad33439..0c8b73c34 100644 --- a/input/lux.lux +++ b/input/lux.lux @@ -10,15 +10,6 @@ (_jvm_interface "Function" [] (apply ["java.lang.Object"] "java.lang.Object" ["public" "abstract"])) -## (_jvm_class "lux.MyFunction" "java.lang.Object" ["lux.Function"] -## [(foo "java.lang.Object" ["public" "static"])] -## (<init> [] "void" -## ["public"] -## (_jvm_invokespecial java.lang.Object <init> [] this [])) -## (apply [(arg "java.lang.Object")] "java.lang.Object" -## ["public"] -## "YOLO")) - ## Basic types (_lux_def Bool (#DataT "java.lang.Boolean")) (_lux_export Bool) @@ -35,6 +26,9 @@ (_lux_def Text (#DataT "java.lang.String")) (_lux_export Text) +(_lux_def Unit (#TupleT #Nil)) +(_lux_export Unit) + (_lux_def Void (#VariantT #Nil)) (_lux_export Void) @@ -105,6 +99,7 @@ (#Cons [(#BoundT "v") #Nil])]))])] #Nil])]))])])) +(_lux_export Bindings) ## (deftype (Env k v) ## (& #name Text @@ -121,6 +116,7 @@ (#Cons [["lux;closure" (#AppT [(#AppT [Bindings (#BoundT "k")]) (#BoundT "v")])] #Nil])])])]))])])) +(_lux_export Env) ## (deftype Cursor ## (, Text Int Int)) @@ -855,7 +851,7 @@ (wrap-meta (form$ (list (tag$ ["lux" "SymbolS"]) (tuple$ (list (text$ module') (text$ name))))))) [_ (#Meta [_ (#TupleS elems)])] - (splice (untemplate replace? subst) (tag$ ["lux" "TupleS"]) elems) + (splice replace? (untemplate replace? subst) (tag$ ["lux" "TupleS"]) elems) [true (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~"])]) (#Cons [unquoted #Nil])]))])] unquoted @@ -937,7 +933,7 @@ ($' (B' m) (B' a)) ($' (B' m) (B' b))))])))) -(def'' Maybe:Monad +(def'' Maybe/Monad ($' Monad Maybe) {#lux;return (lambda return [x] @@ -949,7 +945,7 @@ #None #None (#Some a) (f a)))}) -(def'' Lux:Monad +(def'' Lux/Monad ($' Monad Lux) {#lux;return (lambda [x] @@ -1126,8 +1122,8 @@ (_lux_case tokens (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [(#Meta [_ (#TupleS templates)]) data])]) (_lux_case (_lux_: (, ($' Maybe ($' List Text)) ($' Maybe ($' List ($' List Syntax)))) - [(map% Maybe:Monad get-ident bindings) - (map% Maybe:Monad tuple->list data)]) + [(map% Maybe/Monad get-ident bindings) + (map% Maybe/Monad tuple->list data)]) [(#Some bindings') (#Some data')] (let [apply (_lux_: (-> RepEnv ($' List Syntax)) (lambda [env] (map (apply-template env) templates)))] @@ -1146,12 +1142,12 @@ (-> <type> <type> Bool) (<cmp> x y))] - [int:= _jvm_leq Int] - [int:> _jvm_lgt Int] - [int:< _jvm_llt Int] - [real:= _jvm_deq Real] - [real:> _jvm_dgt Real] - [real:< _jvm_dlt Real] + [i= _jvm_leq Int] + [i> _jvm_lgt Int] + [i< _jvm_llt Int] + [r= _jvm_deq Real] + [r> _jvm_dgt Real] + [r< _jvm_dlt Real] ) (do-template [<name> <cmp> <eq> <type>] @@ -1161,10 +1157,10 @@ true (<eq> x y)))] - [ int:>= int:> int:= Int] - [ int:<= int:< int:= Int] - [real:>= real:> real:= Real] - [real:<= real:< real:= Real] + [i>= i> i= Int] + [i<= i< i= Int] + [r>= r> r= Real] + [r<= r< r= Real] ) (do-template [<name> <cmp> <type>] @@ -1172,25 +1168,25 @@ (-> <type> <type> <type>) (<cmp> x y))] - [int:+ _jvm_ladd Int] - [int:- _jvm_lsub Int] - [int:* _jvm_lmul Int] - [int:/ _jvm_ldiv Int] - [int:% _jvm_lrem Int] - [real:+ _jvm_dadd Real] - [real:- _jvm_dsub Real] - [real:* _jvm_dmul Real] - [real:/ _jvm_ddiv Real] - [real:% _jvm_drem Real] + [i+ _jvm_ladd Int] + [i- _jvm_lsub Int] + [i* _jvm_lmul Int] + [i/ _jvm_ldiv Int] + [i% _jvm_lrem Int] + [r+ _jvm_dadd Real] + [r- _jvm_dsub Real] + [r* _jvm_dmul Real] + [r/ _jvm_ddiv Real] + [r% _jvm_drem Real] ) (def'' (multiple? div n) (-> Int Int Bool) - (int:= 0 (int:% n div))) + (i= 0 (i% n div))) (def'' (length list) (-> List Int) - (foldL (lambda [acc _] (int:+ 1 acc)) 0 list)) + (foldL (lambda [acc _] (i+ 1 acc)) 0 list)) (def'' #export (not x) (-> Bool Bool) @@ -1244,7 +1240,7 @@ ["" tokens]))] (_lux_case tokens' (#Cons [(#Meta [_ (#TupleS args)]) (#Cons [body #Nil])]) - (_lux_case (map% Maybe:Monad get-ident args) + (_lux_case (map% Maybe/Monad get-ident args) (#Some idents) (_lux_case idents #Nil @@ -1309,7 +1305,7 @@ (-> ($' List (, Text ($' Module Compiler))) Text Text Text ($' Maybe Macro)) - (do Maybe:Monad + (do Maybe/Monad [$module (get module modules) gdef (let [{#module-aliases _ #defs bindings #imports _} (_lux_: ($' Module Compiler) $module)] (get name bindings))] @@ -1329,7 +1325,7 @@ (def'' (find-macro ident) (-> Ident ($' Lux ($' Maybe Macro))) - (do Lux:Monad + (do Lux/Monad [current-module get-module-name] (let [[module name] ident] (lambda [state] @@ -1348,7 +1344,7 @@ (-> Ident ($' Lux Ident)) (_lux_case ident ["" name] - (do Lux:Monad + (do Lux/Monad [module-name get-module-name] (;return (_lux_: Ident [module-name name]))) @@ -1356,18 +1352,18 @@ (return ident))) (defmacro #export (| tokens) - (do Lux:Monad - [pairs (map% Lux:Monad + (do Lux/Monad + [pairs (map% Lux/Monad (_lux_: (-> Syntax ($' Lux Syntax)) (lambda [token] (_lux_case token (#Meta [_ (#TagS ident)]) - (do Lux:Monad + (do Lux/Monad [ident (normalize ident)] (;return (`' [(~ (text$ (ident->text ident))) (;,)]))) (#Meta [_ (#FormS (#Cons [(#Meta [_ (#TagS ident)]) (#Cons [value #Nil])]))]) - (do Lux:Monad + (do Lux/Monad [ident (normalize ident)] (;return (`' [(~ (text$ (ident->text ident))) (~ value)]))) @@ -1379,13 +1375,13 @@ (defmacro #export (& tokens) (if (not (multiple? 2 (length tokens))) (fail "& expects an even number of arguments.") - (do Lux:Monad - [pairs (map% Lux:Monad + (do Lux/Monad + [pairs (map% Lux/Monad (_lux_: (-> (, Syntax Syntax) ($' Lux Syntax)) (lambda [pair] (_lux_case pair [(#Meta [_ (#TagS ident)]) value] - (do Lux:Monad + (do Lux/Monad [ident (normalize ident)] (;return (`' [(~ (text$ (ident->text ident))) (~ value)]))) @@ -1415,30 +1411,30 @@ (-> Syntax ($' Lux ($' List Syntax))) (_lux_case syntax (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS macro-name)]) args]))]) - (do Lux:Monad + (do Lux/Monad [macro-name' (normalize macro-name) ?macro (find-macro macro-name')] (_lux_case ?macro (#Some macro) - (do Lux:Monad + (do Lux/Monad [expansion (macro args) - expansion' (map% Lux:Monad macro-expand expansion)] + expansion' (map% Lux/Monad macro-expand expansion)] (;return (list:join expansion'))) #None - (do Lux:Monad - [parts' (map% Lux:Monad macro-expand (list& (symbol$ macro-name) args))] + (do Lux/Monad + [parts' (map% Lux/Monad macro-expand (list& (symbol$ macro-name) args))] (;return (list (form$ (list:join parts'))))))) (#Meta [_ (#FormS (#Cons [harg targs]))]) - (do Lux:Monad + (do Lux/Monad [harg+ (macro-expand harg) - targs+ (map% Lux:Monad macro-expand targs)] + targs+ (map% Lux/Monad macro-expand targs)] (;return (list (form$ (list:++ harg+ (list:join targs+)))))) (#Meta [_ (#TupleS members)]) - (do Lux:Monad - [members' (map% Lux:Monad macro-expand members)] + (do Lux/Monad + [members' (map% Lux/Monad macro-expand members)] (;return (list (tuple$ (list:join members'))))) _ @@ -1464,7 +1460,7 @@ (defmacro #export (type tokens) (_lux_case tokens (#Cons [type #Nil]) - (do Lux:Monad + (do Lux/Monad [type+ (macro-expand type)] (_lux_case type+ (#Cons [type' #Nil]) @@ -1494,12 +1490,12 @@ (defmacro #export (deftype tokens) (let [[export? tokens'] (: (, Bool (List Syntax)) - (_lux_case tokens + (_lux_case (:! (List Syntax) tokens) (#Cons [(#Meta [_ (#TagS ["" "export"])]) tokens']) - [true tokens'] + [true (:! (List Syntax) tokens')] _ - [false tokens])) + [false (:! (List Syntax) tokens)])) parts (: (Maybe (, Syntax (List Syntax) Syntax)) (_lux_case tokens' (#Cons [(#Meta [_ (#SymbolS name)]) (#Cons [type #Nil])]) @@ -1597,20 +1593,20 @@ (defmacro #export (case tokens) (_lux_case tokens (#Cons [value branches]) - (do Lux:Monad - [expansions (map% Lux:Monad + (do Lux/Monad + [expansions (map% Lux/Monad (: (-> (, Syntax Syntax) (Lux (List (, Syntax Syntax)))) (lambda expander [branch] - (let [[pattern body] branch] - (_lux_case pattern - (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS macro-name)]) macro-args]))]) - (do Lux:Monad - [expansion (macro-expand (form$ (list& (symbol$ macro-name) body macro-args))) - expansions (map% Lux:Monad expander (as-pairs expansion))] - (;return (list:join expansions))) - - _ - (;return (list branch)))))) + (let [[pattern body] branch] + (_lux_case pattern + (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS macro-name)]) macro-args]))]) + (do Lux/Monad + [expansion (macro-expand (form$ (list& (symbol$ macro-name) body macro-args))) + expansions (map% Lux/Monad expander (as-pairs expansion))] + (;return (list:join expansions))) + + _ + (;return (list branch)))))) (as-pairs branches))] (;return (list (`' (_lux_case (~ value) (~@ (|> expansions list:join (map rejoin-pair) list:join))))))) @@ -1621,7 +1617,7 @@ (defmacro #export (\ tokens) (case tokens (#Cons [body (#Cons [pattern #Nil])]) - (do Lux:Monad + (do Lux/Monad [pattern+ (macro-expand pattern)] (case pattern+ (#Cons [pattern' #Nil]) @@ -1641,8 +1637,8 @@ (fail "\\or can't have 0 patterns") _ - (do Lux:Monad - [patterns' (map% Lux:Monad macro-expand patterns)] + (do Lux/Monad + [patterns' (map% Lux/Monad macro-expand patterns)] (;return (list:join (map (lambda [pattern] (list pattern body)) (list:join patterns')))))) @@ -1650,13 +1646,13 @@ (fail "Wrong syntax for \\or"))) (do-template [<name> <offset>] - [(def #export <name> (int:+ <offset>))] + [(def #export <name> (i+ <offset>))] [inc 1] [dec -1]) (defmacro #export (` tokens) - (do Lux:Monad + (do Lux/Monad [module-name get-module-name] (case tokens (\ (list template)) @@ -1678,7 +1674,7 @@ (def (macro-expand-1 token) (-> Syntax (Lux Syntax)) - (do Lux:Monad + (do Lux/Monad [token+ (macro-expand token)] (case token+ (\ (list token')) @@ -1688,14 +1684,14 @@ (fail "Macro expanded to more than 1 element.")))) (defmacro #export (sig tokens) - (do Lux:Monad - [tokens' (map% Lux:Monad macro-expand tokens) - members (map% Lux:Monad + (do Lux/Monad + [tokens' (map% Lux/Monad macro-expand tokens) + members (map% Lux/Monad (: (-> Syntax (Lux (, Ident Syntax))) (lambda [token] (case token (\ (#Meta [_ (#FormS (list (#Meta [_ (#SymbolS ["" "_lux_:"])]) type (#Meta [_ (#SymbolS name)])))])) - (do Lux:Monad + (do Lux/Monad [name' (normalize name)] (;return (: (, Ident Syntax) [name' type]))) @@ -1745,14 +1741,14 @@ (fail "Wrong syntax for defsig")))) (defmacro #export (struct tokens) - (do Lux:Monad - [tokens' (map% Lux:Monad macro-expand tokens) - members (map% Lux:Monad + (do Lux/Monad + [tokens' (map% Lux/Monad macro-expand tokens) + members (map% Lux/Monad (: (-> Syntax (Lux (, Syntax Syntax))) (lambda [token] (case token (\ (#Meta [_ (#FormS (list (#Meta [_ (#SymbolS ["" "_lux_def"])]) (#Meta [_ (#SymbolS name)]) value))])) - (do Lux:Monad + (do Lux/Monad [name' (normalize name)] (;return (: (, Syntax Syntax) [(tag$ name') value]))) @@ -1825,7 +1821,7 @@ (def (extract-defs defs) (-> (List Syntax) (Lux (List Text))) - (map% Lux:Monad + (map% Lux/Monad (: (-> Syntax (Lux Text)) (lambda [def] (case def @@ -1854,12 +1850,12 @@ (return (: (, Referrals (List Syntax)) [#All tokens'])) (\ (#Meta [_ (#FormS (list& (#Meta [_ (#TagS ["" "only"])]) defs))])) - (do Lux:Monad + (do Lux/Monad [defs' (extract-defs defs)] (return (: (, Referrals (List Syntax)) [(#Only defs') tokens']))) (\ (#Meta [_ (#FormS (list& (#Meta [_ (#TagS ["" "except"])]) defs))])) - (do Lux:Monad + (do Lux/Monad [defs' (extract-defs defs)] (return (: (, Referrals (List Syntax)) [(#Except defs') tokens']))) @@ -1871,7 +1867,7 @@ (def (decorate-imports super-name tokens) (-> Text (List Syntax) (Lux (List Syntax))) - (map% Lux:Monad + (map% Lux/Monad (: (-> Syntax (Lux Syntax)) (lambda [token] (case token @@ -1887,8 +1883,8 @@ (def (parse-imports imports) (-> (List Syntax) (Lux (List Import))) - (do Lux:Monad - [referrals' (map% Lux:Monad + (do Lux/Monad + [referrals' (map% Lux/Monad (: (-> Syntax (Lux (List Import))) (lambda [token] (case token @@ -1896,7 +1892,7 @@ (;return (list [m-name #None #All])) (\ (#Meta [_ (#FormS (list& (#Meta [_ (#SymbolS ["" m-name])]) extra))])) - (do Lux:Monad + (do Lux/Monad [alias+extra' (parse-alias extra) #let [[alias extra'] (: (, (Maybe Text) (List Syntax)) alias+extra')] @@ -1976,14 +1972,14 @@ (def (split-module-contexts module) (-> Text (List Text)) (#Cons [module (let [idx (last-index-of "/" module)] - (if (int:< idx 0) + (if (i< idx 0) #Nil (split-module-contexts (substring2 0 idx module))))])) (def (split-module module) (-> Text (List Text)) (let [idx (index-of "/" module)] - (if (int:< idx 0) + (if (i< idx 0) (#Cons [module #Nil]) (#Cons [(substring2 0 idx module) (split-module (substring1 (inc idx) module))])))) @@ -1996,7 +1992,7 @@ #None (#Cons [x xs']) - (if (int:= idx 0) + (if (i= idx 0) (#Some x) (@ (dec idx) xs') ))) @@ -2021,7 +2017,7 @@ (def (clean-module module) (-> Text (Lux Text)) - (do Lux:Monad + (do Lux/Monad [module-name get-module-name] (case (split-module module) (\ (list& "." parts)) @@ -2030,7 +2026,7 @@ parts (let [[ups parts'] (split-with (text:= "..") parts) num-ups (length ups)] - (if (int:= num-ups 0) + (if (i= num-ups 0) (return module) (case (@ num-ups (split-module-contexts module-name)) #None @@ -2062,23 +2058,23 @@ output)) (defmacro #export (import tokens) - (do Lux:Monad + (do Lux/Monad [imports (parse-imports tokens) - imports (map% Lux:Monad + imports (map% Lux/Monad (: (-> Import (Lux Import)) (lambda [import] (case import [m-name m-alias m-referrals] - (do Lux:Monad + (do Lux/Monad [m-name (clean-module m-name)] (;return (: Import [m-name m-alias m-referrals])))))) imports) - unknowns' (map% Lux:Monad + unknowns' (map% Lux/Monad (: (-> Import (Lux (List Text))) (lambda [import] (case import [m-name _ _] - (do Lux:Monad + (do Lux/Monad [? (module-exists? m-name)] (;return (if ? (list) @@ -2087,24 +2083,24 @@ #let [unknowns (list:join unknowns')]] (case unknowns #Nil - (do Lux:Monad - [output' (map% Lux:Monad + (do Lux/Monad + [output' (map% Lux/Monad (: (-> Import (Lux (List Syntax))) (lambda [import] (case import [m-name m-alias m-referrals] - (do Lux:Monad + (do Lux/Monad [defs (case m-referrals #All (exported-defs m-name) (#Only +defs) - (do Lux:Monad + (do Lux/Monad [*defs (exported-defs m-name)] (;return (filter (is-member? +defs) *defs))) (#Except -defs) - (do Lux:Monad + (do Lux/Monad [*defs (exported-defs m-name)] (;return (filter (. not (is-member? -defs)) *defs))) @@ -2270,7 +2266,7 @@ (defmacro #export (? tokens) (case tokens (\ (list maybe else)) - (do Lux:Monad + (do Lux/Monad [g!value (gensym "")] (return (list (` (case (~ maybe) (#;Some (~ g!value)) @@ -2292,7 +2288,7 @@ body)) (#AppT [F A]) - (do Maybe:Monad + (do Maybe/Monad [type-fn* (apply-type F A)] (apply-type type-fn* param)) @@ -2408,7 +2404,7 @@ ## {#source source #modules modules ## #envs envs #types types #host host ## #seed seed #seen-sources seen-sources #eval? eval?} state] -## (do Maybe:Monad +## (do Maybe/Monad ## [module (get v-prefix modules) ## #let [{#defs defs #module-aliases _ #imports _} module] ## def (get v-name defs) @@ -2421,7 +2417,7 @@ (def (find-var-type name) (-> Ident (Lux Type)) - (do Lux:Monad + (do Lux/Monad [name' (normalize name)] (lambda [state] (case (find-in-env name state) @@ -2444,7 +2440,7 @@ (\ (list struct body)) (case struct (#Meta [_ (#SymbolS name)]) - (do Lux:Monad + (do Lux/Monad [struct-type (find-var-type name)] (case (resolve-struct-type struct-type) (#Some (#RecordT slots)) @@ -2491,7 +2487,7 @@ (f x y)))) (defmacro #export (cond tokens) - (if (int:= 0 (int:% (length tokens) 2)) + (if (i= 0 (i% (length tokens) 2)) (fail "cond requires an even number of arguments.") (case (reverse tokens) (\ (list& else branches')) @@ -2510,13 +2506,13 @@ (\ (list (#Meta [_ (#TagS slot')]) record)) (case record (#Meta [_ (#SymbolS name)]) - (do Lux:Monad + (do Lux/Monad [type (find-var-type name) g!blank (gensym "") g!output (gensym "")] (case (resolve-struct-type type) (#Some (#RecordT slots)) - (do Lux:Monad + (do Lux/Monad [slot (normalize slot')] (let [[s-prefix s-name] (: Ident slot) pattern (record$ (map (: (-> (, Text Type) (, Syntax Syntax)) @@ -2534,7 +2530,7 @@ (fail "get@ can only use records."))) _ - (do Lux:Monad + (do Lux/Monad [_record (gensym "")] (return (list (` (let [(~ _record) (~ record)] (get@ (~ (tag$ slot')) (~ _record)))))))) @@ -2545,7 +2541,7 @@ (defmacro #export (open tokens) (case tokens (\ (list (#Meta [_ (#SymbolS struct-name)]))) - (do Lux:Monad + (do Lux/Monad [struct-type (find-var-type struct-name)] (case (resolve-struct-type struct-type) (#Some (#RecordT slots)) @@ -2579,8 +2575,8 @@ (defmacro #export (:: tokens) (case tokens (\ (list& start parts)) - (do Lux:Monad - [output (foldL% Lux:Monad + (do Lux/Monad + [output (foldL% Lux/Monad (: (-> Syntax Syntax (Lux Syntax)) (lambda [so-far part] (case part @@ -2604,16 +2600,16 @@ (\ (list (#Meta [_ (#TagS slot')]) value record)) (case record (#Meta [_ (#SymbolS name)]) - (do Lux:Monad + (do Lux/Monad [type (find-var-type name)] (case (resolve-struct-type type) (#Some (#RecordT slots)) - (do Lux:Monad - [pattern' (map% Lux:Monad + (do Lux/Monad + [pattern' (map% Lux/Monad (: (-> (, Text Type) (Lux (, Text Syntax))) (lambda [slot] (let [[r-slot-name r-type] slot] - (do Lux:Monad + (do Lux/Monad [g!slot (gensym "")] (return [r-slot-name g!slot]))))) slots) @@ -2639,7 +2635,7 @@ (fail "set@ can only use records."))) _ - (do Lux:Monad + (do Lux/Monad [_record (gensym "")] (return (list (` (let [(~ _record) (~ record)] (set@ (~ (tag$ slot')) (~ value) (~ _record)))))))) @@ -2652,16 +2648,16 @@ (\ (list (#Meta [_ (#TagS slot')]) fun record)) (case record (#Meta [_ (#SymbolS name)]) - (do Lux:Monad + (do Lux/Monad [type (find-var-type name)] (case (resolve-struct-type type) (#Some (#RecordT slots)) - (do Lux:Monad - [pattern' (map% Lux:Monad + (do Lux/Monad + [pattern' (map% Lux/Monad (: (-> (, Text Type) (Lux (, Text Syntax))) (lambda [slot] (let [[r-slot-name r-type] slot] - (do Lux:Monad + (do Lux/Monad [g!slot (gensym "")] (return [r-slot-name g!slot]))))) slots) @@ -2687,7 +2683,7 @@ (fail "update@ can only use records."))) _ - (do Lux:Monad + (do Lux/Monad [_record (gensym "")] (return (list (` (let [(~ _record) (~ record)] (update@ (~ (tag$ slot')) (~ fun) (~ _record)))))))) @@ -2695,6 +2691,33 @@ _ (fail "Wrong syntax for update@"))) +(defmacro #export (\template tokens) + (case tokens + (\ (list (#Meta [_ (#TupleS data)]) + (#Meta [_ (#TupleS bindings)]) + (#Meta [_ (#TupleS templates)]))) + (case (: (Maybe (List Syntax)) + (do Maybe/Monad + [bindings' (map% Maybe/Monad get-ident bindings) + data' (map% Maybe/Monad tuple->list data)] + (let [apply (: (-> RepEnv (List Syntax)) + (lambda [env] (map (apply-template env) templates)))] + (|> data' + (join-map (. apply (make-env bindings'))) + ;return)))) + (#Some output) + (return output) + + #None + (fail "Wrong syntax for \\template")) + + _ + (fail "Wrong syntax for \\template"))) + +(def #export complement + (All [a] (-> (-> a Bool) (-> a Bool))) + (. not)) + ## (defmacro #export (loop tokens) ## (case tokens ## (\ (list bindings body)) @@ -2702,14 +2725,14 @@ ## vars (map first pairs) ## inits (map second pairs)] ## (if (every? symbol? inits) -## (do Lux:Monad -## [inits' (map% Maybe:Monad get-ident inits) -## init-types (map% Maybe:Monad find-var-type inits')] +## (do Lux/Monad +## [inits' (map% Maybe/Monad get-ident inits) +## init-types (map% Maybe/Monad find-var-type inits')] ## (return (list (` ((lambda (~ (#SymbolS ["" "recur"])) [(~@ vars)] ## (~ body)) ## (~@ inits)))))) -## (do Lux:Monad -## [aliases (map% Maybe:Monad (lambda [_] (gensym "")) inits)] +## (do Lux/Monad +## [aliases (map% Maybe/Monad (lambda [_] (gensym "")) inits)] ## (return (list (` (let [(~@ (interleave aliases inits))] ## (loop [(~@ (interleave vars aliases))] ## (~ body))))))))) |