aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2017-10-31 01:53:56 -0400
committerEduardo Julian2017-10-31 01:53:56 -0400
commite0f63b0cfda4d7dd0d233d13ce88b5da889dea02 (patch)
tree77a6a0db4fb096715743961d2efe0e5df256a293 /stdlib
parent89f165331e97d6f0814238fbc7686daac3aa4888 (diff)
- Now, all special forms are handled as procedures.
- "lux case" now takes its branches as a non-empty record.
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux.lux2286
-rw-r--r--stdlib/source/lux/control/comonad.lux8
-rw-r--r--stdlib/source/lux/control/monad.lux14
-rw-r--r--stdlib/source/lux/host.jvm.lux8
-rw-r--r--stdlib/source/lux/meta/syntax.lux8
5 files changed, 1162 insertions, 1162 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index e3a81cebd..6b68b9f29 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -186,39 +186,39 @@
("lux def" Type
(+12 ["lux" "Type"]
("lux case" ("lux check type" (+11 (+6 +1) (+6 +0)))
- Type
- ("lux case" ("lux check type" (+11 Type List))
- Type-List
- ("lux case" ("lux check type" (+4 Type Type))
- Type-Pair
- (+11 Void
- (+9 #Nil
- (+3 ## "lux;Primitive"
- (+4 Text Type-List)
- (+3 ## "lux;Void"
- (+2)
- (+3 ## "lux;Unit"
- (+2)
- (+3 ## "lux;Sum"
- Type-Pair
- (+3 ## "lux;Product"
- Type-Pair
- (+3 ## "lux;Function"
- Type-Pair
- (+3 ## "lux;Bound"
- Nat
- (+3 ## "lux;Var"
- Nat
- (+3 ## "lux;Ex"
- Nat
- (+3 ## "lux;UnivQ"
- (+4 Type-List Type)
- (+3 ## "lux;ExQ"
- (+4 Type-List Type)
- (+3 ## "lux;App"
- Type-Pair
- ## "lux;Named"
- (+4 Ident Type)))))))))))))))))))
+ {Type
+ ("lux case" ("lux check type" (+11 Type List))
+ {Type-List
+ ("lux case" ("lux check type" (+4 Type Type))
+ {Type-Pair
+ (+11 Void
+ (+9 #Nil
+ (+3 ## "lux;Primitive"
+ (+4 Text Type-List)
+ (+3 ## "lux;Void"
+ (+2)
+ (+3 ## "lux;Unit"
+ (+2)
+ (+3 ## "lux;Sum"
+ Type-Pair
+ (+3 ## "lux;Product"
+ Type-Pair
+ (+3 ## "lux;Function"
+ Type-Pair
+ (+3 ## "lux;Bound"
+ Nat
+ (+3 ## "lux;Var"
+ Nat
+ (+3 ## "lux;Ex"
+ Nat
+ (+3 ## "lux;UnivQ"
+ (+4 Type-List Type)
+ (+3 ## "lux;ExQ"
+ (+4 Type-List Type)
+ (+3 ## "lux;App"
+ Type-Pair
+ ## "lux;Named"
+ (+4 Ident Type)))))))))))))))})})}))
[dummy-cursor
(+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])]
[dummy-cursor (+0 true)]]
@@ -339,34 +339,34 @@
("lux case" ("lux check type" (#Apply (#Apply (#Bound +1)
(#Bound +0))
(#Bound +1)))
- Code
- ("lux case" ("lux check type" (#Apply Code List))
- Code-List
- (#UnivQ #Nil
- (#Sum ## "lux;Bool"
- Bool
- (#Sum ## "lux;Nat"
- Nat
- (#Sum ## "lux;Int"
- Int
- (#Sum ## "lux;Deg"
- Deg
- (#Sum ## "lux;Frac"
- Frac
- (#Sum ## "lux;Text"
- Text
- (#Sum ## "lux;Symbol"
- Ident
- (#Sum ## "lux;Tag"
- Ident
- (#Sum ## "lux;Form"
- Code-List
- (#Sum ## "lux;Tuple"
- Code-List
- ## "lux;Record"
- (#Apply (#Product Code Code) List)
- ))))))))))
- ))))
+ {Code
+ ("lux case" ("lux check type" (#Apply Code List))
+ {Code-List
+ (#UnivQ #Nil
+ (#Sum ## "lux;Bool"
+ Bool
+ (#Sum ## "lux;Nat"
+ Nat
+ (#Sum ## "lux;Int"
+ Int
+ (#Sum ## "lux;Deg"
+ Deg
+ (#Sum ## "lux;Frac"
+ Frac
+ (#Sum ## "lux;Text"
+ Text
+ (#Sum ## "lux;Symbol"
+ Ident
+ (#Sum ## "lux;Tag"
+ Ident
+ (#Sum ## "lux;Form"
+ Code-List
+ (#Sum ## "lux;Tuple"
+ Code-List
+ ## "lux;Record"
+ (#Apply (#Product Code Code) List)
+ ))))))))))
+ )})}))
[dummy-cursor
(+10 (#Cons [[dummy-cursor (+7 ["lux" "tags"])]
[dummy-cursor (+9 (#Cons [dummy-cursor (+5 "Bool")]
@@ -394,8 +394,8 @@
("lux def" Code
(#Named ["lux" "Code"]
("lux case" ("lux check type" (#Apply Cursor Ann))
- w
- (#Apply (#Apply w Code') w)))
+ {w
+ (#Apply (#Apply w Code') w)}))
[dummy-cursor
(#Record (#Cons [[dummy-cursor (#Tag ["lux" "doc"])]
[dummy-cursor (#Text "The type of Code nodes for Lux syntax.")]]
@@ -824,51 +824,51 @@
("lux check" Macro
("lux function" _ tokens
("lux case" tokens
- (#Cons lhs (#Cons rhs (#Cons body #Nil)))
- (return (#Cons (form$ (#Cons (text$ "lux case")
- (#Cons rhs (#Cons lhs (#Cons body #Nil)))))
- #Nil))
+ {(#Cons lhs (#Cons rhs (#Cons body #Nil)))
+ (return (#Cons (form$ (#Cons (text$ "lux case")
+ (#Cons rhs (#Cons (record$ (#;Cons [lhs body] #Nil)) #Nil))))
+ #Nil))
- _
- (fail "Wrong syntax for let''"))))
+ _
+ (fail "Wrong syntax for let''")})))
(record$ default-macro-meta))
("lux def" function''
("lux check" Macro
("lux function" _ tokens
("lux case" tokens
- (#Cons [_ (#Tuple (#Cons arg args'))] (#Cons body #Nil))
- (return (#Cons (_ann (#Form (#Cons (_ann (#Text "lux function"))
- (#Cons (_ann (#Symbol "" ""))
- (#Cons arg
- (#Cons ("lux case" args'
- #Nil
- body
-
- _
- (_ann (#Form (#Cons (_ann (#Symbol "lux" "function''"))
- (#Cons (_ann (#Tuple args'))
- (#Cons body #Nil))))))
- #Nil))))))
- #Nil))
-
- (#Cons [_ (#Symbol "" self)] (#Cons [_ (#Tuple (#Cons arg args'))] (#Cons body #Nil)))
- (return (#Cons (_ann (#Form (#Cons (_ann (#Text "lux function"))
- (#Cons (_ann (#Symbol "" self))
- (#Cons arg
- (#Cons ("lux case" args'
- #Nil
- body
-
- _
- (_ann (#Form (#Cons (_ann (#Symbol "lux" "function''"))
- (#Cons (_ann (#Tuple args'))
- (#Cons body #Nil))))))
- #Nil))))))
- #Nil))
-
- _
- (fail "Wrong syntax for function''"))))
+ {(#Cons [_ (#Tuple (#Cons arg args'))] (#Cons body #Nil))
+ (return (#Cons (_ann (#Form (#Cons (_ann (#Text "lux function"))
+ (#Cons (_ann (#Symbol "" ""))
+ (#Cons arg
+ (#Cons ("lux case" args'
+ {#Nil
+ body
+
+ _
+ (_ann (#Form (#Cons (_ann (#Symbol "lux" "function''"))
+ (#Cons (_ann (#Tuple args'))
+ (#Cons body #Nil)))))})
+ #Nil))))))
+ #Nil))
+
+ (#Cons [_ (#Symbol "" self)] (#Cons [_ (#Tuple (#Cons arg args'))] (#Cons body #Nil)))
+ (return (#Cons (_ann (#Form (#Cons (_ann (#Text "lux function"))
+ (#Cons (_ann (#Symbol "" self))
+ (#Cons arg
+ (#Cons ("lux case" args'
+ {#Nil
+ body
+
+ _
+ (_ann (#Form (#Cons (_ann (#Symbol "lux" "function''"))
+ (#Cons (_ann (#Tuple args'))
+ (#Cons body #Nil)))))})
+ #Nil))))))
+ #Nil))
+
+ _
+ (fail "Wrong syntax for function''")})))
(record$ default-macro-meta))
("lux def" cursor-code
@@ -936,69 +936,69 @@
("lux check" Macro
(function'' [tokens]
("lux case" tokens
- (#Cons [[_ (#Tag ["" "export"])]
- (#Cons [[_ (#Form (#Cons [name args]))]
- (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])])
- (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def"))
- (#Cons [name
- (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check"))
- (#Cons [type
- (#Cons [(_ann (#Form (#Cons [(_ann (#Symbol ["lux" "function''"]))
- (#Cons [name
- (#Cons [(_ann (#Tuple args))
- (#Cons [body #Nil])])])])))
- #Nil])])])))
- (#Cons (form$ (#Cons (symbol$ ["lux" "record$"])
- (#Cons (with-export-meta meta)
- #Nil)))
- #Nil)])])])))
- #Nil]))
-
- (#Cons [[_ (#Tag ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])])
- (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def"))
- (#Cons [name
- (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check"))
- (#Cons [type
- (#Cons [body
- #Nil])])])))
- (#Cons (form$ (#Cons (symbol$ ["lux" "record$"])
- (#Cons (with-export-meta meta)
- #Nil)))
- #Nil)])])])))
- #Nil]))
-
- (#Cons [[_ (#Form (#Cons [name args]))]
- (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])
- (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def"))
- (#Cons [name
- (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check"))
- (#Cons [type
- (#Cons [(_ann (#Form (#Cons [(_ann (#Symbol ["lux" "function''"]))
- (#Cons [name
- (#Cons [(_ann (#Tuple args))
- (#Cons [body #Nil])])])])))
- #Nil])])])))
- (#Cons (form$ (#Cons (symbol$ ["lux" "record$"])
- (#Cons meta
- #Nil)))
- #Nil)])])])))
- #Nil]))
-
- (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])
- (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def"))
- (#Cons [name
- (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check"))
- (#Cons [type
- (#Cons [body
- #Nil])])])))
- (#Cons (form$ (#Cons (symbol$ ["lux" "record$"])
- (#Cons meta
- #Nil)))
- #Nil)])])])))
- #Nil]))
+ {(#Cons [[_ (#Tag ["" "export"])]
+ (#Cons [[_ (#Form (#Cons [name args]))]
+ (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])])
+ (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def"))
+ (#Cons [name
+ (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check"))
+ (#Cons [type
+ (#Cons [(_ann (#Form (#Cons [(_ann (#Symbol ["lux" "function''"]))
+ (#Cons [name
+ (#Cons [(_ann (#Tuple args))
+ (#Cons [body #Nil])])])])))
+ #Nil])])])))
+ (#Cons (form$ (#Cons (symbol$ ["lux" "record$"])
+ (#Cons (with-export-meta meta)
+ #Nil)))
+ #Nil)])])])))
+ #Nil]))
+
+ (#Cons [[_ (#Tag ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])])
+ (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def"))
+ (#Cons [name
+ (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check"))
+ (#Cons [type
+ (#Cons [body
+ #Nil])])])))
+ (#Cons (form$ (#Cons (symbol$ ["lux" "record$"])
+ (#Cons (with-export-meta meta)
+ #Nil)))
+ #Nil)])])])))
+ #Nil]))
+
+ (#Cons [[_ (#Form (#Cons [name args]))]
+ (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])
+ (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def"))
+ (#Cons [name
+ (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check"))
+ (#Cons [type
+ (#Cons [(_ann (#Form (#Cons [(_ann (#Symbol ["lux" "function''"]))
+ (#Cons [name
+ (#Cons [(_ann (#Tuple args))
+ (#Cons [body #Nil])])])])))
+ #Nil])])])))
+ (#Cons (form$ (#Cons (symbol$ ["lux" "record$"])
+ (#Cons meta
+ #Nil)))
+ #Nil)])])])))
+ #Nil]))
+
+ (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])
+ (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def"))
+ (#Cons [name
+ (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check"))
+ (#Cons [type
+ (#Cons [body
+ #Nil])])])))
+ (#Cons (form$ (#Cons (symbol$ ["lux" "record$"])
+ (#Cons meta
+ #Nil)))
+ #Nil)])])])))
+ #Nil]))
- _
- (fail "Wrong syntax for def''"))
+ _
+ (fail "Wrong syntax for def''")})
))
(record$ default-macro-meta))
@@ -1006,40 +1006,40 @@
default-macro-meta
Macro
("lux case" tokens
- (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil))
- (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"])
- (#Cons (form$ (#Cons name args))
- (#Cons (with-macro-meta (tag$ ["lux" "Nil"]))
- (#Cons (symbol$ ["lux" "Macro"])
- (#Cons body
- #Nil)))
- )))
- #Nil))
-
- (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil)))
- (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"])
- (#Cons (tag$ ["" "export"])
- (#Cons (form$ (#Cons name args))
- (#Cons (with-macro-meta (tag$ ["lux" "Nil"]))
- (#Cons (symbol$ ["lux" "Macro"])
- (#Cons body
- #Nil)))
- ))))
- #Nil))
-
- (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons meta-data (#Cons body #Nil))))
- (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"])
- (#Cons (tag$ ["" "export"])
- (#Cons (form$ (#Cons name args))
- (#Cons (with-macro-meta meta-data)
- (#Cons (symbol$ ["lux" "Macro"])
- (#Cons body
- #Nil)))
- ))))
- #Nil))
-
- _
- (fail "Wrong syntax for macro:'")))
+ {(#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil))
+ (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"])
+ (#Cons (form$ (#Cons name args))
+ (#Cons (with-macro-meta (tag$ ["lux" "Nil"]))
+ (#Cons (symbol$ ["lux" "Macro"])
+ (#Cons body
+ #Nil)))
+ )))
+ #Nil))
+
+ (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil)))
+ (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"])
+ (#Cons (tag$ ["" "export"])
+ (#Cons (form$ (#Cons name args))
+ (#Cons (with-macro-meta (tag$ ["lux" "Nil"]))
+ (#Cons (symbol$ ["lux" "Macro"])
+ (#Cons body
+ #Nil)))
+ ))))
+ #Nil))
+
+ (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons meta-data (#Cons body #Nil))))
+ (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"])
+ (#Cons (tag$ ["" "export"])
+ (#Cons (form$ (#Cons name args))
+ (#Cons (with-macro-meta meta-data)
+ (#Cons (symbol$ ["lux" "Macro"])
+ (#Cons body
+ #Nil)))
+ ))))
+ #Nil))
+
+ _
+ (fail "Wrong syntax for macro:'")}))
(macro:' #export (comment tokens)
(#Cons [(tag$ ["lux" "doc"])
@@ -1051,18 +1051,18 @@
(macro:' ($' tokens)
("lux case" tokens
- (#Cons x #Nil)
- (return tokens)
-
- (#Cons x (#Cons y xs))
- (return (#Cons (form$ (#Cons (symbol$ ["lux" "$'"])
- (#Cons (form$ (#Cons (tag$ ["lux" "Apply"])
- (#Cons y (#Cons x #Nil))))
- xs)))
- #Nil))
+ {(#Cons x #Nil)
+ (return tokens)
+
+ (#Cons x (#Cons y xs))
+ (return (#Cons (form$ (#Cons (symbol$ ["lux" "$'"])
+ (#Cons (form$ (#Cons (tag$ ["lux" "Apply"])
+ (#Cons y (#Cons x #Nil))))
+ xs)))
+ #Nil))
- _
- (fail "Wrong syntax for $'")))
+ _
+ (fail "Wrong syntax for $'")}))
(def:'' (map f xs)
#;Nil
@@ -1072,11 +1072,11 @@
(#Function ($' List (#Bound +3))
($' List (#Bound +1))))))
("lux case" xs
- #Nil
- #Nil
+ {#Nil
+ #Nil
- (#Cons x xs')
- (#Cons (f x) (map f xs'))))
+ (#Cons x xs')
+ (#Cons (f x) (map f xs'))}))
(def:'' RepEnv
#;Nil
@@ -1087,11 +1087,11 @@
#;Nil
(#Function ($' List Text) (#Function ($' List Code) RepEnv))
("lux case" [xs ys]
- [(#Cons x xs') (#Cons y ys')]
- (#Cons [x y] (make-env xs' ys'))
+ {[(#Cons x xs') (#Cons y ys')]
+ (#Cons [x y] (make-env xs' ys'))
- _
- #Nil))
+ _
+ #Nil}))
(def:'' (text/= x y)
#;Nil
@@ -1102,69 +1102,69 @@
#;Nil
(#Function Text (#Function RepEnv ($' Maybe Code)))
("lux case" env
- #Nil
- #None
+ {#Nil
+ #None
- (#Cons [k v] env')
- ("lux case" (text/= k key)
- true
- (#Some v)
+ (#Cons [k v] env')
+ ("lux case" (text/= k key)
+ {true
+ (#Some v)
- false
- (get-rep key env'))))
+ false
+ (get-rep key env')})}))
(def:'' (replace-syntax reps syntax)
#;Nil
(#Function RepEnv (#Function Code Code))
("lux case" syntax
- [_ (#Symbol "" name)]
- ("lux case" (get-rep name reps)
- (#Some replacement)
- replacement
+ {[_ (#Symbol "" name)]
+ ("lux case" (get-rep name reps)
+ {(#Some replacement)
+ replacement
- #None
- syntax)
+ #None
+ syntax})
- [meta (#Form parts)]
- [meta (#Form (map (replace-syntax reps) parts))]
+ [meta (#Form parts)]
+ [meta (#Form (map (replace-syntax reps) parts))]
- [meta (#Tuple members)]
- [meta (#Tuple (map (replace-syntax reps) members))]
+ [meta (#Tuple members)]
+ [meta (#Tuple (map (replace-syntax reps) members))]
- [meta (#Record slots)]
- [meta (#Record (map ("lux check" (#Function (#Product Code Code) (#Product Code Code))
- (function'' [slot]
- ("lux case" slot
- [k v]
- [(replace-syntax reps k) (replace-syntax reps v)])))
- slots))]
-
- _
- syntax)
+ [meta (#Record slots)]
+ [meta (#Record (map ("lux check" (#Function (#Product Code Code) (#Product Code Code))
+ (function'' [slot]
+ ("lux case" slot
+ {[k v]
+ [(replace-syntax reps k) (replace-syntax reps v)]})))
+ slots))]
+
+ _
+ syntax})
)
(def:'' (update-bounds code)
#;Nil
(#Function Code Code)
("lux case" code
- [_ (#Tuple members)]
- (tuple$ (map update-bounds members))
+ {[_ (#Tuple members)]
+ (tuple$ (map update-bounds members))
- [_ (#Record pairs)]
- (record$ (map ("lux check" (#Function (#Product Code Code) (#Product Code Code))
- (function'' [pair]
- (let'' [name val] pair
- [name (update-bounds val)])))
- pairs))
+ [_ (#Record pairs)]
+ (record$ (map ("lux check" (#Function (#Product Code Code) (#Product Code Code))
+ (function'' [pair]
+ (let'' [name val] pair
+ [name (update-bounds val)])))
+ pairs))
- [_ (#Form (#Cons [_ (#Tag "lux" "Bound")] (#Cons [_ (#Nat idx)] #Nil)))]
- (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ (_lux_proc ["nat" "+"] [+2 idx])) #Nil)))
+ [_ (#Form (#Cons [_ (#Tag "lux" "Bound")] (#Cons [_ (#Nat idx)] #Nil)))]
+ (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ (_lux_proc ["nat" "+"] [+2 idx])) #Nil)))
- [_ (#Form members)]
- (form$ (map update-bounds members))
+ [_ (#Form members)]
+ (form$ (map update-bounds members))
- _
- code))
+ _
+ code}))
(def:'' (parse-quantified-args args next)
#;Nil
@@ -1174,14 +1174,14 @@
(#Apply ($' List Code) Meta)
))
("lux case" args
- #Nil
- (next #Nil)
+ {#Nil
+ (next #Nil)
- (#Cons [_ (#Symbol "" arg-name)] args')
- (parse-quantified-args args' (function'' [names] (next (#Cons arg-name names))))
+ (#Cons [_ (#Symbol "" arg-name)] args')
+ (parse-quantified-args args' (function'' [names] (next (#Cons arg-name names))))
- _
- (fail "Expected symbol.")
+ _
+ (fail "Expected symbol.")}
))
(def:'' (make-bound idx)
@@ -1199,11 +1199,11 @@
(#Function ($' List (#Bound +1))
(#Bound +3))))))
("lux case" xs
- #Nil
- init
+ {#Nil
+ init
- (#Cons x xs')
- (fold f (f x init) xs')))
+ (#Cons x xs')
+ (fold f (f x init) xs')}))
(def:'' (length list)
#;Nil
@@ -1223,42 +1223,42 @@
[a (List a)]))")]
#;Nil)
(let'' [self-name tokens] ("lux case" tokens
- (#Cons [_ (#Symbol "" self-name)] tokens)
- [self-name tokens]
+ {(#Cons [_ (#Symbol "" self-name)] tokens)
+ [self-name tokens]
- _
- ["" tokens])
+ _
+ ["" tokens]})
("lux case" tokens
- (#Cons [_ (#Tuple args)] (#Cons body #Nil))
- (parse-quantified-args args
- (function'' [names]
- (let'' body' (fold ("lux check" (#Function Text (#Function Code Code))
- (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"))
+ {(#Cons [_ (#Tuple args)] (#Cons body #Nil))
+ (parse-quantified-args args
+ (function'' [names]
+ (let'' body' (fold ("lux check" (#Function Text (#Function Code Code))
+ (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")})
))
(macro:' #export (Ex tokens)
@@ -1275,42 +1275,42 @@
(List (Self a))])")]
#;Nil)
(let'' [self-name tokens] ("lux case" tokens
- (#Cons [_ (#Symbol "" self-name)] tokens)
- [self-name tokens]
+ {(#Cons [_ (#Symbol "" self-name)] tokens)
+ [self-name tokens]
- _
- ["" tokens])
+ _
+ ["" tokens]})
("lux case" tokens
- (#Cons [_ (#Tuple args)] (#Cons body #Nil))
- (parse-quantified-args args
- (function'' [names]
- (let'' body' (fold ("lux check" (#Function Text (#Function Code Code))
- (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"))
+ {(#Cons [_ (#Tuple args)] (#Cons body #Nil))
+ (parse-quantified-args args
+ (function'' [names]
+ (let'' body' (fold ("lux check" (#Function Text (#Function Code Code))
+ (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")})
))
(def:'' (reverse list)
@@ -1328,15 +1328,15 @@
## This is the type of a function that takes 2 Ints and returns an Int.")]
#;Nil)
("lux case" (reverse tokens)
- (#Cons output inputs)
- (return (#Cons (fold ("lux check" (#Function Code (#Function Code Code))
- (function'' [i o] (form$ (#Cons (tag$ ["lux" "Function"]) (#Cons i (#Cons o #Nil))))))
- output
- inputs)
- #Nil))
-
- _
- (fail "Wrong syntax for ->")))
+ {(#Cons output inputs)
+ (return (#Cons (fold ("lux check" (#Function Code (#Function Code Code))
+ (function'' [i o] (form$ (#Cons (tag$ ["lux" "Function"]) (#Cons i (#Cons o #Nil))))))
+ output
+ inputs)
+ #Nil))
+
+ _
+ (fail "Wrong syntax for ->")}))
(macro:' #export (list xs)
(#Cons [(tag$ ["lux" "doc"])
@@ -1358,15 +1358,15 @@
(list& 1 2 3 (list 4 5 6))")]
#;Nil)
("lux case" (reverse xs)
- (#Cons last init)
- (return (list (fold (function'' [head tail]
- (form$ (list (tag$ ["lux" "Cons"])
- (tuple$ (list head tail)))))
- last
- init)))
+ {(#Cons last init)
+ (return (list (fold (function'' [head tail]
+ (form$ (list (tag$ ["lux" "Cons"])
+ (tuple$ (list head tail)))))
+ last
+ init)))
- _
- (fail "Wrong syntax for list&")))
+ _
+ (fail "Wrong syntax for list&")}))
(macro:' #export (& tokens)
(#Cons [(tag$ ["lux" "doc"])
@@ -1377,13 +1377,13 @@
(&)")]
#;Nil)
("lux case" (reverse tokens)
- #Nil
- (return (list (tag$ ["lux" "Unit"])))
+ {#Nil
+ (return (list (tag$ ["lux" "Unit"])))
- (#Cons last prevs)
- (return (list (fold (function'' [left right] (form$ (list (tag$ ["lux" "Product"]) left right)))
- last
- prevs)))
+ (#Cons last prevs)
+ (return (list (fold (function'' [left right] (form$ (list (tag$ ["lux" "Product"]) left right)))
+ last
+ prevs)))}
))
(macro:' #export (| tokens)
@@ -1395,143 +1395,143 @@
(|)")]
#;Nil)
("lux case" (reverse tokens)
- #Nil
- (return (list (tag$ ["lux" "Void"])))
+ {#Nil
+ (return (list (tag$ ["lux" "Void"])))
- (#Cons last prevs)
- (return (list (fold (function'' [left right] (form$ (list (tag$ ["lux" "Sum"]) left right)))
- last
- prevs)))
+ (#Cons last prevs)
+ (return (list (fold (function'' [left right] (form$ (list (tag$ ["lux" "Sum"]) left right)))
+ last
+ prevs)))}
))
(macro:' (function' tokens)
(let'' [name tokens'] ("lux case" tokens
- (#Cons [[_ (#Symbol ["" name])] tokens'])
- [name tokens']
+ {(#Cons [[_ (#Symbol ["" name])] tokens'])
+ [name tokens']
- _
- ["" tokens])
+ _
+ ["" tokens]})
("lux case" tokens'
- (#Cons [[_ (#Tuple args)] (#Cons [body #Nil])])
- ("lux case" args
- #Nil
- (fail "function' requires a non-empty arguments tuple.")
-
- (#Cons [harg targs])
- (return (list (form$ (list (text$ "lux function")
- (symbol$ ["" name])
- harg
- (fold (function'' [arg body']
- (form$ (list (text$ "lux function")
- (symbol$ ["" ""])
- arg
- body')))
- body
- (reverse targs)))))))
+ {(#Cons [[_ (#Tuple args)] (#Cons [body #Nil])])
+ ("lux case" args
+ {#Nil
+ (fail "function' requires a non-empty arguments tuple.")
+
+ (#Cons [harg targs])
+ (return (list (form$ (list (text$ "lux function")
+ (symbol$ ["" name])
+ harg
+ (fold (function'' [arg body']
+ (form$ (list (text$ "lux function")
+ (symbol$ ["" ""])
+ arg
+ body')))
+ body
+ (reverse targs))))))})
- _
- (fail "Wrong syntax for function'"))))
+ _
+ (fail "Wrong syntax for function'")})))
(macro:' (def:''' tokens)
("lux case" tokens
- (#Cons [[_ (#Tag ["" "export"])]
- (#Cons [[_ (#Form (#Cons [name args]))]
- (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])])
- (return (list (form$ (list (text$ "lux def")
- name
- (form$ (list (text$ "lux check")
- type
- (form$ (list (symbol$ ["lux" "function'"])
- name
- (tuple$ args)
- body))))
- (form$ (#Cons (symbol$ ["lux" "record$"])
- (#Cons (with-export-meta meta)
- #Nil)))))))
-
- (#Cons [[_ (#Tag ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])])
- (return (list (form$ (list (text$ "lux def")
- name
- (form$ (list (text$ "lux check")
- type
- body))
- (form$ (#Cons (symbol$ ["lux" "record$"])
- (#Cons (with-export-meta meta)
- #Nil)))))))
-
- (#Cons [[_ (#Form (#Cons [name args]))]
- (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])
- (return (list (form$ (list (text$ "lux def")
- name
- (form$ (list (text$ "lux check")
- type
- (form$ (list (symbol$ ["lux" "function'"])
- name
- (tuple$ args)
- body))))
- (form$ (#Cons (symbol$ ["lux" "record$"])
- (#Cons meta
- #Nil)))))))
-
- (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])
- (return (list (form$ (list (text$ "lux def")
- name
- (form$ (list (text$ "lux check") type body))
- (form$ (#Cons (symbol$ ["lux" "record$"])
- (#Cons meta
- #Nil)))))))
-
- _
- (fail "Wrong syntax for def'''")
+ {(#Cons [[_ (#Tag ["" "export"])]
+ (#Cons [[_ (#Form (#Cons [name args]))]
+ (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])])
+ (return (list (form$ (list (text$ "lux def")
+ name
+ (form$ (list (text$ "lux check")
+ type
+ (form$ (list (symbol$ ["lux" "function'"])
+ name
+ (tuple$ args)
+ body))))
+ (form$ (#Cons (symbol$ ["lux" "record$"])
+ (#Cons (with-export-meta meta)
+ #Nil)))))))
+
+ (#Cons [[_ (#Tag ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])])
+ (return (list (form$ (list (text$ "lux def")
+ name
+ (form$ (list (text$ "lux check")
+ type
+ body))
+ (form$ (#Cons (symbol$ ["lux" "record$"])
+ (#Cons (with-export-meta meta)
+ #Nil)))))))
+
+ (#Cons [[_ (#Form (#Cons [name args]))]
+ (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])
+ (return (list (form$ (list (text$ "lux def")
+ name
+ (form$ (list (text$ "lux check")
+ type
+ (form$ (list (symbol$ ["lux" "function'"])
+ name
+ (tuple$ args)
+ body))))
+ (form$ (#Cons (symbol$ ["lux" "record$"])
+ (#Cons meta
+ #Nil)))))))
+
+ (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])
+ (return (list (form$ (list (text$ "lux def")
+ name
+ (form$ (list (text$ "lux check") type body))
+ (form$ (#Cons (symbol$ ["lux" "record$"])
+ (#Cons meta
+ #Nil)))))))
+
+ _
+ (fail "Wrong syntax for def'''")}
))
(def:''' (as-pairs xs)
#;Nil
(All [a] (-> ($' List a) ($' List (& a a))))
("lux case" xs
- (#Cons x (#Cons y xs'))
- (#Cons [x y] (as-pairs xs'))
+ {(#Cons x (#Cons y xs'))
+ (#Cons [x y] (as-pairs xs'))
- _
- #Nil))
+ _
+ #Nil}))
(macro:' (let' tokens)
("lux case" tokens
- (#Cons [[_ (#Tuple bindings)] (#Cons [body #Nil])])
- (return (list (fold ("lux check" (-> (& Code Code) Code
- Code)
- (function' [binding body]
- ("lux case" binding
- [label value]
- (form$ (list (text$ "lux case") value label body)))))
- body
- (reverse (as-pairs bindings)))))
+ {(#Cons [[_ (#Tuple bindings)] (#Cons [body #Nil])])
+ (return (list (fold ("lux check" (-> (& Code Code) Code
+ Code)
+ (function' [binding body]
+ ("lux case" binding
+ {[label value]
+ (form$ (list (text$ "lux case") value (record$ (list [label body]))))})))
+ body
+ (reverse (as-pairs bindings)))))
- _
- (fail "Wrong syntax for let'")))
+ _
+ (fail "Wrong syntax for let'")}))
(def:''' (any? p xs)
#;Nil
(All [a]
(-> (-> a Bool) ($' List a) Bool))
("lux case" xs
- #Nil
- false
+ {#Nil
+ false
- (#Cons x xs')
- ("lux case" (p x)
- true true
- false (any? p xs'))))
+ (#Cons x xs')
+ ("lux case" (p x)
+ {true true
+ false (any? p xs')})}))
(def:''' (spliced? token)
#;Nil
(-> Code Bool)
("lux case" token
- [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [_ #Nil])]))]
- true
+ {[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [_ #Nil])]))]
+ true
- _
- false))
+ _
+ false}))
(def:''' (wrap-meta content)
#;Nil
@@ -1543,21 +1543,21 @@
#;Nil
(-> ($' List Code) Code)
("lux case" tokens
- #Nil
- (_ann (#Tag ["lux" "Nil"]))
+ {#Nil
+ (_ann (#Tag ["lux" "Nil"]))
- (#Cons [token tokens'])
- (_ann (#Form (list (_ann (#Tag ["lux" "Cons"])) token (untemplate-list tokens'))))))
+ (#Cons [token tokens'])
+ (_ann (#Form (list (_ann (#Tag ["lux" "Cons"])) token (untemplate-list tokens'))))}))
(def:''' (list/compose xs ys)
#;Nil
(All [a] (-> ($' List a) ($' List a) ($' List a)))
("lux case" xs
- (#Cons x xs')
- (#Cons x (list/compose xs' ys))
+ {(#Cons x xs')
+ (#Cons x (list/compose xs' ys))
- #Nil
- ys))
+ #Nil
+ ys}))
(def:''' #export (splice-helper xs ys)
(#Cons [(tag$ ["lux" "hidden?"])
@@ -1565,21 +1565,21 @@
#;Nil)
(-> ($' List Code) ($' List Code) ($' List Code))
("lux case" xs
- (#Cons x xs')
- (#Cons x (splice-helper xs' ys))
+ {(#Cons x xs')
+ (#Cons x (splice-helper xs' ys))
- #Nil
- ys))
+ #Nil
+ ys}))
(def:''' (_$_joiner op a1 a2)
#;Nil
(-> Code Code Code Code)
("lux case" op
- [_ (#Form parts)]
- (form$ (list/compose parts (list a1 a2)))
+ {[_ (#Form parts)]
+ (form$ (list/compose parts (list a1 a2)))
- _
- (form$ (list op a1 a2))))
+ _
+ (form$ (list op a1 a2))}))
(macro:' #export (_$ tokens)
(#Cons [(tag$ ["lux" "doc"])
@@ -1590,16 +1590,16 @@
(text/compose (text/compose \"Hello, \" name) \".\\nHow are you?\")")]
#;Nil)
("lux case" tokens
- (#Cons op tokens')
- ("lux case" tokens'
- (#Cons first nexts)
- (return (list (fold (_$_joiner op) first nexts)))
+ {(#Cons op tokens')
+ ("lux case" tokens'
+ {(#Cons first nexts)
+ (return (list (fold (_$_joiner op) first nexts)))
+ _
+ (fail "Wrong syntax for _$")})
+
_
- (fail "Wrong syntax for _$"))
-
- _
- (fail "Wrong syntax for _$")))
+ (fail "Wrong syntax for _$")}))
(macro:' #export ($_ tokens)
(#Cons [(tag$ ["lux" "doc"])
@@ -1610,16 +1610,16 @@
(text/compose \"Hello, \" (text/compose name \".\\nHow are you?\"))")]
#;Nil)
("lux case" tokens
- (#Cons op tokens')
- ("lux case" (reverse tokens')
- (#Cons last prevs)
- (return (list (fold (_$_joiner op) last prevs)))
+ {(#Cons op tokens')
+ ("lux case" (reverse tokens')
+ {(#Cons last prevs)
+ (return (list (fold (_$_joiner op) last prevs)))
+ _
+ (fail "Wrong syntax for $_")})
+
_
- (fail "Wrong syntax for $_"))
-
- _
- (fail "Wrong syntax for $_")))
+ (fail "Wrong syntax for $_")}))
## (sig: (Monad m)
## (: (All [a] (-> a (m a)))
@@ -1647,8 +1647,8 @@
#bind
(function' [f ma]
("lux case" ma
- #None #None
- (#Some a) (f a)))})
+ {#None #None
+ (#Some a) (f a)}))})
(def:''' Monad<Meta>
#Nil
@@ -1662,37 +1662,37 @@
(function' [f ma]
(function' [state]
("lux case" (ma state)
- (#Left msg)
- (#Left msg)
+ {(#Left msg)
+ (#Left msg)
- (#Right state' a)
- (f a state'))))})
+ (#Right state' a)
+ (f a state')})))})
(macro:' (do tokens)
("lux case" tokens
- (#Cons monad (#Cons [_ (#Tuple bindings)] (#Cons body #Nil)))
- (let' [g!wrap (symbol$ ["" "wrap"])
- g!bind (symbol$ ["" " bind "])
- body' (fold ("lux check" (-> (& Code Code) Code Code)
- (function' [binding body']
- (let' [[var value] binding]
- ("lux case" var
- [_ (#Tag "" "let")]
- (form$ (list (symbol$ ["lux" "let'"]) value body'))
-
- _
- (form$ (list g!bind
- (form$ (list (text$ "lux function") (symbol$ ["" ""]) var body'))
- value))))))
- body
- (reverse (as-pairs bindings)))]
- (return (list (form$ (list (text$ "lux case")
- monad
- (record$ (list [(tag$ ["lux" "wrap"]) g!wrap] [(tag$ ["lux" "bind"]) g!bind]))
- body')))))
+ {(#Cons monad (#Cons [_ (#Tuple bindings)] (#Cons body #Nil)))
+ (let' [g!wrap (symbol$ ["" "wrap"])
+ g!bind (symbol$ ["" " bind "])
+ body' (fold ("lux check" (-> (& Code Code) Code Code)
+ (function' [binding body']
+ (let' [[var value] binding]
+ ("lux case" var
+ {[_ (#Tag "" "let")]
+ (form$ (list (symbol$ ["lux" "let'"]) value body'))
+
+ _
+ (form$ (list g!bind
+ (form$ (list (text$ "lux function") (symbol$ ["" ""]) var body'))
+ value))}))))
+ body
+ (reverse (as-pairs bindings)))]
+ (return (list (form$ (list (text$ "lux case")
+ monad
+ (record$ (list [(record$ (list [(tag$ ["lux" "wrap"]) g!wrap] [(tag$ ["lux" "bind"]) g!bind]))
+ body'])))))))
- _
- (fail "Wrong syntax for do")))
+ _
+ (fail "Wrong syntax for do")}))
(def:''' (mapM m f xs)
#Nil
@@ -1705,14 +1705,14 @@
($' m ($' List b))))
(let' [{#;wrap wrap #;bind _} m]
("lux case" xs
- #Nil
- (wrap #Nil)
-
- (#Cons x xs')
- (do m
- [y (f x)
- ys (mapM m f xs')]
- (wrap (#Cons y ys)))
+ {#Nil
+ (wrap #Nil)
+
+ (#Cons x xs')
+ (do m
+ [y (f x)
+ ys (mapM m f xs')]
+ (wrap (#Cons y ys)))}
)))
(macro:' #export (if tokens)
@@ -1725,39 +1725,39 @@
=> \"Oh, yeah!\"")])
("lux case" tokens
- (#Cons test (#Cons then (#Cons else #Nil)))
- (return (list (form$ (list (text$ "lux case") test
- (bool$ true) then
- (bool$ false) else))))
+ {(#Cons test (#Cons then (#Cons else #Nil)))
+ (return (list (form$ (list (text$ "lux case") test
+ (record$ (list [(bool$ true) then]
+ [(bool$ false) else]))))))
- _
- (fail "Wrong syntax for if")))
+ _
+ (fail "Wrong syntax for if")}))
(def:''' (get k plist)
#Nil
(All [a]
(-> Text ($' List (& Text a)) ($' Maybe a)))
("lux case" plist
- (#Cons [[k' v] plist'])
- (if (text/= k k')
- (#Some v)
- (get k plist'))
+ {(#Cons [[k' v] plist'])
+ (if (text/= k k')
+ (#Some v)
+ (get k plist'))
- #Nil
- #None))
+ #Nil
+ #None}))
(def:''' (put k v dict)
#Nil
(All [a]
(-> Text a ($' List (& Text a)) ($' List (& Text a))))
("lux case" dict
- #Nil
- (list [k v])
+ {#Nil
+ (list [k v])
- (#Cons [[k' v'] dict'])
- (if (text/= k k')
- (#Cons [[k' v] dict'])
- (#Cons [[k' v'] (put k v dict')]))))
+ (#Cons [[k' v'] dict'])
+ (if (text/= k k')
+ (#Cons [[k' v] dict'])
+ (#Cons [[k' v'] (put k v dict')]))}))
(def:''' #export (log! message)
(list [(tag$ ["lux" "doc"])
@@ -1777,35 +1777,35 @@
(-> Ident Text)
(let' [[module name] ident]
("lux case" module
- "" name
- _ ($_ text/compose module ";" name))))
+ {"" name
+ _ ($_ text/compose module ";" name)})))
(def:''' (get-meta tag def-meta)
#Nil
(-> Ident Code ($' Maybe Code))
(let' [[prefix name] tag]
("lux case" def-meta
- [_ (#Record def-meta)]
- ("lux case" def-meta
- (#Cons [key value] def-meta')
- ("lux case" key
- [_ (#Tag [prefix' name'])]
- ("lux case" [(text/= prefix prefix')
- (text/= name name')]
- [true true]
- (#Some value)
+ {[_ (#Record def-meta)]
+ ("lux case" def-meta
+ {(#Cons [key value] def-meta')
+ ("lux case" key
+ {[_ (#Tag [prefix' name'])]
+ ("lux case" [(text/= prefix prefix')
+ (text/= name name')]
+ {[true true]
+ (#Some value)
- _
- (get-meta tag (record$ def-meta')))
+ _
+ (get-meta tag (record$ def-meta'))})
- _
- (get-meta tag (record$ def-meta')))
+ _
+ (get-meta tag (record$ def-meta'))})
- #Nil
- #None)
+ #Nil
+ #None})
- _
- #None)))
+ _
+ #None})))
(def:''' (resolve-global-symbol ident state)
#Nil
@@ -1816,136 +1816,136 @@
#seed seed #expected expected #cursor cursor
#scope-type-vars scope-type-vars} state]
("lux case" (get module modules)
- (#Some {#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-annotations _ #module-state _})
- ("lux case" (get name defs)
- (#Some [def-type def-meta def-value])
- ("lux case" (get-meta ["lux" "alias"] def-meta)
- (#Some [_ (#Symbol real-name)])
- (#Right [state real-name])
+ {(#Some {#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-annotations _ #module-state _})
+ ("lux case" (get name defs)
+ {(#Some [def-type def-meta def-value])
+ ("lux case" (get-meta ["lux" "alias"] def-meta)
+ {(#Some [_ (#Symbol real-name)])
+ (#Right [state real-name])
- _
- (#Right [state ident]))
+ _
+ (#Right [state ident])})
+ #None
+ (#Left ($_ text/compose "Unknown definition: " (ident/encode ident)))})
+
#None
- (#Left ($_ text/compose "Unknown definition: " (ident/encode ident))))
-
- #None
- (#Left ($_ text/compose "Unknown module: " module " @ " (ident/encode ident))))))
+ (#Left ($_ text/compose "Unknown module: " module " @ " (ident/encode ident)))})))
(def:''' (splice replace? untemplate tag elems)
#Nil
(-> Bool (-> Code ($' Meta Code)) Code ($' List Code) ($' Meta Code))
("lux case" replace?
- true
- ("lux case" (any? spliced? elems)
- true
- (do Monad<Meta>
- [elems' ("lux check" ($' Meta ($' List Code))
- (mapM Monad<Meta>
- ("lux check" (-> Code ($' Meta Code))
- (function' [elem]
- ("lux case" elem
- [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))]
- (wrap spliced)
-
- _
- (do Monad<Meta>
- [=elem (untemplate elem)]
- (wrap (form$ (list (text$ "lux check")
- (form$ (list (tag$ ["lux" "Apply"]) (tuple$ (list (symbol$ ["lux" "Code"]) (symbol$ ["lux" "List"])))))
- (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list =elem (tag$ ["lux" "Nil"]))))))))))))
- elems))]
- (wrap (wrap-meta (form$ (list tag
- (form$ (list& (symbol$ ["lux" "$_"])
- (symbol$ ["lux" "splice-helper"])
- elems')))))))
-
+ {true
+ ("lux case" (any? spliced? elems)
+ {true
+ (do Monad<Meta>
+ [elems' ("lux check" ($' Meta ($' List Code))
+ (mapM Monad<Meta>
+ ("lux check" (-> Code ($' Meta Code))
+ (function' [elem]
+ ("lux case" elem
+ {[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))]
+ (wrap spliced)
+
+ _
+ (do Monad<Meta>
+ [=elem (untemplate elem)]
+ (wrap (form$ (list (text$ "lux check")
+ (form$ (list (tag$ ["lux" "Apply"]) (tuple$ (list (symbol$ ["lux" "Code"]) (symbol$ ["lux" "List"])))))
+ (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list =elem (tag$ ["lux" "Nil"])))))))))})))
+ elems))]
+ (wrap (wrap-meta (form$ (list tag
+ (form$ (list& (symbol$ ["lux" "$_"])
+ (symbol$ ["lux" "splice-helper"])
+ elems')))))))
+
+ false
+ (do Monad<Meta>
+ [=elems (mapM Monad<Meta> untemplate elems)]
+ (wrap (wrap-meta (form$ (list tag (untemplate-list =elems))))))})
false
(do Monad<Meta>
[=elems (mapM Monad<Meta> untemplate elems)]
- (wrap (wrap-meta (form$ (list tag (untemplate-list =elems)))))))
- false
- (do Monad<Meta>
- [=elems (mapM Monad<Meta> untemplate elems)]
- (wrap (wrap-meta (form$ (list tag (untemplate-list =elems))))))))
+ (wrap (wrap-meta (form$ (list tag (untemplate-list =elems))))))}))
(def:''' (untemplate replace? subst token)
#Nil
(-> Bool Text Code ($' Meta Code))
("lux case" [replace? token]
- [_ [_ (#Bool value)]]
- (return (wrap-meta (form$ (list (tag$ ["lux" "Bool"]) (bool$ value)))))
+ {[_ [_ (#Bool value)]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "Bool"]) (bool$ value)))))
- [_ [_ (#Nat value)]]
- (return (wrap-meta (form$ (list (tag$ ["lux" "Nat"]) (nat$ value)))))
+ [_ [_ (#Nat value)]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "Nat"]) (nat$ value)))))
- [_ [_ (#Int value)]]
- (return (wrap-meta (form$ (list (tag$ ["lux" "Int"]) (int$ value)))))
+ [_ [_ (#Int value)]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "Int"]) (int$ value)))))
- [_ [_ (#Deg value)]]
- (return (wrap-meta (form$ (list (tag$ ["lux" "Deg"]) (deg$ value)))))
-
- [_ [_ (#Frac value)]]
- (return (wrap-meta (form$ (list (tag$ ["lux" "Frac"]) (frac$ value)))))
+ [_ [_ (#Deg value)]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "Deg"]) (deg$ value)))))
+
+ [_ [_ (#Frac value)]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "Frac"]) (frac$ value)))))
+
+ [_ [_ (#Text value)]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "Text"]) (text$ value)))))
- [_ [_ (#Text value)]]
- (return (wrap-meta (form$ (list (tag$ ["lux" "Text"]) (text$ value)))))
+ [false [_ (#Tag [module name])]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module) (text$ name)))))))
- [false [_ (#Tag [module name])]]
- (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module) (text$ name)))))))
+ [true [_ (#Tag [module name])]]
+ (let' [module' ("lux case" module
+ {""
+ subst
+
+ _
+ module})]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module') (text$ name))))))))
- [true [_ (#Tag [module name])]]
- (let' [module' ("lux case" module
- ""
- subst
+ [true [_ (#Symbol [module name])]]
+ (do Monad<Meta>
+ [real-name ("lux case" module
+ {""
+ (if (text/= "" subst)
+ (wrap [module name])
+ (resolve-global-symbol [subst name]))
_
- module)]
- (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module') (text$ name))))))))
-
- [true [_ (#Symbol [module name])]]
- (do Monad<Meta>
- [real-name ("lux case" module
- ""
- (if (text/= "" subst)
- (wrap [module name])
- (resolve-global-symbol [subst name]))
-
- _
- (wrap [module name]))
- #let [[module name] real-name]]
- (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (tuple$ (list (text$ module) (text$ name))))))))
-
- [false [_ (#Symbol [module name])]]
- (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (tuple$ (list (text$ module) (text$ name)))))))
-
- [_ [_ (#Tuple elems)]]
- (splice replace? (untemplate replace? subst) (tag$ ["lux" "Tuple"]) elems)
-
- [true [_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))]]
- (return unquoted)
-
- [true [_ (#Form (#Cons [[_ (#Symbol ["" "~'"])] (#Cons [keep-quoted #Nil])]))]]
- (untemplate false subst keep-quoted)
-
- [_ [meta (#Form elems)]]
- (do Monad<Meta>
- [output (splice replace? (untemplate replace? subst) (tag$ ["lux" "Form"]) elems)
- #let [[_ form'] output]]
- (return [meta form']))
-
- [_ [_ (#Record fields)]]
- (do Monad<Meta>
- [=fields (mapM Monad<Meta>
- ("lux check" (-> (& Code Code) ($' Meta Code))
- (function' [kv]
- (let' [[k v] kv]
- (do Monad<Meta>
- [=k (untemplate replace? subst k)
- =v (untemplate replace? subst v)]
- (wrap (tuple$ (list =k =v)))))))
- fields)]
- (wrap (wrap-meta (form$ (list (tag$ ["lux" "Record"]) (untemplate-list =fields))))))
+ (wrap [module name])})
+ #let [[module name] real-name]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (tuple$ (list (text$ module) (text$ name))))))))
+
+ [false [_ (#Symbol [module name])]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (tuple$ (list (text$ module) (text$ name)))))))
+
+ [_ [_ (#Tuple elems)]]
+ (splice replace? (untemplate replace? subst) (tag$ ["lux" "Tuple"]) elems)
+
+ [true [_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))]]
+ (return unquoted)
+
+ [true [_ (#Form (#Cons [[_ (#Symbol ["" "~'"])] (#Cons [keep-quoted #Nil])]))]]
+ (untemplate false subst keep-quoted)
+
+ [_ [meta (#Form elems)]]
+ (do Monad<Meta>
+ [output (splice replace? (untemplate replace? subst) (tag$ ["lux" "Form"]) elems)
+ #let [[_ form'] output]]
+ (return [meta form']))
+
+ [_ [_ (#Record fields)]]
+ (do Monad<Meta>
+ [=fields (mapM Monad<Meta>
+ ("lux check" (-> (& Code Code) ($' Meta Code))
+ (function' [kv]
+ (let' [[k v] kv]
+ (do Monad<Meta>
+ [=k (untemplate replace? subst k)
+ =v (untemplate replace? subst v)]
+ (wrap (tuple$ (list =k =v)))))))
+ fields)]
+ (wrap (wrap-meta (form$ (list (tag$ ["lux" "Record"]) (untemplate-list =fields))))))}
))
(macro:' #export (primitive tokens)
@@ -1955,36 +1955,36 @@
(primitive java.util.List [java.lang.Long])")])
("lux case" tokens
- (#Cons [_ (#Symbol "" class-name)] #Nil)
- (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (tag$ ["lux" "Nil"])))))
+ {(#Cons [_ (#Symbol "" class-name)] #Nil)
+ (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (tag$ ["lux" "Nil"])))))
- (#Cons [_ (#Symbol "" class-name)] (#Cons [_ (#Tuple params)] #Nil))
- (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (untemplate-list params)))))
+ (#Cons [_ (#Symbol "" class-name)] (#Cons [_ (#Tuple params)] #Nil))
+ (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (untemplate-list params)))))
- (#Cons [_ (#Text class-name)] #Nil)
- (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (tag$ ["lux" "Nil"])))))
+ (#Cons [_ (#Text class-name)] #Nil)
+ (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (tag$ ["lux" "Nil"])))))
- (#Cons [_ (#Text class-name)] (#Cons [_ (#Tuple params)] #Nil))
- (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (untemplate-list params)))))
+ (#Cons [_ (#Text class-name)] (#Cons [_ (#Tuple params)] #Nil))
+ (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (untemplate-list params)))))
- _
- (fail "Wrong syntax for primitive")))
+ _
+ (fail "Wrong syntax for primitive")}))
(def:'' (current-module-name state)
#Nil
($' Meta Text)
("lux case" state
- {#info info #source source #current-module current-module #modules modules
- #scopes scopes #type-context types #host host
- #seed seed #expected expected #cursor cursor
- #scope-type-vars scope-type-vars}
- ("lux case" current-module
- (#;Some module-name)
- (#Right [state module-name])
+ {{#info info #source source #current-module current-module #modules modules
+ #scopes scopes #type-context types #host host
+ #seed seed #expected expected #cursor cursor
+ #scope-type-vars scope-type-vars}
+ ("lux case" current-module
+ {(#;Some module-name)
+ (#Right [state module-name])
- _
- (#Left "Cannot get the module name without a module!")
- )))
+ _
+ (#Left "Cannot get the module name without a module!")}
+ )}))
(macro:' #export (` tokens)
(list [(tag$ ["lux" "doc"])
@@ -1994,14 +1994,14 @@
(function [(~@ args)]
(~ body))))")])
("lux case" tokens
- (#Cons template #Nil)
- (do Monad<Meta>
- [current-module current-module-name
- =template (untemplate true current-module template)]
- (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template)))))
+ {(#Cons template #Nil)
+ (do Monad<Meta>
+ [current-module current-module-name
+ =template (untemplate true current-module template)]
+ (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template)))))
- _
- (fail "Wrong syntax for `")))
+ _
+ (fail "Wrong syntax for `")}))
(macro:' #export (`' tokens)
(list [(tag$ ["lux" "doc"])
@@ -2010,26 +2010,26 @@
(function [(~@ args)]
(~ body))))")])
("lux case" tokens
- (#Cons template #Nil)
- (do Monad<Meta>
- [=template (untemplate true "" template)]
- (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template)))))
+ {(#Cons template #Nil)
+ (do Monad<Meta>
+ [=template (untemplate true "" template)]
+ (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template)))))
- _
- (fail "Wrong syntax for `")))
+ _
+ (fail "Wrong syntax for `")}))
(macro:' #export (' tokens)
(list [(tag$ ["lux" "doc"])
(text$ "## Quotation as a macro.
(' \"YOLO\")")])
("lux case" tokens
- (#Cons template #Nil)
- (do Monad<Meta>
- [=template (untemplate false "" template)]
- (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template)))))
+ {(#Cons template #Nil)
+ (do Monad<Meta>
+ [=template (untemplate false "" template)]
+ (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template)))))
- _
- (fail "Wrong syntax for '")))
+ _
+ (fail "Wrong syntax for '")}))
(macro:' #export (|> tokens)
(list [(tag$ ["lux" "doc"])
@@ -2041,23 +2041,23 @@
(interpose \" \"
(map int/encode elems)))")])
("lux case" tokens
- (#Cons [init apps])
- (return (list (fold ("lux check" (-> Code Code Code)
- (function' [app acc]
- ("lux case" app
- [_ (#Tuple parts)]
- (tuple$ (list/compose parts (list acc)))
+ {(#Cons [init apps])
+ (return (list (fold ("lux check" (-> Code Code Code)
+ (function' [app acc]
+ ("lux case" app
+ {[_ (#Tuple parts)]
+ (tuple$ (list/compose parts (list acc)))
- [_ (#Form parts)]
- (form$ (list/compose parts (list acc)))
+ [_ (#Form parts)]
+ (form$ (list/compose parts (list acc)))
- _
- (` ((~ app) (~ acc))))))
- init
- apps)))
+ _
+ (` ((~ app) (~ acc)))})))
+ init
+ apps)))
- _
- (fail "Wrong syntax for |>")))
+ _
+ (fail "Wrong syntax for |>")}))
(macro:' #export (<| tokens)
(list [(tag$ ["lux" "doc"])
@@ -2069,23 +2069,23 @@
(interpose \" \"
(map int/encode elems)))")])
("lux case" (reverse tokens)
- (#Cons [init apps])
- (return (list (fold ("lux check" (-> Code Code Code)
- (function' [app acc]
- ("lux case" app
- [_ (#Tuple parts)]
- (tuple$ (list/compose parts (list acc)))
+ {(#Cons [init apps])
+ (return (list (fold ("lux check" (-> Code Code Code)
+ (function' [app acc]
+ ("lux case" app
+ {[_ (#Tuple parts)]
+ (tuple$ (list/compose parts (list acc)))
- [_ (#Form parts)]
- (form$ (list/compose parts (list acc)))
+ [_ (#Form parts)]
+ (form$ (list/compose parts (list acc)))
- _
- (` ((~ app) (~ acc))))))
- init
- apps)))
+ _
+ (` ((~ app) (~ acc)))})))
+ init
+ apps)))
- _
- (fail "Wrong syntax for <|")))
+ _
+ (fail "Wrong syntax for <|")}))
(def:''' #export (. f g)
(list [(tag$ ["lux" "doc"])
@@ -2098,80 +2098,80 @@
#Nil
(-> Code ($' Maybe Ident))
("lux case" x
- [_ (#Symbol sname)]
- (#Some sname)
+ {[_ (#Symbol sname)]
+ (#Some sname)
- _
- #None))
+ _
+ #None}))
(def:''' (get-tag x)
#Nil
(-> Code ($' Maybe Ident))
("lux case" x
- [_ (#Tag sname)]
- (#Some sname)
+ {[_ (#Tag sname)]
+ (#Some sname)
- _
- #None))
+ _
+ #None}))
(def:''' (get-name x)
#Nil
(-> Code ($' Maybe Text))
("lux case" x
- [_ (#Symbol "" sname)]
- (#Some sname)
+ {[_ (#Symbol "" sname)]
+ (#Some sname)
- _
- #None))
+ _
+ #None}))
(def:''' (tuple->list tuple)
#Nil
(-> Code ($' Maybe ($' List Code)))
("lux case" tuple
- [_ (#Tuple members)]
- (#Some members)
+ {[_ (#Tuple members)]
+ (#Some members)
- _
- #None))
+ _
+ #None}))
(def:''' (apply-template env template)
#Nil
(-> RepEnv Code Code)
("lux case" template
- [_ (#Symbol "" sname)]
- ("lux case" (get-rep sname env)
- (#Some subst)
- subst
+ {[_ (#Symbol "" sname)]
+ ("lux case" (get-rep sname env)
+ {(#Some subst)
+ subst
- _
- template)
+ _
+ template})
- [meta (#Tuple elems)]
- [meta (#Tuple (map (apply-template env) elems))]
+ [meta (#Tuple elems)]
+ [meta (#Tuple (map (apply-template env) elems))]
- [meta (#Form elems)]
- [meta (#Form (map (apply-template env) elems))]
+ [meta (#Form elems)]
+ [meta (#Form (map (apply-template env) elems))]
- [meta (#Record members)]
- [meta (#Record (map ("lux check" (-> (& Code Code) (& Code Code))
- (function' [kv]
- (let' [[slot value] kv]
- [(apply-template env slot) (apply-template env value)])))
- members))]
+ [meta (#Record members)]
+ [meta (#Record (map ("lux check" (-> (& Code Code) (& Code Code))
+ (function' [kv]
+ (let' [[slot value] kv]
+ [(apply-template env slot) (apply-template env value)])))
+ members))]
- _
- template))
+ _
+ template}))
(def:''' (join-map f xs)
#Nil
(All [a b]
(-> (-> a ($' List b)) ($' List a) ($' List b)))
("lux case" xs
- #Nil
- #Nil
+ {#Nil
+ #Nil
- (#Cons [x xs'])
- (list/compose (f x) (join-map f xs'))))
+ (#Cons [x xs'])
+ (list/compose (f x) (join-map f xs'))}))
(def:''' (every? p xs)
#Nil
@@ -2190,25 +2190,25 @@
[i.inc 1]
[i.dec -1])")])
("lux case" tokens
- (#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])])
- ("lux case" [(mapM Monad<Maybe> get-name bindings)
- (mapM Monad<Maybe> tuple->list data)]
- [(#Some bindings') (#Some data')]
- (let' [apply ("lux check" (-> RepEnv ($' List Code))
- (function' [env] (map (apply-template env) templates)))
- num-bindings (length bindings')]
- (if (every? (function' [sample] (_lux_proc ["int" "="] [num-bindings sample]))
- (map length data'))
- (|> data'
- (join-map (. apply (make-env bindings')))
- return)
- (fail "Irregular arguments tuples for do-template.")))
+ {(#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])])
+ ("lux case" [(mapM Monad<Maybe> get-name bindings)
+ (mapM Monad<Maybe> tuple->list data)]
+ {[(#Some bindings') (#Some data')]
+ (let' [apply ("lux check" (-> RepEnv ($' List Code))
+ (function' [env] (map (apply-template env) templates)))
+ num-bindings (length bindings')]
+ (if (every? (function' [sample] (_lux_proc ["int" "="] [num-bindings sample]))
+ (map length data'))
+ (|> data'
+ (join-map (. apply (make-env bindings')))
+ return)
+ (fail "Irregular arguments tuples for do-template.")))
- _
- (fail "Wrong syntax for do-template"))
+ _
+ (fail "Wrong syntax for do-template")})
- _
- (fail "Wrong syntax for do-template")))
+ _
+ (fail "Wrong syntax for do-template")}))
(do-template [<type> <category> <=-name> <lt-name> <lte-name> <gt-name> <gte-name>
<eq-doc> <<-doc> <<=-doc> <>-doc> <>=-doc>]
@@ -2325,28 +2325,28 @@
#Nil
(-> Nat Text)
("lux case" digit
- +0 "0"
- +1 "1" +2 "2" +3 "3"
- +4 "4" +5 "5" +6 "6"
- +7 "7" +8 "8" +9 "9"
- _ (_lux_proc ["io" "error"] ["undefined"])))
+ {+0 "0"
+ +1 "1" +2 "2" +3 "3"
+ +4 "4" +5 "5" +6 "6"
+ +7 "7" +8 "8" +9 "9"
+ _ (_lux_proc ["io" "error"] ["undefined"])}))
(def:''' (nat/encode value)
#Nil
(-> Nat Text)
("lux case" value
- +0
- "+0"
-
- _
- (let' [loop ("lux check" (-> Nat Text Text)
- (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 ""))))
+ {+0
+ "+0"
+
+ _
+ (let' [loop ("lux check" (-> Nat Text Text)
+ (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)
#Nil
@@ -2404,23 +2404,23 @@
(get name bindings))]
(let' [[def-type def-meta def-value] ("lux check" Def gdef)]
("lux case" (get-meta ["lux" "macro?"] def-meta)
- (#Some [_ (#Bool true)])
- ("lux case" (get-meta ["lux" "export?"] def-meta)
- (#Some [_ (#Bool true)])
- (#Some ("lux coerce" Macro def-value))
-
- _
- (if (text/= module current-module)
+ {(#Some [_ (#Bool true)])
+ ("lux case" (get-meta ["lux" "export?"] def-meta)
+ {(#Some [_ (#Bool true)])
(#Some ("lux coerce" Macro def-value))
- #None))
-
- _
- ("lux case" (get-meta ["lux" "alias"] def-meta)
- (#Some [_ (#Symbol [r-module r-name])])
- (find-macro' modules current-module r-module r-name)
+ _
+ (if (text/= module current-module)
+ (#Some ("lux coerce" Macro def-value))
+ #None)})
+
_
- #None)
+ ("lux case" (get-meta ["lux" "alias"] def-meta)
+ {(#Some [_ (#Symbol [r-module r-name])])
+ (find-macro' modules current-module r-module r-name)
+
+ _
+ #None})}
))
))
@@ -2428,13 +2428,13 @@
#Nil
(-> Ident ($' Meta Ident))
("lux case" ident
- ["" name]
- (do Monad<Meta>
- [module-name current-module-name]
- (wrap [module-name name]))
+ {["" name]
+ (do Monad<Meta>
+ [module-name current-module-name]
+ (wrap [module-name name]))
- _
- (return ident)))
+ _
+ (return ident)}))
(def:''' (find-macro ident)
#Nil
@@ -2444,12 +2444,12 @@
(let' [[module name] ident]
(function' [state]
("lux case" state
- {#info info #source source #current-module _ #modules modules
- #scopes scopes #type-context types #host host
- #seed seed #expected expected
- #cursor cursor
- #scope-type-vars scope-type-vars}
- (#Right state (find-macro' modules current-module module name)))))))
+ {{#info info #source source #current-module _ #modules modules
+ #scopes scopes #type-context 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
@@ -2458,8 +2458,8 @@
[ident (normalize ident)
output (find-macro ident)]
(wrap ("lux case" output
- (#Some _) true
- #None false))))
+ {(#Some _) true
+ #None false}))))
(def:''' (list/join xs)
#Nil
@@ -2472,168 +2472,168 @@
(All [a]
(-> a ($' List a) ($' List a)))
("lux case" xs
- #Nil
- xs
+ {#Nil
+ xs
- (#Cons [x #Nil])
- xs
+ (#Cons [x #Nil])
+ xs
- (#Cons [x xs'])
- (list& x sep (interpose sep xs'))))
+ (#Cons [x xs'])
+ (list& x sep (interpose sep xs'))}))
(def:''' (macro-expand-once token)
#Nil
(-> Code ($' Meta ($' List Code)))
("lux case" token
- [_ (#Form (#Cons [_ (#Symbol macro-name)] args))]
- (do Monad<Meta>
- [macro-name' (normalize macro-name)
- ?macro (find-macro macro-name')]
- ("lux case" ?macro
- (#Some macro)
- (macro args)
-
- #None
- (return (list token))))
+ {[_ (#Form (#Cons [_ (#Symbol macro-name)] args))]
+ (do Monad<Meta>
+ [macro-name' (normalize macro-name)
+ ?macro (find-macro macro-name')]
+ ("lux case" ?macro
+ {(#Some macro)
+ (macro args)
+
+ #None
+ (return (list token))}))
- _
- (return (list token))))
+ _
+ (return (list token))}))
(def:''' (macro-expand token)
#Nil
(-> Code ($' Meta ($' List Code)))
("lux case" token
- [_ (#Form (#Cons [_ (#Symbol macro-name)] args))]
- (do Monad<Meta>
- [macro-name' (normalize macro-name)
- ?macro (find-macro macro-name')]
- ("lux case" ?macro
- (#Some macro)
- (do Monad<Meta>
- [expansion (macro args)
- expansion' (mapM Monad<Meta> macro-expand expansion)]
- (wrap (list/join expansion')))
-
- #None
- (return (list token))))
+ {[_ (#Form (#Cons [_ (#Symbol macro-name)] args))]
+ (do Monad<Meta>
+ [macro-name' (normalize macro-name)
+ ?macro (find-macro macro-name')]
+ ("lux case" ?macro
+ {(#Some macro)
+ (do Monad<Meta>
+ [expansion (macro args)
+ expansion' (mapM Monad<Meta> macro-expand expansion)]
+ (wrap (list/join expansion')))
+
+ #None
+ (return (list token))}))
- _
- (return (list token))))
+ _
+ (return (list token))}))
(def:''' (macro-expand-all syntax)
#Nil
(-> Code ($' Meta ($' List Code)))
("lux case" syntax
- [_ (#Form (#Cons [_ (#Symbol macro-name)] args))]
- (do Monad<Meta>
- [macro-name' (normalize macro-name)
- ?macro (find-macro macro-name')]
- ("lux case" ?macro
- (#Some macro)
- (do Monad<Meta>
- [expansion (macro args)
- expansion' (mapM Monad<Meta> macro-expand-all expansion)]
- (wrap (list/join expansion')))
-
- #None
- (do Monad<Meta>
- [args' (mapM Monad<Meta> macro-expand-all args)]
- (wrap (list (form$ (#Cons (symbol$ macro-name) (list/join args'))))))))
-
- [_ (#Form members)]
- (do Monad<Meta>
- [members' (mapM Monad<Meta> macro-expand-all members)]
- (wrap (list (form$ (list/join members')))))
-
- [_ (#Tuple members)]
- (do Monad<Meta>
- [members' (mapM Monad<Meta> macro-expand-all members)]
- (wrap (list (tuple$ (list/join members')))))
-
- [_ (#Record pairs)]
- (do Monad<Meta>
- [pairs' (mapM Monad<Meta>
- (function' [kv]
- (let' [[key val] kv]
- (do Monad<Meta>
- [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 Code.")))))
- pairs)]
- (wrap (list (record$ pairs'))))
-
- _
- (return (list syntax))))
+ {[_ (#Form (#Cons [_ (#Symbol macro-name)] args))]
+ (do Monad<Meta>
+ [macro-name' (normalize macro-name)
+ ?macro (find-macro macro-name')]
+ ("lux case" ?macro
+ {(#Some macro)
+ (do Monad<Meta>
+ [expansion (macro args)
+ expansion' (mapM Monad<Meta> macro-expand-all expansion)]
+ (wrap (list/join expansion')))
+
+ #None
+ (do Monad<Meta>
+ [args' (mapM Monad<Meta> macro-expand-all args)]
+ (wrap (list (form$ (#Cons (symbol$ macro-name) (list/join args'))))))}))
+
+ [_ (#Form members)]
+ (do Monad<Meta>
+ [members' (mapM Monad<Meta> macro-expand-all members)]
+ (wrap (list (form$ (list/join members')))))
+
+ [_ (#Tuple members)]
+ (do Monad<Meta>
+ [members' (mapM Monad<Meta> macro-expand-all members)]
+ (wrap (list (tuple$ (list/join members')))))
+
+ [_ (#Record pairs)]
+ (do Monad<Meta>
+ [pairs' (mapM Monad<Meta>
+ (function' [kv]
+ (let' [[key val] kv]
+ (do Monad<Meta>
+ [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 Code.")}))))
+ pairs)]
+ (wrap (list (record$ pairs'))))
+
+ _
+ (return (list syntax))}))
(def:''' (walk-type type)
#Nil
(-> Code Code)
("lux case" type
- [_ (#Form (#Cons [_ (#Tag tag)] parts))]
- (form$ (#Cons [(tag$ tag) (map walk-type parts)]))
+ {[_ (#Form (#Cons [_ (#Tag tag)] parts))]
+ (form$ (#Cons [(tag$ tag) (map walk-type parts)]))
- [_ (#Tuple members)]
- (` (& (~@ (map walk-type members))))
+ [_ (#Tuple members)]
+ (` (& (~@ (map walk-type members))))
- [_ (#Form (#Cons type-fn args))]
- (fold ("lux check" (-> Code Code Code)
- (function' [arg type-fn] (` (#;Apply (~ arg) (~ type-fn)))))
- (walk-type type-fn)
- (map walk-type args))
-
- _
- type))
+ [_ (#Form (#Cons type-fn args))]
+ (fold ("lux check" (-> Code Code Code)
+ (function' [arg type-fn] (` (#;Apply (~ arg) (~ type-fn)))))
+ (walk-type type-fn)
+ (map walk-type args))
+
+ _
+ type}))
(macro:' #export (type tokens)
(list [(tag$ ["lux" "doc"])
(text$ "## Takes a type expression and returns it's representation as data-structure.
(type (All [a] (Maybe (List a))))")])
("lux case" tokens
- (#Cons type #Nil)
- (do Monad<Meta>
- [type+ (macro-expand-all type)]
- ("lux case" type+
- (#Cons type' #Nil)
- (wrap (list (walk-type type')))
-
- _
- (fail "The expansion of the type-syntax had to yield a single element.")))
+ {(#Cons type #Nil)
+ (do Monad<Meta>
+ [type+ (macro-expand-all type)]
+ ("lux case" type+
+ {(#Cons type' #Nil)
+ (wrap (list (walk-type type')))
+
+ _
+ (fail "The expansion of the type-syntax had to yield a single element.")}))
- _
- (fail "Wrong syntax for type")))
+ _
+ (fail "Wrong syntax for type")}))
(macro:' #export (: tokens)
(list [(tag$ ["lux" "doc"])
(text$ "## The type-annotation macro.
(: (List Int) (list 1 2 3))")])
("lux case" tokens
- (#Cons type (#Cons value #Nil))
- (return (list (` ("lux check" (type (~ type)) (~ value)))))
+ {(#Cons type (#Cons value #Nil))
+ (return (list (` ("lux check" (type (~ type)) (~ value)))))
- _
- (fail "Wrong syntax for :")))
+ _
+ (fail "Wrong syntax for :")}))
(macro:' #export (:! tokens)
(list [(tag$ ["lux" "doc"])
(text$ "## The type-coercion macro.
(:! Dinosaur (list 1 2 3))")])
("lux case" tokens
- (#Cons type (#Cons value #Nil))
- (return (list (` ("lux coerce" (type (~ type)) (~ value)))))
+ {(#Cons type (#Cons value #Nil))
+ (return (list (` ("lux coerce" (type (~ type)) (~ value)))))
- _
- (fail "Wrong syntax for :!")))
+ _
+ (fail "Wrong syntax for :!")}))
(def:''' (empty? xs)
#Nil
(All [a] (-> ($' List a) Bool))
("lux case" xs
- #Nil true
- _ false))
+ {#Nil true
+ _ false}))
(do-template [<name> <type> <value>]
[(def:''' (<name> xy)
@@ -2648,71 +2648,71 @@
#Nil
(-> ($' List Code) ($' Meta (& Code ($' Maybe ($' List Text)))))
("lux case" type-codes
- (#Cons [_ (#Record pairs)] #;Nil)
- (do Monad<Meta>
- [members (mapM Monad<Meta>
- (: (-> [Code Code] (Meta [Text Code]))
- (function' [pair]
- ("lux case" pair
- [[_ (#Tag "" member-name)] member-type]
- (return [member-name member-type])
+ {(#Cons [_ (#Record pairs)] #;Nil)
+ (do Monad<Meta>
+ [members (mapM Monad<Meta>
+ (: (-> [Code Code] (Meta [Text Code]))
+ (function' [pair]
+ ("lux case" pair
+ {[[_ (#Tag "" member-name)] member-type]
+ (return [member-name member-type])
+
+ _
+ (fail "Wrong syntax for variant case.")})))
+ pairs)]
+ (return [(` (& (~@ (map second members))))
+ (#Some (map first members))]))
+
+ (#Cons type #Nil)
+ ("lux case" type
+ {[_ (#Tag "" member-name)]
+ (return [(` #;Unit) (#;Some (list member-name))])
+
+ [_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))]
+ (return [(` (& (~@ member-types))) (#;Some (list member-name))])
- _
- (fail "Wrong syntax for variant case."))))
- pairs)]
- (return [(` (& (~@ (map second members))))
- (#Some (map first members))]))
+ _
+ (return [type #None])})
- (#Cons type #Nil)
- ("lux case" type
- [_ (#Tag "" member-name)]
- (return [(` #;Unit) (#;Some (list member-name))])
-
- [_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))]
- (return [(` (& (~@ member-types))) (#;Some (list member-name))])
+ (#Cons case cases)
+ (do Monad<Meta>
+ [members (mapM Monad<Meta>
+ (: (-> Code (Meta [Text Code]))
+ (function' [case]
+ ("lux case" case
+ {[_ (#Tag "" member-name)]
+ (return [member-name (` Unit)])
+
+ [_ (#Form (#Cons [_ (#Tag "" member-name)] (#Cons member-type #Nil)))]
+ (return [member-name member-type])
+
+ [_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))]
+ (return [member-name (` (& (~@ member-types)))])
+
+ _
+ (fail "Wrong syntax for variant case.")})))
+ (list& case cases))]
+ (return [(` (| (~@ (map second members))))
+ (#Some (map first members))]))
_
- (return [type #None]))
-
- (#Cons case cases)
- (do Monad<Meta>
- [members (mapM Monad<Meta>
- (: (-> Code (Meta [Text Code]))
- (function' [case]
- ("lux case" case
- [_ (#Tag "" member-name)]
- (return [member-name (` Unit)])
-
- [_ (#Form (#Cons [_ (#Tag "" member-name)] (#Cons member-type #Nil)))]
- (return [member-name member-type])
-
- [_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))]
- (return [member-name (` (& (~@ member-types)))])
-
- _
- (fail "Wrong syntax for variant case."))))
- (list& case cases))]
- (return [(` (| (~@ (map second members))))
- (#Some (map first members))]))
-
- _
- (fail "Improper type-definition syntax")))
+ (fail "Improper type-definition syntax")}))
(def:''' (gensym prefix state)
#Nil
(-> Text ($' Meta Code))
("lux case" state
- {#info info #source source #current-module _ #modules modules
- #scopes scopes #type-context types #host host
- #seed seed #expected expected
- #cursor cursor
- #scope-type-vars scope-type-vars}
- (#Right {#info info #source source #current-module _ #modules modules
- #scopes scopes #type-context types #host host
- #seed (n.+ +1 seed) #expected expected
- #cursor cursor
- #scope-type-vars scope-type-vars}
- (symbol$ ["" ($_ text/compose "__gensym__" prefix (nat/encode seed))]))))
+ {{#info info #source source #current-module _ #modules modules
+ #scopes scopes #type-context types #host host
+ #seed seed #expected expected
+ #cursor cursor
+ #scope-type-vars scope-type-vars}
+ (#Right {#info info #source source #current-module _ #modules modules
+ #scopes scopes #type-context types #host host
+ #seed (n.+ +1 seed) #expected expected
+ #cursor cursor
+ #scope-type-vars scope-type-vars}
+ (symbol$ ["" ($_ text/compose "__gensym__" prefix (nat/encode seed))]))}))
(macro:' #export (Rec tokens)
(list [(tag$ ["lux" "doc"])
@@ -2721,13 +2721,13 @@
(Rec Self
[Int (List Self)])")])
("lux case" tokens
- (#Cons [_ (#Symbol "" name)] (#Cons body #Nil))
- (let' [body' (replace-syntax (list [name (` (#Apply (~ (make-bound +1)) (~ (make-bound +0))))])
- (update-bounds body))]
- (return (list (` (#Apply #;Void (#UnivQ #Nil (~ body')))))))
-
- _
- (fail "Wrong syntax for Rec")))
+ {(#Cons [_ (#Symbol "" name)] (#Cons body #Nil))
+ (let' [body' (replace-syntax (list [name (` (#Apply (~ (make-bound +1)) (~ (make-bound +0))))])
+ (update-bounds body))]
+ (return (list (` (#Apply #;Void (#UnivQ #Nil (~ body')))))))
+
+ _
+ (fail "Wrong syntax for Rec")}))
(macro:' #export (exec tokens)
(list [(tag$ ["lux" "doc"])
@@ -2738,61 +2738,61 @@
(log! \"#3\")
\"YOLO\")")])
("lux case" (reverse tokens)
- (#Cons value actions)
- (let' [dummy (symbol$ ["" ""])]
- (return (list (fold ("lux check" (-> Code Code Code)
- (function' [pre post] (` ("lux case" (~ pre) (~ dummy) (~ post)))))
- value
- actions))))
+ {(#Cons value actions)
+ (let' [dummy (symbol$ ["" ""])]
+ (return (list (fold ("lux check" (-> Code Code Code)
+ (function' [pre post] (` ("lux case" (~ pre) {(~ dummy) (~ post)}))))
+ value
+ actions))))
- _
- (fail "Wrong syntax for exec")))
+ _
+ (fail "Wrong syntax for exec")}))
(macro:' (def:' tokens)
(let' [[export? tokens'] ("lux case" tokens
- (#Cons [_ (#Tag ["" "export"])] tokens')
- [true tokens']
+ {(#Cons [_ (#Tag ["" "export"])] tokens')
+ [true tokens']
- _
- [false tokens])
+ _
+ [false tokens]})
parts (: (Maybe [Code (List Code) (Maybe Code) Code])
("lux case" tokens'
- (#Cons [_ (#Form (#Cons name args))] (#Cons type (#Cons body #Nil)))
- (#Some name args (#Some type) body)
-
- (#Cons name (#Cons type (#Cons body #Nil)))
- (#Some name #Nil (#Some type) body)
-
- (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil))
- (#Some name args #None body)
-
- (#Cons name (#Cons body #Nil))
- (#Some name #Nil #None body)
+ {(#Cons [_ (#Form (#Cons name args))] (#Cons type (#Cons body #Nil)))
+ (#Some name args (#Some type) body)
+
+ (#Cons name (#Cons type (#Cons body #Nil)))
+ (#Some name #Nil (#Some type) body)
+
+ (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil))
+ (#Some name args #None body)
+
+ (#Cons name (#Cons body #Nil))
+ (#Some name #Nil #None body)
- _
- #None))]
+ _
+ #None}))]
("lux case" parts
- (#Some name args ?type body)
- (let' [body' ("lux case" args
- #Nil
- body
+ {(#Some name args ?type body)
+ (let' [body' ("lux case" args
+ {#Nil
+ body
- _
- (` (function' (~ name) [(~@ args)] (~ body))))
- body'' ("lux case" ?type
- (#Some type)
- (` (: (~ type) (~ body')))
-
- #None
- body')]
- (return (list (` ("lux def" (~ name) (~ body'')
- [(~ cursor-code)
- (#;Record (~ (if export?
- (with-export-meta (tag$ ["lux" "Nil"]))
- (tag$ ["lux" "Nil"]))))])))))
-
- #None
- (fail "Wrong syntax for def'"))))
+ _
+ (` (function' (~ name) [(~@ args)] (~ body)))})
+ body'' ("lux case" ?type
+ {(#Some type)
+ (` (: (~ type) (~ body')))
+
+ #None
+ body'})]
+ (return (list (` ("lux def" (~ name) (~ body'')
+ [(~ cursor-code)
+ (#;Record (~ (if export?
+ (with-export-meta (tag$ ["lux" "Nil"]))
+ (tag$ ["lux" "Nil"]))))])))))
+
+ #None
+ (fail "Wrong syntax for def'")})))
(def:' (rejoin-pair pair)
(-> [Code Code] (List Code))
@@ -2802,88 +2802,88 @@
(def:' (code-to-text code)
(-> Code Text)
("lux case" code
- [_ (#Bool value)]
- (bool/encode value)
+ {[_ (#Bool value)]
+ (bool/encode value)
- [_ (#Nat value)]
- (nat/encode value)
+ [_ (#Nat value)]
+ (nat/encode value)
- [_ (#Int value)]
- (int/encode value)
+ [_ (#Int value)]
+ (int/encode value)
- [_ (#Deg value)]
- (_lux_proc ["io" "error"] ["Undefined behavior."])
-
- [_ (#Frac value)]
- (frac/encode value)
+ [_ (#Deg value)]
+ (_lux_proc ["io" "error"] ["Undefined behavior."])
+
+ [_ (#Frac value)]
+ (frac/encode value)
- [_ (#Text value)]
- ($_ text/compose "\"" value "\"")
-
- [_ (#Symbol [prefix name])]
- (if (text/= "" prefix)
- name
- ($_ text/compose prefix ";" name))
-
- [_ (#Tag [prefix name])]
- (if (text/= "" prefix)
- ($_ text/compose "#" name)
- ($_ text/compose "#" prefix ";" name))
-
- [_ (#Form xs)]
- ($_ text/compose "(" (|> xs
- (map code-to-text)
- (interpose " ")
- reverse
- (fold text/compose "")) ")")
-
- [_ (#Tuple xs)]
- ($_ text/compose "[" (|> xs
- (map code-to-text)
- (interpose " ")
- reverse
- (fold text/compose "")) "]")
-
- [_ (#Record kvs)]
- ($_ text/compose "{" (|> kvs
- (map (function' [kv] ("lux case" kv [k v] ($_ text/compose (code-to-text k) " " (code-to-text v)))))
- (interpose " ")
- reverse
- (fold text/compose "")) "}")
+ [_ (#Text value)]
+ ($_ text/compose "\"" value "\"")
+
+ [_ (#Symbol [prefix name])]
+ (if (text/= "" prefix)
+ name
+ ($_ text/compose prefix ";" name))
+
+ [_ (#Tag [prefix name])]
+ (if (text/= "" prefix)
+ ($_ text/compose "#" name)
+ ($_ text/compose "#" prefix ";" name))
+
+ [_ (#Form xs)]
+ ($_ text/compose "(" (|> xs
+ (map code-to-text)
+ (interpose " ")
+ reverse
+ (fold text/compose "")) ")")
+
+ [_ (#Tuple xs)]
+ ($_ text/compose "[" (|> xs
+ (map code-to-text)
+ (interpose " ")
+ reverse
+ (fold text/compose "")) "]")
+
+ [_ (#Record kvs)]
+ ($_ text/compose "{" (|> kvs
+ (map (function' [kv] ("lux case" kv {[k v] ($_ text/compose (code-to-text k) " " (code-to-text v))})))
+ (interpose " ")
+ reverse
+ (fold text/compose "")) "}")}
))
(def:' (expander branches)
(-> (List Code) (Meta (List Code)))
("lux case" branches
- (#;Cons [_ (#Form (#Cons [_ (#Symbol macro-name)] macro-args))]
- (#;Cons body
- branches'))
- (do Monad<Meta>
- [??? (macro? macro-name)]
- (if ???
- (do Monad<Meta>
- [init-expansion (macro-expand-once (form$ (list& (symbol$ macro-name) (form$ macro-args) body branches')))]
- (expander init-expansion))
- (do Monad<Meta>
- [sub-expansion (expander branches')]
- (wrap (list& (form$ (list& (symbol$ macro-name) macro-args))
- body
- sub-expansion)))))
+ {(#;Cons [_ (#Form (#Cons [_ (#Symbol macro-name)] macro-args))]
+ (#;Cons body
+ branches'))
+ (do Monad<Meta>
+ [??? (macro? macro-name)]
+ (if ???
+ (do Monad<Meta>
+ [init-expansion (macro-expand-once (form$ (list& (symbol$ macro-name) (form$ macro-args) body branches')))]
+ (expander init-expansion))
+ (do Monad<Meta>
+ [sub-expansion (expander branches')]
+ (wrap (list& (form$ (list& (symbol$ macro-name) macro-args))
+ body
+ sub-expansion)))))
- (#;Cons pattern (#;Cons body branches'))
- (do Monad<Meta>
- [sub-expansion (expander branches')]
- (wrap (list& pattern body sub-expansion)))
+ (#;Cons pattern (#;Cons body branches'))
+ (do Monad<Meta>
+ [sub-expansion (expander branches')]
+ (wrap (list& pattern body sub-expansion)))
- #;Nil
- (do Monad<Meta> [] (wrap (list)))
+ #;Nil
+ (do Monad<Meta> [] (wrap (list)))
- _
- (fail ($_ text/compose "\"lux;case\" expects an even number of tokens: " (|> branches
- (map code-to-text)
- (interpose " ")
- reverse
- (fold text/compose ""))))))
+ _
+ (fail ($_ text/compose "\"lux;case\" expects an even number of tokens: " (|> branches
+ (map code-to-text)
+ (interpose " ")
+ reverse
+ (fold text/compose ""))))}))
(macro:' #export (case tokens)
(list [(tag$ ["lux" "doc"])
@@ -2896,13 +2896,13 @@
_
#None)")])
("lux case" tokens
- (#Cons value branches)
- (do Monad<Meta>
- [expansion (expander branches)]
- (wrap (list (` ("lux case" (~ value) (~@ expansion))))))
+ {(#Cons value branches)
+ (do Monad<Meta>
+ [expansion (expander branches)]
+ (wrap (list (` ("lux case" (~ value) (~ (record$ (as-pairs expansion))))))))
- _
- (fail "Wrong syntax for case")))
+ _
+ (fail "Wrong syntax for case")}))
(macro:' #export (^ tokens)
(list [(tag$ ["lux" "doc"])
@@ -2987,7 +2987,7 @@
(function' [lr body']
(let' [[l r] lr]
(if (symbol? l)
- (` ("lux case" (~ r) (~ l) (~ body')))
+ (` ("lux case" (~ r) {(~ l) (~ body')}))
(` (case (~ r) (~ l) (~ body')))))))
body)
list
@@ -4401,7 +4401,7 @@
(wrap enhanced-target))))
target
(zip2 tags members))]
- (wrap (` ("lux case" (~ (symbol$ source)) (~ pattern) (~ enhanced-target))))))))
+ (wrap (` ("lux case" (~ (symbol$ source)) {(~ pattern) (~ enhanced-target)})))))))
name tags&members body)]
(wrap (list full-body)))))
@@ -4486,7 +4486,7 @@
g!output
g!_)]))
(zip2 tags (enumerate members))))]
- (return (list (` ("lux case" (~ record) (~ pattern) (~ g!output))))))
+ (return (list (` ("lux case" (~ record) {(~ pattern) (~ g!output)})))))
_
(fail "get@ can only use records.")))
@@ -4808,7 +4808,7 @@
value
r-var)]))
pattern'))]
- (return (list (` ("lux case" (~ record) (~ pattern) (~ output)))))))
+ (return (list (` ("lux case" (~ record) {(~ pattern) (~ output)}))))))
_
(fail "set@ can only use records.")))
@@ -4894,7 +4894,7 @@
(` ((~ fun) (~ r-var)))
r-var)]))
pattern'))]
- (return (list (` ("lux case" (~ record) (~ pattern) (~ output)))))))
+ (return (list (` ("lux case" (~ record) {(~ pattern) (~ output)}))))))
_
(fail "update@ can only use records.")))
@@ -5573,12 +5573,12 @@
(~ g!temp)
#;None))
- (#;Some (~ g!temp))
- (~ g!temp)
+ {(#;Some (~ g!temp))
+ (~ g!temp)
- #;None
- (case (~ g!temp)
- (~@ next-branches)))))]
+ #;None
+ (case (~ g!temp)
+ (~@ next-branches))})))]
(wrap output)))
_
diff --git a/stdlib/source/lux/control/comonad.lux b/stdlib/source/lux/control/comonad.lux
index eca4cd4f1..7886d8c3c 100644
--- a/stdlib/source/lux/control/comonad.lux
+++ b/stdlib/source/lux/control/comonad.lux
@@ -49,10 +49,10 @@
body
(list;reverse (list;as-pairs bindings)))]
(#;Right [state (#;Cons (` ("lux case" (~ comonad)
- (~' @)
- ("lux case" (~' @)
- {#functor {#F;map (~ g!map)} #unwrap (~' unwrap) #split (~ g!split)}
- (~ body'))))
+ {(~' @)
+ ("lux case" (~' @)
+ {{#functor {#F;map (~ g!map)} #unwrap (~' unwrap) #split (~ g!split)}
+ (~ body')})}))
#;Nil)]))
(#;Left "'be' bindings must have an even number of parts."))
diff --git a/stdlib/source/lux/control/monad.lux b/stdlib/source/lux/control/monad.lux
index 856509baa..b9ecf5470 100644
--- a/stdlib/source/lux/control/monad.lux
+++ b/stdlib/source/lux/control/monad.lux
@@ -77,13 +77,13 @@
body
(reverse (as-pairs bindings)))]
(#;Right [state (#;Cons (` ("lux case" (~ monad)
- (~' @)
- ("lux case" (~' @)
- {#applicative {#A;functor {#F;map (~ g!map)}
- #A;wrap (~' wrap)
- #A;apply (~ g!apply)}
- #join (~ g!join)}
- (~ body'))))
+ {(~' @)
+ ("lux case" (~' @)
+ {{#applicative {#A;functor {#F;map (~ g!map)}
+ #A;wrap (~' wrap)
+ #A;apply (~ g!apply)}
+ #join (~ g!join)}
+ (~ body')})}))
#;Nil)]))
(#;Left "'do' bindings must have an even number of parts."))
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index b1cc9735c..d8105ca0a 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -1409,11 +1409,11 @@
"YOLO")}
(with-gensyms [g!value]
(wrap (list (` ("lux case" (~ expr)
- (#;Some (~ g!value))
- (~ g!value)
+ {(#;Some (~ g!value))
+ (~ g!value)
- #;None
- (;_lux_proc ["jvm" "null"] [])))))))
+ #;None
+ (;_lux_proc ["jvm" "null"] [])}))))))
(syntax: #export (try expr)
{#;doc (doc "Covers the expression in a try-catch block."
diff --git a/stdlib/source/lux/meta/syntax.lux b/stdlib/source/lux/meta/syntax.lux
index dd10d7123..4574b9f5d 100644
--- a/stdlib/source/lux/meta/syntax.lux
+++ b/stdlib/source/lux/meta/syntax.lux
@@ -287,11 +287,11 @@
((~' wrap) (do meta;Monad<Meta>
[]
(~ body))))))
- (#E;Success (~ g!body))
- ((~ g!body) (~ g!state))
+ {(#E;Success (~ g!body))
+ ((~ g!body) (~ g!state))
- (#E;Error (~ g!msg))
- (#E;Error (text.join-with ": " (list (~ error-msg) (~ g!msg)))))))))))
+ (#E;Error (~ g!msg))
+ (#E;Error (text.join-with ": " (list (~ error-msg) (~ g!msg))))})))))))
_
(meta;fail "Wrong syntax for syntax:"))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-07 18:53:58 +0000