aboutsummaryrefslogtreecommitdiff
path: root/input/lux.lux
diff options
context:
space:
mode:
Diffstat (limited to 'input/lux.lux')
-rw-r--r--input/lux.lux293
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)))))))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-07 20:28:39 +0000