aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--stdlib/source/lux.lux1226
1 files changed, 613 insertions, 613 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 0b92fb023..16077a0e3 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -677,7 +677,7 @@
(#AppT Meta Cursor))
AST)
(_lux_lambda _ data
- [_cursor data]))
+ [_cursor data]))
#Nil)
(_lux_def return
@@ -688,8 +688,8 @@
(#ProdT Compiler
(#BoundT +1))))))
(_lux_lambda _ val
- (_lux_lambda _ state
- (#Right state val))))
+ (_lux_lambda _ state
+ (#Right state val))))
#Nil)
(_lux_def fail
@@ -700,8 +700,8 @@
(#ProdT Compiler
(#BoundT +1))))))
(_lux_lambda _ msg
- (_lux_lambda _ state
- (#Left msg))))
+ (_lux_lambda _ state
+ (#Left msg))))
#Nil)
(_lux_def bool$
@@ -773,52 +773,52 @@
(_lux_def let''
(_lux_: Macro
(_lux_lambda _ tokens
- (_lux_case tokens
- (#Cons lhs (#Cons rhs (#Cons body #Nil)))
- (return (#Cons (form$ (#Cons (symbol$ ["" "_lux_case"])
- (#Cons rhs (#Cons lhs (#Cons body #Nil)))))
- #Nil))
+ (_lux_case tokens
+ (#Cons lhs (#Cons rhs (#Cons body #Nil)))
+ (return (#Cons (form$ (#Cons (symbol$ ["" "_lux_case"])
+ (#Cons rhs (#Cons lhs (#Cons body #Nil)))))
+ #Nil))
- _
- (fail "Wrong syntax for let''"))))
+ _
+ (fail "Wrong syntax for let''"))))
default-macro-meta)
-(_lux_def lambda''
+(_lux_def function''
(_lux_: Macro
(_lux_lambda _ tokens
- (_lux_case tokens
- (#Cons [_ (#TupleS (#Cons arg args'))] (#Cons body #Nil))
- (return (#Cons (_meta (#FormS (#Cons (_meta (#SymbolS "" "_lux_lambda"))
- (#Cons (_meta (#SymbolS "" ""))
- (#Cons arg
- (#Cons (_lux_case args'
- #Nil
- body
-
- _
- (_meta (#FormS (#Cons (_meta (#SymbolS "lux" "lambda''"))
- (#Cons (_meta (#TupleS args'))
- (#Cons body #Nil))))))
- #Nil))))))
- #Nil))
-
- (#Cons [_ (#SymbolS "" self)] (#Cons [_ (#TupleS (#Cons arg args'))] (#Cons body #Nil)))
- (return (#Cons (_meta (#FormS (#Cons (_meta (#SymbolS "" "_lux_lambda"))
- (#Cons (_meta (#SymbolS "" self))
- (#Cons arg
- (#Cons (_lux_case args'
- #Nil
- body
-
- _
- (_meta (#FormS (#Cons (_meta (#SymbolS "lux" "lambda''"))
- (#Cons (_meta (#TupleS args'))
- (#Cons body #Nil))))))
- #Nil))))))
- #Nil))
-
- _
- (fail "Wrong syntax for lambda''"))))
+ (_lux_case tokens
+ (#Cons [_ (#TupleS (#Cons arg args'))] (#Cons body #Nil))
+ (return (#Cons (_meta (#FormS (#Cons (_meta (#SymbolS "" "_lux_lambda"))
+ (#Cons (_meta (#SymbolS "" ""))
+ (#Cons arg
+ (#Cons (_lux_case args'
+ #Nil
+ body
+
+ _
+ (_meta (#FormS (#Cons (_meta (#SymbolS "lux" "function''"))
+ (#Cons (_meta (#TupleS args'))
+ (#Cons body #Nil))))))
+ #Nil))))))
+ #Nil))
+
+ (#Cons [_ (#SymbolS "" self)] (#Cons [_ (#TupleS (#Cons arg args'))] (#Cons body #Nil)))
+ (return (#Cons (_meta (#FormS (#Cons (_meta (#SymbolS "" "_lux_lambda"))
+ (#Cons (_meta (#SymbolS "" self))
+ (#Cons arg
+ (#Cons (_lux_case args'
+ #Nil
+ body
+
+ _
+ (_meta (#FormS (#Cons (_meta (#SymbolS "lux" "function''"))
+ (#Cons (_meta (#TupleS args'))
+ (#Cons body #Nil))))))
+ #Nil))))))
+ #Nil))
+
+ _
+ (fail "Wrong syntax for function''"))))
default-macro-meta)
(_lux_def export?-meta
@@ -850,84 +850,84 @@
(_lux_def with-export-meta
(_lux_: (#LambdaT AST AST)
- (lambda'' [tail]
- (form$ (#Cons (tag$ ["lux" "Cons"])
- (#Cons export?-meta
- (#Cons tail #Nil))))))
+ (function'' [tail]
+ (form$ (#Cons (tag$ ["lux" "Cons"])
+ (#Cons export?-meta
+ (#Cons tail #Nil))))))
#Nil)
(_lux_def with-hidden-meta
(_lux_: (#LambdaT AST AST)
- (lambda'' [tail]
- (form$ (#Cons (tag$ ["lux" "Cons"])
- (#Cons hidden?-meta
- (#Cons tail #Nil))))))
+ (function'' [tail]
+ (form$ (#Cons (tag$ ["lux" "Cons"])
+ (#Cons hidden?-meta
+ (#Cons tail #Nil))))))
#Nil)
(_lux_def with-macro-meta
(_lux_: (#LambdaT AST AST)
- (lambda'' [tail]
- (form$ (#Cons (tag$ ["lux" "Cons"])
- (#Cons macro?-meta
- (#Cons tail #Nil))))))
+ (function'' [tail]
+ (form$ (#Cons (tag$ ["lux" "Cons"])
+ (#Cons macro?-meta
+ (#Cons tail #Nil))))))
#Nil)
(_lux_def def:''
(_lux_: Macro
- (lambda'' [tokens]
- (_lux_case tokens
- (#Cons [[_ (#TagS ["" "export"])]
- (#Cons [[_ (#FormS (#Cons [name args]))]
- (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])])
- (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
- (#Cons [name
- (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
- (#Cons [type
- (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda''"]))
- (#Cons [name
- (#Cons [(_meta (#TupleS args))
- (#Cons [body #Nil])])])])))
- #Nil])])])))
- (#Cons (with-export-meta meta) #Nil)])])])))
- #Nil]))
-
- (#Cons [[_ (#TagS ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])])
- (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
- (#Cons [name
- (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
- (#Cons [type
- (#Cons [body
- #Nil])])])))
- (#Cons (with-export-meta meta) #Nil)])])])))
- #Nil]))
-
- (#Cons [[_ (#FormS (#Cons [name args]))]
- (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])
- (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
- (#Cons [name
- (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
- (#Cons [type
- (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda''"]))
- (#Cons [name
- (#Cons [(_meta (#TupleS args))
- (#Cons [body #Nil])])])])))
- #Nil])])])))
- (#Cons meta #Nil)])])])))
- #Nil]))
-
- (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])
- (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
- (#Cons [name
- (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
- (#Cons [type
- (#Cons [body
- #Nil])])])))
- (#Cons meta #Nil)])])])))
- #Nil]))
+ (function'' [tokens]
+ (_lux_case tokens
+ (#Cons [[_ (#TagS ["" "export"])]
+ (#Cons [[_ (#FormS (#Cons [name args]))]
+ (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])])
+ (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
+ (#Cons [name
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
+ (#Cons [type
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "function''"]))
+ (#Cons [name
+ (#Cons [(_meta (#TupleS args))
+ (#Cons [body #Nil])])])])))
+ #Nil])])])))
+ (#Cons (with-export-meta meta) #Nil)])])])))
+ #Nil]))
+
+ (#Cons [[_ (#TagS ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])])
+ (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
+ (#Cons [name
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
+ (#Cons [type
+ (#Cons [body
+ #Nil])])])))
+ (#Cons (with-export-meta meta) #Nil)])])])))
+ #Nil]))
+
+ (#Cons [[_ (#FormS (#Cons [name args]))]
+ (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])
+ (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
+ (#Cons [name
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
+ (#Cons [type
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "function''"]))
+ (#Cons [name
+ (#Cons [(_meta (#TupleS args))
+ (#Cons [body #Nil])])])])))
+ #Nil])])])))
+ (#Cons meta #Nil)])])])))
+ #Nil]))
+
+ (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])
+ (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
+ (#Cons [name
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
+ (#Cons [type
+ (#Cons [body
+ #Nil])])])))
+ (#Cons meta #Nil)])])])))
+ #Nil]))
- _
- (fail "Wrong syntax for def''"))
- ))
+ _
+ (fail "Wrong syntax for def''"))
+ ))
default-macro-meta)
(def:'' (macro:' tokens)
@@ -1060,10 +1060,10 @@
[meta (#RecordS slots)]
[meta (#RecordS (map (_lux_: (#LambdaT (#ProdT AST AST) (#ProdT AST AST))
- (lambda'' [slot]
- (_lux_case slot
- [k v]
- [(replace-syntax reps k) (replace-syntax reps v)])))
+ (function'' [slot]
+ (_lux_case slot
+ [k v]
+ [(replace-syntax reps k) (replace-syntax reps v)])))
slots))]
_
@@ -1079,9 +1079,9 @@
[_ (#RecordS pairs)]
(record$ (map (_lux_: (#LambdaT (#ProdT AST AST) (#ProdT AST AST))
- (lambda'' [pair]
- (let'' [name val] pair
- [name (update-bounds val)])))
+ (function'' [pair]
+ (let'' [name val] pair
+ [name (update-bounds val)])))
pairs))
[_ (#FormS (#Cons [_ (#TagS "lux" "BoundT")] (#Cons [_ (#NatS idx)] #Nil)))]
@@ -1105,7 +1105,7 @@
(next #Nil)
(#Cons [_ (#SymbolS "" arg-name)] args')
- (parse-quantified-args args' (lambda'' [names] (next (#Cons arg-name names))))
+ (parse-quantified-args args' (function'' [names] (next (#Cons arg-name names))))
_
(fail "Expected symbol.")
@@ -1136,7 +1136,7 @@
#Nil
(#UnivQ #Nil
(#LambdaT ($' List (#BoundT +1)) Int))
- (fold (lambda'' [_ acc] (_lux_proc ["int" "+"] [1 acc])) 0 list))
+ (fold (function'' [_ acc] (_lux_proc ["int" "+"] [1 acc])) 0 list))
(macro:' #export (All tokens)
(#Cons [["lux" "doc"] (#TextA "## Universal quantification.
@@ -1157,31 +1157,31 @@
(_lux_case tokens
(#Cons [_ (#TupleS args)] (#Cons body #Nil))
(parse-quantified-args args
- (lambda'' [names]
- (let'' body' (fold (_lux_: (#LambdaT Text (#LambdaT AST AST))
- (lambda'' [name' body']
- (form$ (#Cons (tag$ ["lux" "UnivQ"])
- (#Cons (tag$ ["lux" "Nil"])
- (#Cons (replace-syntax (#Cons [name' (make-bound +1)] #Nil)
- (update-bounds body')) #Nil))))))
- body
- names)
- (return (#Cons (_lux_case [(Text/= "" self-name) names]
- [true _]
- body'
-
- [_ #;Nil]
- body'
-
- [false _]
- (replace-syntax (#Cons [self-name (make-bound (_lux_proc ["nat" "*"]
- [+2 (_lux_proc ["nat" "-"]
- [(_lux_proc ["int" "to-nat"]
- [(length names)])
- +1])]))]
- #Nil)
- body'))
- #Nil)))))
+ (function'' [names]
+ (let'' body' (fold (_lux_: (#LambdaT Text (#LambdaT AST AST))
+ (function'' [name' body']
+ (form$ (#Cons (tag$ ["lux" "UnivQ"])
+ (#Cons (tag$ ["lux" "Nil"])
+ (#Cons (replace-syntax (#Cons [name' (make-bound +1)] #Nil)
+ (update-bounds body')) #Nil))))))
+ body
+ names)
+ (return (#Cons (_lux_case [(Text/= "" self-name) names]
+ [true _]
+ body'
+
+ [_ #;Nil]
+ body'
+
+ [false _]
+ (replace-syntax (#Cons [self-name (make-bound (_lux_proc ["nat" "*"]
+ [+2 (_lux_proc ["nat" "-"]
+ [(_lux_proc ["int" "to-nat"]
+ [(length names)])
+ +1])]))]
+ #Nil)
+ body'))
+ #Nil)))))
_
(fail "Wrong syntax for All"))
@@ -1208,31 +1208,31 @@
(_lux_case tokens
(#Cons [_ (#TupleS args)] (#Cons body #Nil))
(parse-quantified-args args
- (lambda'' [names]
- (let'' body' (fold (_lux_: (#LambdaT Text (#LambdaT AST AST))
- (lambda'' [name' body']
- (form$ (#Cons (tag$ ["lux" "ExQ"])
- (#Cons (tag$ ["lux" "Nil"])
- (#Cons (replace-syntax (#Cons [name' (make-bound +1)] #Nil)
- (update-bounds body')) #Nil))))))
- body
- names)
- (return (#Cons (_lux_case [(Text/= "" self-name) names]
- [true _]
- body'
-
- [_ #;Nil]
- body'
-
- [false _]
- (replace-syntax (#Cons [self-name (make-bound (_lux_proc ["nat" "*"]
- [+2 (_lux_proc ["nat" "-"]
- [(_lux_proc ["int" "to-nat"]
- [(length names)])
- +1])]))]
- #Nil)
- body'))
- #Nil)))))
+ (function'' [names]
+ (let'' body' (fold (_lux_: (#LambdaT Text (#LambdaT AST AST))
+ (function'' [name' body']
+ (form$ (#Cons (tag$ ["lux" "ExQ"])
+ (#Cons (tag$ ["lux" "Nil"])
+ (#Cons (replace-syntax (#Cons [name' (make-bound +1)] #Nil)
+ (update-bounds body')) #Nil))))))
+ body
+ names)
+ (return (#Cons (_lux_case [(Text/= "" self-name) names]
+ [true _]
+ body'
+
+ [_ #;Nil]
+ body'
+
+ [false _]
+ (replace-syntax (#Cons [self-name (make-bound (_lux_proc ["nat" "*"]
+ [+2 (_lux_proc ["nat" "-"]
+ [(_lux_proc ["int" "to-nat"]
+ [(length names)])
+ +1])]))]
+ #Nil)
+ body'))
+ #Nil)))))
_
(fail "Wrong syntax for Ex"))
@@ -1241,7 +1241,7 @@
(def:'' (reverse list)
#Nil
(All [a] (#LambdaT ($' List a) ($' List a)))
- (fold (lambda'' [head tail] (#Cons head tail))
+ (fold (function'' [head tail] (#Cons head tail))
#Nil
list))
@@ -1254,7 +1254,7 @@
(_lux_case (reverse tokens)
(#Cons output inputs)
(return (#Cons (fold (_lux_: (#LambdaT AST (#LambdaT AST AST))
- (lambda'' [i o] (form$ (#Cons (tag$ ["lux" "LambdaT"]) (#Cons i (#Cons o #Nil))))))
+ (function'' [i o] (form$ (#Cons (tag$ ["lux" "LambdaT"]) (#Cons i (#Cons o #Nil))))))
output
inputs)
#Nil))
@@ -1266,10 +1266,10 @@
(#Cons [["lux" "doc"] (#TextA "## List-construction macro.
(list 1 2 3)")]
#;Nil)
- (return (#Cons (fold (lambda'' [head tail]
- (form$ (#Cons (tag$ ["lux" "Cons"])
- (#Cons (tuple$ (#Cons [head (#Cons [tail #Nil])]))
- #Nil))))
+ (return (#Cons (fold (function'' [head tail]
+ (form$ (#Cons (tag$ ["lux" "Cons"])
+ (#Cons (tuple$ (#Cons [head (#Cons [tail #Nil])]))
+ #Nil))))
(tag$ ["lux" "Nil"])
(reverse xs))
#Nil)))
@@ -1281,9 +1281,9 @@
#;Nil)
(_lux_case (reverse xs)
(#Cons last init)
- (return (list (fold (lambda'' [head tail]
- (form$ (list (tag$ ["lux" "Cons"])
- (tuple$ (list head tail)))))
+ (return (list (fold (function'' [head tail]
+ (form$ (list (tag$ ["lux" "Cons"])
+ (tuple$ (list head tail)))))
last
init)))
@@ -1302,7 +1302,7 @@
(return (list (tag$ ["lux" "UnitT"])))
(#Cons last prevs)
- (return (list (fold (lambda'' [left right] (form$ (list (tag$ ["lux" "ProdT"]) left right)))
+ (return (list (fold (function'' [left right] (form$ (list (tag$ ["lux" "ProdT"]) left right)))
last
prevs)))
))
@@ -1319,12 +1319,12 @@
(return (list (tag$ ["lux" "VoidT"])))
(#Cons last prevs)
- (return (list (fold (lambda'' [left right] (form$ (list (tag$ ["lux" "SumT"]) left right)))
+ (return (list (fold (function'' [left right] (form$ (list (tag$ ["lux" "SumT"]) left right)))
last
prevs)))
))
-(macro:' (lambda' tokens)
+(macro:' (function' tokens)
(let'' [name tokens'] (_lux_case tokens
(#Cons [[_ (#SymbolS ["" name])] tokens'])
[name tokens']
@@ -1335,22 +1335,22 @@
(#Cons [[_ (#TupleS args)] (#Cons [body #Nil])])
(_lux_case args
#Nil
- (fail "lambda' requires a non-empty arguments tuple.")
+ (fail "function' requires a non-empty arguments tuple.")
(#Cons [harg targs])
(return (list (form$ (list (symbol$ ["" "_lux_lambda"])
(symbol$ ["" name])
harg
- (fold (lambda'' [arg body']
- (form$ (list (symbol$ ["" "_lux_lambda"])
- (symbol$ ["" ""])
- arg
- body')))
+ (fold (function'' [arg body']
+ (form$ (list (symbol$ ["" "_lux_lambda"])
+ (symbol$ ["" ""])
+ arg
+ body')))
body
(reverse targs)))))))
_
- (fail "Wrong syntax for lambda'"))))
+ (fail "Wrong syntax for function'"))))
(macro:' (def:''' tokens)
(_lux_case tokens
@@ -1361,7 +1361,7 @@
name
(form$ (list (symbol$ ["" "_lux_:"])
type
- (form$ (list (symbol$ ["lux" "lambda'"])
+ (form$ (list (symbol$ ["lux" "function'"])
name
(tuple$ args)
body))))
@@ -1381,7 +1381,7 @@
name
(form$ (list (symbol$ ["" "_lux_:"])
type
- (form$ (list (symbol$ ["lux" "lambda'"])
+ (form$ (list (symbol$ ["lux" "function'"])
name
(tuple$ args)
body))))
@@ -1412,10 +1412,10 @@
(#Cons [[_ (#TupleS bindings)] (#Cons [body #Nil])])
(return (list (fold (_lux_: (-> (& AST AST) AST
AST)
- (lambda' [binding body]
- (_lux_case binding
- [label value]
- (form$ (list (symbol$ ["" "_lux_case"]) value label body)))))
+ (function' [binding body]
+ (_lux_case binding
+ [label value]
+ (form$ (list (symbol$ ["" "_lux_case"]) value label body)))))
body
(reverse (as-pairs bindings)))))
@@ -1493,7 +1493,7 @@
(#Cons op tokens')
(_lux_case tokens'
(#Cons first nexts)
- (return (list (fold (lambda' [a1 a2] (form$ (list op a1 a2)))
+ (return (list (fold (function' [a1 a2] (form$ (list op a1 a2)))
first
nexts)))
@@ -1514,7 +1514,7 @@
(#Cons op tokens')
(_lux_case (reverse tokens')
(#Cons last prevs)
- (return (list (fold (lambda' [a1 a2] (form$ (list op a1 a2)))
+ (return (list (fold (function' [a1 a2] (form$ (list op a1 a2)))
last
prevs)))
@@ -1544,31 +1544,31 @@
#Nil
($' Monad Maybe)
{#wrap
- (lambda' [x] (#Some x))
+ (function' [x] (#Some x))
#bind
- (lambda' [f ma]
- (_lux_case ma
- #None #None
- (#Some a) (f a)))})
+ (function' [f ma]
+ (_lux_case ma
+ #None #None
+ (#Some a) (f a)))})
(def:''' Monad<Lux>
#Nil
($' Monad Lux)
{#wrap
- (lambda' [x]
- (lambda' [state]
- (#Right state x)))
+ (function' [x]
+ (function' [state]
+ (#Right state x)))
#bind
- (lambda' [f ma]
- (lambda' [state]
- (_lux_case (ma state)
- (#Left msg)
- (#Left msg)
+ (function' [f ma]
+ (function' [state]
+ (_lux_case (ma state)
+ (#Left msg)
+ (#Left msg)
- (#Right state' a)
- (f a state'))))})
+ (#Right state' a)
+ (f a state'))))})
(macro:' (do tokens)
(_lux_case tokens
@@ -1576,16 +1576,16 @@
(let' [g!wrap (symbol$ ["" "wrap"])
g!bind (symbol$ ["" " bind "])
body' (fold (_lux_: (-> (& AST AST) AST AST)
- (lambda' [binding body']
- (let' [[var value] binding]
- (_lux_case var
- [_ (#TagS "" "let")]
- (form$ (list (symbol$ ["lux" "let'"]) value body'))
-
- _
- (form$ (list g!bind
- (form$ (list (symbol$ ["" "_lux_lambda"]) (symbol$ ["" ""]) var body'))
- value))))))
+ (function' [binding body']
+ (let' [[var value] binding]
+ (_lux_case var
+ [_ (#TagS "" "let")]
+ (form$ (list (symbol$ ["lux" "let'"]) value body'))
+
+ _
+ (form$ (list g!bind
+ (form$ (list (symbol$ ["" "_lux_lambda"]) (symbol$ ["" ""]) var body'))
+ value))))))
body
(reverse (as-pairs bindings)))]
(return (list (form$ (list (symbol$ ["" "_lux_case"])
@@ -1733,17 +1733,17 @@
[elems' (_lux_: ($' Lux ($' List AST))
(mapM Monad<Lux>
(_lux_: (-> AST ($' Lux AST))
- (lambda' [elem]
- (_lux_case elem
- [_ (#FormS (#Cons [[_ (#SymbolS ["" "~@"])] (#Cons [spliced #Nil])]))]
- (wrap spliced)
+ (function' [elem]
+ (_lux_case elem
+ [_ (#FormS (#Cons [[_ (#SymbolS ["" "~@"])] (#Cons [spliced #Nil])]))]
+ (wrap spliced)
- _
- (do Monad<Lux>
- [=elem (untemplate elem)]
- (wrap (form$ (list (symbol$ ["" "_lux_:"])
- (form$ (list (tag$ ["lux" "AppT"]) (tuple$ (list (symbol$ ["lux" "List"]) (symbol$ ["lux" "AST"])))))
- (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list =elem (tag$ ["lux" "Nil"]))))))))))))
+ _
+ (do Monad<Lux>
+ [=elem (untemplate elem)]
+ (wrap (form$ (list (symbol$ ["" "_lux_:"])
+ (form$ (list (tag$ ["lux" "AppT"]) (tuple$ (list (symbol$ ["lux" "List"]) (symbol$ ["lux" "AST"])))))
+ (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list =elem (tag$ ["lux" "Nil"]))))))))))))
elems))]
(wrap (wrap-meta (form$ (list tag
(form$ (list& (symbol$ ["lux" "$_"])
@@ -1831,12 +1831,12 @@
(do Monad<Lux>
[=fields (mapM Monad<Lux>
(_lux_: (-> (& AST AST) ($' Lux AST))
- (lambda' [kv]
- (let' [[k v] kv]
- (do Monad<Lux>
- [=k (untemplate replace? subst k)
- =v (untemplate replace? subst v)]
- (wrap (tuple$ (list =k =v)))))))
+ (function' [kv]
+ (let' [[k v] kv]
+ (do Monad<Lux>
+ [=k (untemplate replace? subst k)
+ =v (untemplate replace? subst v)]
+ (wrap (tuple$ (list =k =v)))))))
fields)]
(wrap (wrap-meta (form$ (list (tag$ ["lux" "RecordS"]) (untemplate-list =fields))))))
))
@@ -1925,16 +1925,16 @@
(_lux_case tokens
(#Cons [init apps])
(return (list (fold (_lux_: (-> AST AST AST)
- (lambda' [app acc]
- (_lux_case app
- [_ (#TupleS parts)]
- (tuple$ (List/append parts (list acc)))
+ (function' [app acc]
+ (_lux_case app
+ [_ (#TupleS parts)]
+ (tuple$ (List/append parts (list acc)))
- [_ (#FormS parts)]
- (form$ (List/append parts (list acc)))
+ [_ (#FormS parts)]
+ (form$ (List/append parts (list acc)))
- _
- (` ((~ app) (~ acc))))))
+ _
+ (` ((~ app) (~ acc))))))
init
apps)))
@@ -1952,16 +1952,16 @@
(_lux_case (reverse tokens)
(#Cons [init apps])
(return (list (fold (_lux_: (-> AST AST AST)
- (lambda' [app acc]
- (_lux_case app
- [_ (#TupleS parts)]
- (tuple$ (List/append parts (list acc)))
+ (function' [app acc]
+ (_lux_case app
+ [_ (#TupleS parts)]
+ (tuple$ (List/append parts (list acc)))
- [_ (#FormS parts)]
- (form$ (List/append parts (list acc)))
+ [_ (#FormS parts)]
+ (form$ (List/append parts (list acc)))
- _
- (` ((~ app) (~ acc))))))
+ _
+ (` ((~ app) (~ acc))))))
init
apps)))
@@ -1972,7 +1972,7 @@
(list [["lux" "doc"] (#TextA "Function composition.")])
(All [a b c]
(-> (-> b c) (-> a b) (-> a c)))
- (lambda' [x] (f (g x))))
+ (function' [x] (f (g x))))
(def:''' (get-ident x)
#Nil
@@ -2034,9 +2034,9 @@
[meta (#RecordS members)]
[meta (#RecordS (map (_lux_: (-> (& AST AST) (& AST AST))
- (lambda' [kv]
- (let' [[slot value] kv]
- [(apply-template env slot) (apply-template env value)])))
+ (function' [kv]
+ (let' [[slot value] kv]
+ [(apply-template env slot) (apply-template env value)])))
members))]
_
@@ -2057,7 +2057,7 @@
#Nil
(All [a]
(-> (-> a Bool) ($' List a) Bool))
- (fold (lambda' [_2 _1] (if _1 (p _2) false)) true xs))
+ (fold (function' [_2 _1] (if _1 (p _2) false)) true xs))
(macro:' #export (do-template tokens)
(list [["lux" "doc"] (#TextA "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary.
@@ -2074,9 +2074,9 @@
(mapM Monad<Maybe> tuple->list data)]
[(#Some bindings') (#Some data')]
(let' [apply (_lux_: (-> RepEnv ($' List AST))
- (lambda' [env] (map (apply-template env) templates)))
+ (function' [env] (map (apply-template env) templates)))
num-bindings (length bindings')]
- (if (every? (lambda' [sample] (_lux_proc ["int" "="] [num-bindings sample]))
+ (if (every? (function' [sample] (_lux_proc ["int" "="] [num-bindings sample]))
(map length data'))
(|> data'
(join-map (. apply (make-env bindings')))
@@ -2219,12 +2219,12 @@
_
(let' [loop (_lux_: (-> Nat Text Text)
- (lambda' recur [input output]
- (if (_lux_proc ["nat" "="] [input +0])
- (_lux_proc ["text" "append"] ["+" output])
- (recur (_lux_proc ["nat" "/"] [input +10])
- (_lux_proc ["text" "append"] [(digit-to-text (_lux_proc ["nat" "%"] [input +10]))
- output])))))]
+ (function' recur [input output]
+ (if (_lux_proc ["nat" "="] [input +0])
+ (_lux_proc ["text" "append"] ["+" output])
+ (recur (_lux_proc ["nat" "/"] [input +10])
+ (_lux_proc ["text" "append"] [(digit-to-text (_lux_proc ["nat" "%"] [input +10]))
+ output])))))]
(loop value ""))))
(def:''' (Int/abs value)
@@ -2243,12 +2243,12 @@
""
"-")]
((_lux_: (-> Int Text Text)
- (lambda' recur [input output]
- (if (i.= 0 input)
- (_lux_proc ["text" "append"] [sign output])
- (recur (i./ 10 input)
- (_lux_proc ["text" "append"] [(|> input (i.% 10) (_lux_:! Nat) digit-to-text)
- output])))))
+ (function' recur [input output]
+ (if (i.= 0 input)
+ (_lux_proc ["text" "append"] [sign output])
+ (recur (i./ 10 input)
+ (_lux_proc ["text" "append"] [(|> input (i.% 10) (_lux_:! Nat) digit-to-text)
+ output])))))
(|> value (i./ 10) Int/abs)
(|> value (i.% 10) Int/abs (_lux_:! Nat) digit-to-text)))))
@@ -2340,14 +2340,14 @@
(do Monad<Lux>
[current-module current-module-name]
(let' [[module name] ident]
- (lambda' [state]
- (_lux_case state
- {#info info #source source #modules modules
- #scopes scopes #type-vars types #host host
- #seed seed #expected expected
- #cursor cursor
- #scope-type-vars scope-type-vars}
- (#Right state (find-macro' modules current-module module name)))))))
+ (function' [state]
+ (_lux_case state
+ {#info info #source source #modules modules
+ #scopes scopes #type-vars types #host host
+ #seed seed #expected expected
+ #cursor cursor
+ #scope-type-vars scope-type-vars}
+ (#Right state (find-macro' modules current-module module name)))))))
(def:''' (macro? ident)
#Nil
@@ -2451,16 +2451,16 @@
[_ (#RecordS pairs)]
(do Monad<Lux>
[pairs' (mapM Monad<Lux>
- (lambda' [kv]
- (let' [[key val] kv]
- (do Monad<Lux>
- [val' (macro-expand-all val)]
- (_lux_case val'
- (#;Cons val'' #;Nil)
- (return [key val''])
+ (function' [kv]
+ (let' [[key val] kv]
+ (do Monad<Lux>
+ [val' (macro-expand-all val)]
+ (_lux_case val'
+ (#;Cons val'' #;Nil)
+ (return [key val''])
- _
- (fail "The value-part of a KV-pair in a record must macro-expand to a single AST.")))))
+ _
+ (fail "The value-part of a KV-pair in a record must macro-expand to a single AST.")))))
pairs)]
(wrap (list (record$ pairs'))))
@@ -2479,7 +2479,7 @@
[_ (#FormS (#Cons type-fn args))]
(fold (_lux_: (-> AST AST AST)
- (lambda' [arg type-fn] (` (#;AppT (~ type-fn) (~ arg)))))
+ (function' [arg type-fn] (` (#;AppT (~ type-fn) (~ arg)))))
(walk-type type-fn)
(map walk-type args))
@@ -2547,13 +2547,13 @@
(do Monad<Lux>
[members (mapM Monad<Lux>
(: (-> [AST AST] (Lux [Text AST]))
- (lambda' [pair]
- (_lux_case pair
- [[_ (#TagS "" member-name)] member-type]
- (return [member-name member-type])
+ (function' [pair]
+ (_lux_case pair
+ [[_ (#TagS "" member-name)] member-type]
+ (return [member-name member-type])
- _
- (fail "Wrong syntax for variant case."))))
+ _
+ (fail "Wrong syntax for variant case."))))
pairs)]
(return [(` (& (~@ (map second members))))
(#Some (map first members))]))
@@ -2573,19 +2573,19 @@
(do Monad<Lux>
[members (mapM Monad<Lux>
(: (-> AST (Lux [Text AST]))
- (lambda' [case]
- (_lux_case case
- [_ (#TagS "" member-name)]
- (return [member-name (` Unit)])
-
- [_ (#FormS (#Cons [_ (#TagS "" member-name)] (#Cons member-type #Nil)))]
- (return [member-name member-type])
+ (function' [case]
+ (_lux_case case
+ [_ (#TagS "" member-name)]
+ (return [member-name (` Unit)])
+
+ [_ (#FormS (#Cons [_ (#TagS "" member-name)] (#Cons member-type #Nil)))]
+ (return [member-name member-type])
- [_ (#FormS (#Cons [_ (#TagS "" member-name)] member-types))]
- (return [member-name (` (& (~@ member-types)))])
+ [_ (#FormS (#Cons [_ (#TagS "" member-name)] member-types))]
+ (return [member-name (` (& (~@ member-types)))])
- _
- (fail "Wrong syntax for variant case."))))
+ _
+ (fail "Wrong syntax for variant case."))))
(list& case cases))]
(return [(` (| (~@ (map second members))))
(#Some (map first members))]))
@@ -2634,7 +2634,7 @@
(#Cons value actions)
(let' [dummy (symbol$ ["" ""])]
(return (list (fold (_lux_: (-> AST AST AST)
- (lambda' [pre post] (` (;_lux_case (~ pre) (~ dummy) (~ post)))))
+ (function' [pre post] (` (;_lux_case (~ pre) (~ dummy) (~ post)))))
value
actions))))
@@ -2671,7 +2671,7 @@
body
_
- (` (lambda' (~ name) [(~@ args)] (~ body))))
+ (` (function' (~ name) [(~@ args)] (~ body))))
body'' (_lux_case ?type
(#Some type)
(` (: (~ type) (~ body')))
@@ -2741,7 +2741,7 @@
[_ (#RecordS kvs)]
($_ Text/append "{" (|> kvs
- (map (lambda' [kv] (_lux_case kv [k v] ($_ Text/append (ast-to-text k) " " (ast-to-text v)))))
+ (map (function' [kv] (_lux_case kv [k v] ($_ Text/append (ast-to-text k) " " (ast-to-text v)))))
(interpose " ")
reverse
(fold Text/append "")) "}")
@@ -2849,7 +2849,7 @@
_
(let' [pairs (|> patterns
- (map (lambda' [pattern] (list pattern body)))
+ (map (function' [pattern] (list pattern body)))
(List/join))]
(return (List/append pairs branches))))
_
@@ -2875,11 +2875,11 @@
(if (multiple? 2 (length bindings))
(|> bindings as-pairs reverse
(fold (: (-> [AST AST] AST AST)
- (lambda' [lr body']
- (let' [[l r] lr]
- (if (symbol? l)
- (` (;_lux_case (~ r) (~ l) (~ body')))
- (` (case (~ r) (~ l) (~ body')))))))
+ (function' [lr body']
+ (let' [[l r] lr]
+ (if (symbol? l)
+ (` (;_lux_case (~ r) (~ l) (~ body')))
+ (` (case (~ r) (~ l) (~ body')))))))
body)
list
return)
@@ -2910,11 +2910,11 @@
(let [g!blank (symbol$ ["" ""])
g!name (symbol$ ident)
body+ (fold (: (-> AST AST AST)
- (lambda' [arg body']
- (if (symbol? arg)
- (` (;_lux_lambda (~ g!blank) (~ arg) (~ body')))
- (` (;_lux_lambda (~ g!blank) (~ g!blank)
- (case (~ g!blank) (~ arg) (~ body')))))))
+ (function' [arg body']
+ (if (symbol? arg)
+ (` (;_lux_lambda (~ g!blank) (~ arg) (~ body')))
+ (` (;_lux_lambda (~ g!blank) (~ g!blank)
+ (case (~ g!blank) (~ arg) (~ body')))))))
body
(reverse tail))]
(return (list (if (symbol? head)
@@ -2964,14 +2964,14 @@
[=xs (mapM Monad<Lux>
(: (-> [AST AST] (Lux AST))
(lambda [[k v]]
- (case k
- [_ (#TextS =k)]
- (do Monad<Lux>
- [=v (process-def-meta-value v)]
- (wrap (tuple$ (list (text$ =k) =v))))
-
- _
- (fail (Text/append "Wrong syntax for DictA key: " (ast-to-text k))))))
+ (case k
+ [_ (#TextS =k)]
+ (do Monad<Lux>
+ [=v (process-def-meta-value v)]
+ (wrap (tuple$ (list (text$ =k) =v))))
+
+ _
+ (fail (Text/append "Wrong syntax for DictA key: " (ast-to-text k))))))
kvs)]
(wrap (form$ (list (tag$ ["lux" "DictA"]) (untemplate-list =xs)))))
))
@@ -2984,15 +2984,15 @@
[=kvs (mapM Monad<Lux>
(: (-> [AST AST] (Lux AST))
(lambda [[k v]]
- (case k
- [_ (#TagS [pk nk])]
- (do Monad<Lux>
- [=v (process-def-meta-value v)]
- (wrap (tuple$ (list (tuple$ (list (text$ pk) (text$ nk)))
- =v))))
+ (case k
+ [_ (#TagS [pk nk])]
+ (do Monad<Lux>
+ [=v (process-def-meta-value v)]
+ (wrap (tuple$ (list (tuple$ (list (text$ pk) (text$ nk)))
+ =v))))
- _
- (fail (Text/append "Wrong syntax for Anns: " (ast-to-text ast))))))
+ _
+ (fail (Text/append "Wrong syntax for Anns: " (ast-to-text ast))))))
kvs)]
(wrap (untemplate-list =kvs)))
@@ -3008,14 +3008,14 @@
_
(` (#;Cons [["lux" "func-args"]
(#;ListA (list (~@ (map (lambda [arg]
- (` (#;TextA (~ (text$ (ast-to-text arg))))))
+ (` (#;TextA (~ (text$ (ast-to-text arg))))))
args))))]
(~ meta)))))
(def:' (with-type-args args)
(-> (List AST) AST)
(` {#;type-args (#;ListA (list (~@ (map (lambda [arg]
- (` (#;TextA (~ (text$ (ast-to-text arg))))))
+ (` (#;TextA (~ (text$ (ast-to-text arg))))))
args))))}))
(def:' Export-Level
@@ -3225,18 +3225,18 @@
(mapM Monad<Lux>
(: (-> AST (Lux [Text AST]))
(lambda [token]
- (case token
- (^ [_ (#FormS (list [_ (#SymbolS _ "_lux_:")] type [_ (#SymbolS ["" name])]))])
- (wrap [name type])
+ (case token
+ (^ [_ (#FormS (list [_ (#SymbolS _ "_lux_:")] type [_ (#SymbolS ["" name])]))])
+ (wrap [name type])
- _
- (fail "Signatures require typed members!"))))
+ _
+ (fail "Signatures require typed members!"))))
(List/join sigs')))
#let [[_module _name] name+
def-name (symbol$ name)
sig-type (record$ (map (: (-> [Text AST] [AST AST])
(lambda [[m-name m-type]]
- [(tag$ ["" m-name]) m-type]))
+ [(tag$ ["" m-name]) m-type]))
members))
sig-meta (meta-ast-merge (` {#;sig? true})
meta)
@@ -3468,16 +3468,16 @@
(def: (find-module name)
(-> Text (Lux Module))
(lambda [state]
- (let [{#info info #source source #modules modules
- #scopes scopes #type-vars types #host host
- #seed seed #expected expected #cursor cursor
- #scope-type-vars scope-type-vars} state]
- (case (get name modules)
- (#Some module)
- (#Right state module)
+ (let [{#info info #source source #modules modules
+ #scopes scopes #type-vars types #host host
+ #seed seed #expected expected #cursor cursor
+ #scope-type-vars scope-type-vars} state]
+ (case (get name modules)
+ (#Some module)
+ (#Right state module)
- _
- (#Left ($_ Text/append "Unknown module: " name))))))
+ _
+ (#Left ($_ Text/append "Unknown module: " name))))))
(def: get-current-module
(Lux Module)
@@ -3531,16 +3531,16 @@
(def: get-expected-type
(Lux Type)
(lambda [state]
- (let [{#info info #source source #modules modules
- #scopes scopes #type-vars types #host host
- #seed seed #expected expected #cursor cursor
- #scope-type-vars scope-type-vars} state]
- (case expected
- (#Some type)
- (#Right state type)
+ (let [{#info info #source source #modules modules
+ #scopes scopes #type-vars types #host host
+ #seed seed #expected expected #cursor cursor
+ #scope-type-vars scope-type-vars} state]
+ (case expected
+ (#Some type)
+ (#Right state type)
- #None
- (#Left "Not expecting any type.")))))
+ #None
+ (#Left "Not expecting any type.")))))
(macro: #export (struct tokens)
{#;doc "Not meant to be used directly. Prefer \"struct:\"."}
@@ -3561,17 +3561,17 @@
members (mapM Monad<Lux>
(: (-> AST (Lux [AST AST]))
(lambda [token]
- (case token
- (^ [_ (#FormS (list [_ (#SymbolS _ "_lux_def")] [_ (#SymbolS "" tag-name)] value meta))])
- (case (get tag-name tag-mappings)
- (#Some tag)
- (wrap [tag value])
+ (case token
+ (^ [_ (#FormS (list [_ (#SymbolS _ "_lux_def")] [_ (#SymbolS "" tag-name)] value meta))])
+ (case (get tag-name tag-mappings)
+ (#Some tag)
+ (wrap [tag value])
- _
- (fail (Text/append "Unknown structure member: " tag-name)))
+ _
+ (fail (Text/append "Unknown structure member: " tag-name)))
- _
- (fail "Invalid structure member."))))
+ _
+ (fail "Invalid structure member."))))
(List/join tokens'))]
(wrap (list (record$ members)))))
@@ -3619,12 +3619,12 @@
(case (: (Maybe (List Text))
(mapM Monad<Maybe>
(lambda [sa]
- (case sa
- [_ (#;SymbolS [_ arg-name])]
- (#;Some arg-name)
+ (case sa
+ [_ (#;SymbolS [_ arg-name])]
+ (#;Some arg-name)
- _
- #;None))
+ _
+ #;None))
sig-args))
(^ (#;Some params))
(#;Some (symbol$ ["" ($_ Text/append sig-name "<" (|> params (interpose ",") Text/join) ">")]))
@@ -3725,9 +3725,9 @@
(case tags??
(#Some tags)
(` {#;tags [(~@ (map (: (-> Text AST)
- (lambda' [tag]
- (form$ (list (tag$ ["lux" "TextA"])
- (text$ tag)))))
+ (function' [tag]
+ (form$ (list (tag$ ["lux" "TextA"])
+ (text$ tag)))))
tags))]
#;type? true})
@@ -3790,12 +3790,12 @@
(mapM Monad<Lux>
(: (-> AST (Lux Text))
(lambda [def]
- (case def
- [_ (#SymbolS ["" name])]
- (return name)
+ (case def
+ [_ (#SymbolS ["" name])]
+ (return name)
- _
- (fail "only/exclude requires symbols."))))
+ _
+ (fail "only/exclude requires symbols."))))
defs))
(def: (parse-alias tokens)
@@ -3886,29 +3886,29 @@
(if (|> parts
(map (: (-> AST Bool)
(lambda [part]
- (case part
- (^or [_ (#TextS _)] [_ (#SymbolS _)])
- true
+ (case part
+ (^or [_ (#TextS _)] [_ (#SymbolS _)])
+ true
- _
- false))))
+ _
+ false))))
(fold (lambda [r l] (and l r)) true))
(let [openings (fold (: (-> AST (List Openings) (List Openings))
(lambda [part openings]
- (case part
- [_ (#TextS prefix)]
- (list& [prefix (list)] openings)
-
- [_ (#SymbolS struct-name)]
- (case openings
- #Nil
- (list ["" (list struct-name)])
-
- (#Cons [prefix structs] openings')
- (#Cons [prefix (#Cons struct-name structs)] openings'))
-
- _
- openings)))
+ (case part
+ [_ (#TextS prefix)]
+ (list& [prefix (list)] openings)
+
+ [_ (#SymbolS struct-name)]
+ (case openings
+ #Nil
+ (list ["" (list struct-name)])
+
+ (#Cons [prefix structs] openings')
+ (#Cons [prefix (#Cons struct-name structs)] openings'))
+
+ _
+ openings)))
(: (List Openings) (list))
parts)]
(return [openings tokens']))
@@ -3922,29 +3922,29 @@
(if (|> parts
(map (: (-> AST Bool)
(lambda [part]
- (case part
- (^or [_ (#TextS _)] [_ (#SymbolS _)])
- true
+ (case part
+ (^or [_ (#TextS _)] [_ (#SymbolS _)])
+ true
- _
- false))))
+ _
+ false))))
(fold (lambda [r l] (and l r)) true))
(let [openings (fold (: (-> AST (List Openings) (List Openings))
(lambda [part openings]
- (case part
- [_ (#TextS prefix)]
- (list& [prefix (list)] openings)
-
- [_ (#SymbolS struct-name)]
- (case openings
- #Nil
- (list ["" (list struct-name)])
-
- (#Cons [prefix structs] openings')
- (#Cons [prefix (#Cons struct-name structs)] openings'))
-
- _
- openings)))
+ (case part
+ [_ (#TextS prefix)]
+ (list& [prefix (list)] openings)
+
+ [_ (#SymbolS struct-name)]
+ (case openings
+ #Nil
+ (list ["" (list struct-name)])
+
+ (#Cons [prefix structs] openings')
+ (#Cons [prefix (#Cons struct-name structs)] openings'))
+
+ _
+ openings)))
(: (List Openings) (list))
parts)]
(return [openings (list)]))
@@ -3954,14 +3954,14 @@
(-> Text (List Importation) (List Importation))
(map (: (-> Importation Importation)
(lambda [importation]
- (let [{#import-name _name
- #import-alias _alias
- #import-refer {#refer-defs _referrals
- #refer-open _openings}} importation]
- {#import-name ($_ Text/append super-name "/" _name)
- #import-alias _alias
- #import-refer {#refer-defs _referrals
- #refer-open _openings}})))))
+ (let [{#import-name _name
+ #import-alias _alias
+ #import-refer {#refer-defs _referrals
+ #refer-open _openings}} importation]
+ {#import-name ($_ Text/append super-name "/" _name)
+ #import-alias _alias
+ #import-refer {#refer-defs _referrals
+ #refer-open _openings}})))))
(def: (replace-all pattern value template)
(-> Text Text Text Text)
@@ -3995,60 +3995,60 @@
[imports' (mapM Monad<Lux>
(: (-> AST (Lux (List Importation)))
(lambda [token]
- (case token
- [_ (#SymbolS "" m-name)]
- (do Monad<Lux>
- [m-name (clean-module m-name)]
- (wrap (list [m-name #None {#refer-defs #All
- #refer-open (list)}])))
-
- (^ [_ (#FormS (list& [_ (#SymbolS "" m-name)] extra))])
- (do Monad<Lux>
- [m-name (clean-module m-name)
- alias+extra (parse-alias extra)
- #let [[alias extra] alias+extra]
- referral+extra (parse-referrals extra)
- #let [[referral extra] referral+extra]
- openings+extra (parse-openings extra)
- #let [[openings extra] openings+extra]
- sub-imports (parse-imports extra)
- #let [sub-imports (decorate-sub-importations m-name sub-imports)]]
- (wrap (case [referral alias openings]
- [#Nothing #None #Nil] sub-imports
- _ (list& {#import-name m-name
- #import-alias alias
- #import-refer {#refer-defs referral
- #refer-open openings}}
- sub-imports))))
-
- (^ [_ (#TupleS (list& [_ (#TextS alias)] [_ (#SymbolS "" m-name)] extra))])
- (do Monad<Lux>
- [m-name (clean-module m-name)
- referral+extra (parse-short-referrals extra)
- #let [[referral extra] referral+extra]
- openings+extra (parse-short-openings extra)
- #let [[openings extra] openings+extra]]
- (wrap (list {#import-name m-name
- #import-alias (#;Some (replace-all ";" m-name alias))
- #import-refer {#refer-defs referral
- #refer-open openings}})))
-
- (^ [_ (#TupleS (list& [_ (#SymbolS "" m-name)] extra))])
- (do Monad<Lux>
- [m-name (clean-module m-name)
- referral+extra (parse-short-referrals extra)
- #let [[referral extra] referral+extra]
- openings+extra (parse-short-openings extra)
- #let [[openings extra] openings+extra]]
- (wrap (list {#import-name m-name
- #import-alias (#;Some m-name)
- #import-refer {#refer-defs referral
- #refer-open openings}})))
+ (case token
+ [_ (#SymbolS "" m-name)]
+ (do Monad<Lux>
+ [m-name (clean-module m-name)]
+ (wrap (list [m-name #None {#refer-defs #All
+ #refer-open (list)}])))
+
+ (^ [_ (#FormS (list& [_ (#SymbolS "" m-name)] extra))])
+ (do Monad<Lux>
+ [m-name (clean-module m-name)
+ alias+extra (parse-alias extra)
+ #let [[alias extra] alias+extra]
+ referral+extra (parse-referrals extra)
+ #let [[referral extra] referral+extra]
+ openings+extra (parse-openings extra)
+ #let [[openings extra] openings+extra]
+ sub-imports (parse-imports extra)
+ #let [sub-imports (decorate-sub-importations m-name sub-imports)]]
+ (wrap (case [referral alias openings]
+ [#Nothing #None #Nil] sub-imports
+ _ (list& {#import-name m-name
+ #import-alias alias
+ #import-refer {#refer-defs referral
+ #refer-open openings}}
+ sub-imports))))
+
+ (^ [_ (#TupleS (list& [_ (#TextS alias)] [_ (#SymbolS "" m-name)] extra))])
+ (do Monad<Lux>
+ [m-name (clean-module m-name)
+ referral+extra (parse-short-referrals extra)
+ #let [[referral extra] referral+extra]
+ openings+extra (parse-short-openings extra)
+ #let [[openings extra] openings+extra]]
+ (wrap (list {#import-name m-name
+ #import-alias (#;Some (replace-all ";" m-name alias))
+ #import-refer {#refer-defs referral
+ #refer-open openings}})))
+
+ (^ [_ (#TupleS (list& [_ (#SymbolS "" m-name)] extra))])
+ (do Monad<Lux>
+ [m-name (clean-module m-name)
+ referral+extra (parse-short-referrals extra)
+ #let [[referral extra] referral+extra]
+ openings+extra (parse-short-openings extra)
+ #let [[openings extra] openings+extra]]
+ (wrap (list {#import-name m-name
+ #import-alias (#;Some m-name)
+ #import-refer {#refer-defs referral
+ #refer-open openings}})))
- _
- (do Monad<Lux>
- [current-module current-module-name]
- (fail (Text/append "Wrong syntax for import @ " current-module))))))
+ _
+ (do Monad<Lux>
+ [current-module current-module-name]
+ (fail (Text/append "Wrong syntax for import @ " current-module))))))
imports)]
(wrap (List/join imports'))))
@@ -4065,13 +4065,13 @@
(let [to-alias (map (: (-> [Text Def]
(List Text))
(lambda [[name [def-type def-meta def-value]]]
- (case [(get-meta ["lux" "export?"] def-meta)
- (get-meta ["lux" "hidden?"] def-meta)]
- [(#Some (#BoolA true)) #;None]
- (list name)
+ (case [(get-meta ["lux" "export?"] def-meta)
+ (get-meta ["lux" "hidden?"] def-meta)]
+ [(#Some (#BoolA true)) #;None]
+ (list name)
- _
- (list))))
+ _
+ (list))))
(let [{#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-anns _ #module-state _} =module]
defs))]
(#Right state (List/join to-alias)))
@@ -4094,8 +4094,8 @@
(def: (is-member? cases name)
(-> (List Text) Text Bool)
(let [output (fold (lambda [case prev]
- (or prev
- (Text/= case name)))
+ (or prev
+ (Text/= case name)))
false
cases)]
output))
@@ -4116,15 +4116,15 @@
#scope-type-vars scope-type-vars}
(find (: (-> Scope (Maybe Type))
(lambda [env]
- (case env
- {#name _ #inner-closures _ #locals {#counter _ #mappings locals} #closure {#counter _ #mappings closure}}
- (try-both (find (: (-> [Text Analysis] (Maybe Type))
- (lambda [[bname [[type _] _]]]
- (if (Text/= name bname)
- (#Some type)
- #None))))
- locals
- closure))))
+ (case env
+ {#name _ #inner-closures _ #locals {#counter _ #mappings locals} #closure {#counter _ #mappings closure}}
+ (try-both (find (: (-> [Text Analysis] (Maybe Type))
+ (lambda [[bname [[type _] _]]]
+ (if (Text/= name bname)
+ (#Some type)
+ #None))))
+ locals
+ closure))))
scopes)))
(def: (find-def-type name state)
@@ -4171,25 +4171,25 @@
[#let [[module name] ident]
current-module current-module-name]
(lambda [state]
- (if (Text/= "" module)
- (case (find-in-env name state)
- (#Some struct-type)
- (#Right state struct-type)
+ (if (Text/= "" module)
+ (case (find-in-env name state)
+ (#Some struct-type)
+ (#Right state struct-type)
- _
- (case (find-def-type [current-module name] state)
- (#Some struct-type)
- (#Right state struct-type)
+ _
+ (case (find-def-type [current-module name] state)
+ (#Some struct-type)
+ (#Right state struct-type)
- _
- (#Left ($_ Text/append "Unknown var: " (Ident/encode ident)))))
- (case (find-def-type ident state)
- (#Some struct-type)
- (#Right state struct-type)
+ _
+ (#Left ($_ Text/append "Unknown var: " (Ident/encode ident)))))
+ (case (find-def-type ident state)
+ (#Some struct-type)
+ (#Right state struct-type)
- _
- (#Left ($_ Text/append "Unknown var: " (Ident/encode ident)))))
- )))
+ _
+ (#Left ($_ Text/append "Unknown var: " (Ident/encode ident)))))
+ )))
(def: (zip2 xs ys)
(All [a b] (-> (List a) (List b) (List [a b])))
@@ -4281,26 +4281,26 @@
(do Monad<Lux>
[full-body ((: (-> Ident [(List Ident) (List Type)] AST (Lux AST))
(lambda recur [source [tags members] target]
- (let [pattern (record$ (map (lambda [[t-module t-name]]
- [(tag$ [t-module t-name])
- (symbol$ ["" (Text/append prefix t-name)])])
- tags))]
- (do Monad<Lux>
- [enhanced-target (foldM Monad<Lux>
- (lambda [[[_ m-name] m-type] enhanced-target]
- (do Monad<Lux>
- [m-structure (resolve-type-tags m-type)]
- (case m-structure
- (#;Some m-tags&members)
- (recur ["" (Text/append prefix m-name)]
- m-tags&members
- enhanced-target)
-
- #;None
- (wrap enhanced-target))))
- target
- (zip2 tags members))]
- (wrap (` (;_lux_case (~ (symbol$ source)) (~ pattern) (~ enhanced-target))))))))
+ (let [pattern (record$ (map (lambda [[t-module t-name]]
+ [(tag$ [t-module t-name])
+ (symbol$ ["" (Text/append prefix t-name)])])
+ tags))]
+ (do Monad<Lux>
+ [enhanced-target (foldM Monad<Lux>
+ (lambda [[[_ m-name] m-type] enhanced-target]
+ (do Monad<Lux>
+ [m-structure (resolve-type-tags m-type)]
+ (case m-structure
+ (#;Some m-tags&members)
+ (recur ["" (Text/append prefix m-name)]
+ m-tags&members
+ enhanced-target)
+
+ #;None
+ (wrap enhanced-target))))
+ target
+ (zip2 tags members))]
+ (wrap (` (;_lux_case (~ (symbol$ source)) (~ pattern) (~ enhanced-target))))))))
name tags&members body)]
(wrap (list full-body)))))
@@ -4337,8 +4337,8 @@
(^ (list& else branches'))
(return (list (fold (: (-> [AST AST] AST AST)
(lambda [branch else]
- (let [[right left] branch]
- (` (if (~ left) (~ right) (~ else))))))
+ (let [[right left] branch]
+ (` (if (~ left) (~ right) (~ else))))))
else
(as-pairs branches'))))
@@ -4381,9 +4381,9 @@
(#Some members)
(let [pattern (record$ (map (: (-> [Ident [Nat Type]] [AST AST])
(lambda [[[r-prefix r-name] [r-idx r-type]]]
- [(tag$ [r-prefix r-name]) (if (n.= idx r-idx)
- g!output
- g!_)]))
+ [(tag$ [r-prefix r-name]) (if (n.= idx r-idx)
+ g!output
+ g!_)]))
(zip2 tags (enumerate members))))]
(return (list (` (;_lux_case (~ record) (~ pattern) (~ g!output))))))
@@ -4393,7 +4393,7 @@
(^ (list [_ (#TupleS slots)] record))
(return (list (fold (: (-> AST AST AST)
(lambda [slot inner]
- (` (;;get@ (~ slot) (~ inner)))))
+ (` (;;get@ (~ slot) (~ inner)))))
record
slots)))
@@ -4488,13 +4488,13 @@
current-module current-module-name
#let [test-referrals (: (-> Text (List Text) (List Text) (Lux (List Unit)))
(lambda [module-name all-defs referred-defs]
- (mapM Monad<Lux>
- (: (-> Text (Lux Unit))
- (lambda [_def]
- (if (is-member? all-defs _def)
- (return [])
- (fail ($_ Text/append _def " is not defined in module " module-name " @ " current-module)))))
- referred-defs)))]]
+ (mapM Monad<Lux>
+ (: (-> Text (Lux Unit))
+ (lambda [_def]
+ (if (is-member? all-defs _def)
+ (return [])
+ (fail ($_ Text/append _def " is not defined in module " module-name " @ " current-module)))))
+ referred-defs)))]]
(case options
#;Nil
(wrap {#refer-defs referral
@@ -4513,13 +4513,13 @@
[current-module current-module-name
#let [test-referrals (: (-> Text (List Text) (List Text) (Lux (List Unit)))
(lambda [module-name all-defs referred-defs]
- (mapM Monad<Lux>
- (: (-> Text (Lux Unit))
- (lambda [_def]
- (if (is-member? all-defs _def)
- (return [])
- (fail ($_ Text/append _def " is not defined in module " module-name " @ " current-module)))))
- referred-defs)))]
+ (mapM Monad<Lux>
+ (: (-> Text (Lux Unit))
+ (lambda [_def]
+ (if (is-member? all-defs _def)
+ (return [])
+ (fail ($_ Text/append _def " is not defined in module " module-name " @ " current-module)))))
+ referred-defs)))]
defs' (case r-defs
#All
(exported-defs module-name)
@@ -4540,15 +4540,15 @@
(wrap (list)))
#let [defs (map (: (-> Text AST)
(lambda [def]
- (` (;_lux_def (~ (symbol$ ["" def]))
- (~ (symbol$ [module-name def]))
- (#Cons [["lux" "alias"] (#IdentA [(~ (text$ module-name)) (~ (text$ def))])]
- #Nil)))))
+ (` (;_lux_def (~ (symbol$ ["" def]))
+ (~ (symbol$ [module-name def]))
+ (#Cons [["lux" "alias"] (#IdentA [(~ (text$ module-name)) (~ (text$ def))])]
+ #Nil)))))
defs')
openings (join-map (: (-> Openings (List AST))
(lambda [[prefix structs]]
- (map (lambda [[_ name]] (` (open (~ (symbol$ [module-name name])) (~ (text$ prefix)))))
- structs)))
+ (map (lambda [[_ name]] (` (open (~ (symbol$ [module-name name])) (~ (text$ prefix)))))
+ structs)))
r-opens)]]
(wrap (List/append defs openings))
))
@@ -4581,7 +4581,7 @@
#Nothing
(list)))
=opens (join-map (lambda [[prefix structs]]
- (list& (text$ prefix) (map symbol$ structs)))
+ (list& (text$ prefix) (map symbol$ structs)))
r-opens)]
(` (;;refer (~ (text$ module-name))
(~@ =defs)
@@ -4625,11 +4625,11 @@
imports (parse-imports _imports)
#let [=imports (map (: (-> Importation AST)
(lambda [[m-name m-alias =refer]]
- (` [(~ (text$ m-name)) (~ (text$ (default "" m-alias)))])))
+ (` [(~ (text$ m-name)) (~ (text$ (default "" m-alias)))])))
imports)
=refers (map (: (-> Importation AST)
(lambda [[m-name m-alias =refer]]
- (refer-to-ast m-name =refer)))
+ (refer-to-ast m-name =refer)))
imports)]
=meta (process-def-meta (record$ (list& [(` #;imports) (` [(~@ =imports)])]
_meta)))
@@ -4678,19 +4678,19 @@
[pattern' (mapM Monad<Lux>
(: (-> [Ident [Nat Type]] (Lux [Ident Nat AST]))
(lambda [[r-slot-name [r-idx r-type]]]
- (do Monad<Lux>
- [g!slot (gensym "")]
- (return [r-slot-name r-idx g!slot]))))
+ (do Monad<Lux>
+ [g!slot (gensym "")]
+ (return [r-slot-name r-idx g!slot]))))
(zip2 tags (enumerate members)))]
(let [pattern (record$ (map (: (-> [Ident Nat AST] [AST AST])
(lambda [[r-slot-name r-idx r-var]]
- [(tag$ r-slot-name) r-var]))
+ [(tag$ r-slot-name) r-var]))
pattern'))
output (record$ (map (: (-> [Ident Nat AST] [AST AST])
(lambda [[r-slot-name r-idx r-var]]
- [(tag$ r-slot-name) (if (n.= idx r-idx)
- value
- r-var)]))
+ [(tag$ r-slot-name) (if (n.= idx r-idx)
+ value
+ r-var)]))
pattern'))]
(return (list (` (;_lux_case (~ record) (~ pattern) (~ output)))))))
@@ -4711,13 +4711,13 @@
#let [pairs (zip2 slots bindings)
update-expr (fold (: (-> [AST AST] AST AST)
(lambda [[s b] v]
- (` (;;set@ (~ s) (~ v) (~ b)))))
+ (` (;;set@ (~ s) (~ v) (~ b)))))
value
(reverse pairs))
[_ accesses'] (fold (: (-> [AST AST] [AST (List (List AST))] [AST (List (List AST))])
(lambda [[new-slot new-binding] [old-record accesses']]
- [(` (get@ (~ new-slot) (~ new-binding)))
- (#;Cons (list new-binding old-record) accesses')]))
+ [(` (get@ (~ new-slot) (~ new-binding)))
+ (#;Cons (list new-binding old-record) accesses')]))
[record (: (List (List AST)) #;Nil)]
pairs)
accesses (List/join (reverse accesses'))]]
@@ -4764,19 +4764,19 @@
[pattern' (mapM Monad<Lux>
(: (-> [Ident [Nat Type]] (Lux [Ident Nat AST]))
(lambda [[r-slot-name [r-idx r-type]]]
- (do Monad<Lux>
- [g!slot (gensym "")]
- (return [r-slot-name r-idx g!slot]))))
+ (do Monad<Lux>
+ [g!slot (gensym "")]
+ (return [r-slot-name r-idx g!slot]))))
(zip2 tags (enumerate members)))]
(let [pattern (record$ (map (: (-> [Ident Nat AST] [AST AST])
(lambda [[r-slot-name r-idx r-var]]
- [(tag$ r-slot-name) r-var]))
+ [(tag$ r-slot-name) r-var]))
pattern'))
output (record$ (map (: (-> [Ident Nat AST] [AST AST])
(lambda [[r-slot-name r-idx r-var]]
- [(tag$ r-slot-name) (if (n.= idx r-idx)
- (` ((~ fun) (~ r-var)))
- r-var)]))
+ [(tag$ r-slot-name) (if (n.= idx r-idx)
+ (` ((~ fun) (~ r-var)))
+ r-var)]))
pattern'))]
(return (list (` (;_lux_case (~ record) (~ pattern) (~ output)))))))
@@ -5017,8 +5017,8 @@
(^template [<tag> <open> <close> <prep>]
[group-cursor (<tag> parts)]
(let [[group-cursor' parts-text] (fold (lambda [part [last-cursor text-accum]]
- (let [[part-cursor part-text] (doc-example->Text last-cursor baseline part)]
- [part-cursor (Text/append text-accum part-text)]))
+ (let [[part-cursor part-text] (doc-example->Text last-cursor baseline part)]
+ [part-cursor (Text/append text-accum part-text)]))
[(delim-update-cursor group-cursor) ""]
(<prep> parts))]
[(delim-update-cursor group-cursor')
@@ -5149,7 +5149,7 @@
(return (list (` ((;_lux_: (-> (~@ (map type-to-ast init-types))
(~ (type-to-ast expected)))
(lambda (~ (symbol$ ["" "recur"])) [(~@ vars)]
- (~ body)))
+ (~ body)))
(~@ inits))))))
(do Monad<Lux>
[aliases (mapM Monad<Lux>
@@ -5193,10 +5193,10 @@
(list& hslot tslots))
pattern (record$ (map (: (-> Ident [AST AST])
(lambda [[module name]]
- (let [tag (tag$ [module name])]
- (case (get name slot-pairings)
- (#Some binding) [tag binding]
- #None [tag g!_]))))
+ (let [tag (tag$ [module name])]
+ (case (get name slot-pairings)
+ (#Some binding) [tag binding]
+ #None [tag g!_]))))
tags))]]
(return (list& pattern body branches)))
@@ -5228,15 +5228,15 @@
[=pairs (mapM Monad<Maybe>
(: (-> [AST AST] (Maybe [AST AST]))
(lambda [[slot value]]
- (do Monad<Maybe>
- [slot' (place-tokens label tokens slot)
- value' (place-tokens label tokens value)]
- (case [slot' value']
- (^ [(list =slot) (list =value)])
- (wrap [=slot =value])
+ (do Monad<Maybe>
+ [slot' (place-tokens label tokens slot)
+ value' (place-tokens label tokens value)]
+ (case [slot' value']
+ (^ [(list =slot) (list =value)])
+ (wrap [=slot =value])
- _
- #None))))
+ _
+ #None))))
pairs)]
(wrap (list (record$ =pairs))))
))
@@ -5349,9 +5349,9 @@
[=pairs (mapM Monad<Lux>
(: (-> [AST AST] (Lux [AST AST]))
(lambda [[slot value]]
- (do Monad<Lux>
- [=value (anti-quote value)]
- (wrap [slot =value]))))
+ (do Monad<Lux>
+ [=value (anti-quote value)]
+ (wrap [slot =value]))))
pairs)]
(wrap [meta (#RecordS =pairs)]))
@@ -5414,12 +5414,12 @@
(def: (multi-level-case$ g!_ [[init-pattern levels] body])
(-> AST [MultiLevelCase AST] (List AST))
(let [inner-pattern-body (fold (lambda [[calculation pattern] success]
- (` (case (~ calculation)
- (~ pattern)
- (~ success)
+ (` (case (~ calculation)
+ (~ pattern)
+ (~ success)
- (~ g!_)
- #;None)))
+ (~ g!_)
+ #;None)))
(` (#;Some (~ body)))
(: (List [AST AST]) (reverse levels)))]
(list init-pattern inner-pattern-body)))
@@ -5658,12 +5658,12 @@
(do Monad<Lux>
[args (mapM Monad<Lux>
(lambda [arg']
- (case arg'
- [_ (#SymbolS ["" arg-name])]
- (wrap arg-name)
+ (case arg'
+ [_ (#SymbolS ["" arg-name])]
+ (wrap arg-name)
- _
- (fail "Couldn't parse an argument.")))
+ _
+ (fail "Couldn't parse an argument.")))
args')]
(wrap [[name args] tokens']))
@@ -5720,7 +5720,7 @@
g!compiler (gensym "compiler")
g!_ (gensym "_")
#let [rep-env (map (lambda [arg]
- [arg (` ((~' ~) (~ (symbol$ ["" arg]))))])
+ [arg (` ((~' ~) (~ (symbol$ ["" arg]))))])
args)]]
(wrap (list (` (macro: (~@ (gen-export-level ?export-level))
((~ (symbol$ ["" name])) (~ g!tokens) (~ g!compiler))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-24 02:31:55 +0000