aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux.lux
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux.lux4256
1 files changed, 2132 insertions, 2124 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 0087a8d89..c1d94e53b 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -13,9 +13,9 @@
("lux def" List
(+12 ["lux" "List"]
(+9 (+0)
- (+3 ## "lux;Nil"
+ (+3 ## "lux.Nil"
(+2)
- ## "lux;Cons"
+ ## "lux.Cons"
(+4 (+6 +1)
(+11 (+6 +1) (+6 +0))))))
[dummy-cursor
@@ -151,9 +151,9 @@
("lux def" Maybe
(+12 ["lux" "Maybe"]
(+9 #Nil
- (+3 ## "lux;None"
+ (+3 ## "lux.None"
(+2)
- ## "lux;Some"
+ ## "lux.Some"
(+6 +1))))
[dummy-cursor
(+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])]
@@ -193,31 +193,31 @@
{Type-Pair
(+11 Void
(+9 #Nil
- (+3 ## "lux;Primitive"
+ (+3 ## "lux.Primitive"
(+4 Text Type-List)
- (+3 ## "lux;Void"
+ (+3 ## "lux.Void"
(+2)
- (+3 ## "lux;Unit"
+ (+3 ## "lux.Unit"
(+2)
- (+3 ## "lux;Sum"
+ (+3 ## "lux.Sum"
Type-Pair
- (+3 ## "lux;Product"
+ (+3 ## "lux.Product"
Type-Pair
- (+3 ## "lux;Function"
+ (+3 ## "lux.Function"
Type-Pair
- (+3 ## "lux;Bound"
+ (+3 ## "lux.Bound"
Nat
- (+3 ## "lux;Var"
+ (+3 ## "lux.Var"
Nat
- (+3 ## "lux;Ex"
+ (+3 ## "lux.Ex"
Nat
- (+3 ## "lux;UnivQ"
+ (+3 ## "lux.UnivQ"
(+4 Type-List Type)
- (+3 ## "lux;ExQ"
+ (+3 ## "lux.ExQ"
(+4 Type-List Type)
- (+3 ## "lux;App"
+ (+3 ## "lux.Apply"
Type-Pair
- ## "lux;Named"
+ ## "lux.Named"
(+4 Ident Type)))))))))))))))})})}))
[dummy-cursor
(+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])]
@@ -315,7 +315,7 @@
(#Cons [[dummy-cursor (+7 ["lux" "doc"])]
[dummy-cursor (+5 "The type of things that can be annotated with meta-data of arbitrary types.")]]
(#Cons [[dummy-cursor (+7 ["lux" "type-args"])]
- [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "m")] (#Cons [dummy-cursor (+5 "v")] #;Nil)))]]
+ [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "m")] (#Cons [dummy-cursor (+5 "v")] #Nil)))]]
(#Cons [[dummy-cursor (+7 ["lux" "type?"])]
[dummy-cursor (+0 true)]]
(#Cons [[dummy-cursor (+7 ["lux" "export?"])]
@@ -343,27 +343,27 @@
("lux case" ("lux check type" (#Apply Code List))
{Code-List
(#UnivQ #Nil
- (#Sum ## "lux;Bool"
+ (#Sum ## "lux.Bool"
Bool
- (#Sum ## "lux;Nat"
+ (#Sum ## "lux.Nat"
Nat
- (#Sum ## "lux;Int"
+ (#Sum ## "lux.Int"
Int
- (#Sum ## "lux;Deg"
+ (#Sum ## "lux.Deg"
Deg
- (#Sum ## "lux;Frac"
+ (#Sum ## "lux.Frac"
Frac
- (#Sum ## "lux;Text"
+ (#Sum ## "lux.Text"
Text
- (#Sum ## "lux;Symbol"
+ (#Sum ## "lux.Symbol"
Ident
- (#Sum ## "lux;Tag"
+ (#Sum ## "lux.Tag"
Ident
- (#Sum ## "lux;Form"
+ (#Sum ## "lux.Form"
Code-List
- (#Sum ## "lux;Tuple"
+ (#Sum ## "lux.Tuple"
Code-List
- ## "lux;Record"
+ ## "lux.Record"
(#Apply (#Product Code Code) List)
))))))))))
)})}))
@@ -382,7 +382,7 @@
(#Cons [dummy-cursor (+5 "Record")]
#Nil))))))))))))]]
(#Cons [[dummy-cursor (+7 ["lux" "type-args"])]
- [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "w")] #;Nil))]]
+ [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "w")] #Nil))]]
(#Cons [[dummy-cursor (+7 ["lux" "type?"])]
[dummy-cursor (+0 true)]]
(#Cons [[dummy-cursor (+7 ["lux" "export?"])]
@@ -500,16 +500,16 @@
(#Named ["lux" "Bindings"]
(#UnivQ #Nil
(#UnivQ #Nil
- (#Product ## "lux;counter"
+ (#Product ## "lux.counter"
Nat
- ## "lux;mappings"
+ ## "lux.mappings"
(#Apply (#Product (#Bound +3)
(#Bound +1))
List)))))
(record$ (#Cons [(tag$ ["lux" "tags"])
(tuple$ (#Cons (text$ "counter") (#Cons (text$ "mappings") #Nil)))]
(#Cons [(tag$ ["lux" "type-args"])
- (tuple$ (#Cons (text$ "k") (#Cons (text$ "v") #;Nil)))]
+ (tuple$ (#Cons (text$ "k") (#Cons (text$ "v") #Nil)))]
default-def-meta-exported))))
## (type: #export Ref
@@ -555,14 +555,14 @@
(#Named ["lux" "Either"]
(#UnivQ #Nil
(#UnivQ #Nil
- (#Sum ## "lux;Left"
+ (#Sum ## "lux.Left"
(#Bound +3)
- ## "lux;Right"
+ ## "lux.Right"
(#Bound +1)))))
(record$ (#Cons [(tag$ ["lux" "tags"])
(tuple$ (#Cons (text$ "Left") (#Cons (text$ "Right") #Nil)))]
(#Cons [(tag$ ["lux" "type-args"])
- (tuple$ (#Cons (text$ "l") (#Cons (text$ "r") #;Nil)))]
+ (tuple$ (#Cons (text$ "l") (#Cons (text$ "r") #Nil)))]
(#Cons [(tag$ ["lux" "doc"])
(text$ "A choice between two values of different types.")]
default-def-meta-exported)))))
@@ -603,28 +603,28 @@
## #module-state Module-State})
("lux def" Module
(#Named ["lux" "Module"]
- (#Product ## "lux;module-hash"
+ (#Product ## "lux.module-hash"
Nat
- (#Product ## "lux;module-aliases"
+ (#Product ## "lux.module-aliases"
(#Apply (#Product Text Text) List)
- (#Product ## "lux;defs"
+ (#Product ## "lux.defs"
(#Apply (#Product Text Def) List)
- (#Product ## "lux;imports"
+ (#Product ## "lux.imports"
(#Apply Text List)
- (#Product ## "lux;tags"
+ (#Product ## "lux.tags"
(#Apply (#Product Text
(#Product Nat
(#Product (#Apply Ident List)
(#Product Bool
Type))))
List)
- (#Product ## "lux;types"
+ (#Product ## "lux.types"
(#Apply (#Product Text
(#Product (#Apply Ident List)
(#Product Bool
Type)))
List)
- (#Product ## "lux;module-annotations"
+ (#Product ## "lux.module-annotations"
Code
Module-State))
))))))
@@ -720,27 +720,27 @@
## #host Void})
("lux def" Compiler
(#Named ["lux" "Compiler"]
- (#Product ## "lux;info"
+ (#Product ## "lux.info"
Info
- (#Product ## "lux;source"
+ (#Product ## "lux.source"
Source
- (#Product ## "lux;cursor"
+ (#Product ## "lux.cursor"
Cursor
- (#Product ## "lux;current-module"
+ (#Product ## "lux.current-module"
(#Apply Text Maybe)
- (#Product ## "lux;modules"
+ (#Product ## "lux.modules"
(#Apply (#Product Text Module) List)
- (#Product ## "lux;scopes"
+ (#Product ## "lux.scopes"
(#Apply Scope List)
- (#Product ## "lux;type-context"
+ (#Product ## "lux.type-context"
Type-Context
- (#Product ## "lux;expected"
+ (#Product ## "lux.expected"
(#Apply Type Maybe)
- (#Product ## "lux;seed"
+ (#Product ## "lux.seed"
Nat
(#Product ## scope-type-vars
(#Apply Nat List)
- ## "lux;host"
+ ## "lux.host"
Void)))))))))))
(record$ (#Cons [(tag$ ["lux" "tags"])
(tuple$ (#Cons (text$ "info")
@@ -776,7 +776,7 @@
These computations may fail, or modify the state of the compiler.")]
(#Cons [(tag$ ["lux" "type-args"])
- (tuple$ (#Cons (text$ "a") #;Nil))]
+ (tuple$ (#Cons (text$ "a") #Nil))]
default-def-meta-exported))))
## (type: Macro
@@ -826,7 +826,7 @@
("lux case" tokens
{(#Cons lhs (#Cons rhs (#Cons body #Nil)))
(return (#Cons (form$ (#Cons (text$ "lux case")
- (#Cons rhs (#Cons (record$ (#;Cons [lhs body] #Nil)) #Nil))))
+ (#Cons rhs (#Cons (record$ (#Cons [lhs body] #Nil)) #Nil))))
#Nil))
_
@@ -1003,612 +1003,612 @@
(record$ default-macro-meta))
(def:'' (macro:' tokens)
- 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))
+ 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:'")}))
+ _
+ (fail "Wrong syntax for macro:'")}))
(macro:' #export (comment tokens)
- (#Cons [(tag$ ["lux" "doc"])
- (text$ "## Throws away any code given to it.
+ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "## Throws away any code given to it.
## Great for commenting-out code, while retaining syntax high-lighting and formatting in your text editor.
(comment 1 2 3 4)")]
- #;Nil)
- (return #Nil))
+ #Nil)
+ (return #Nil))
(macro:' ($' tokens)
- ("lux case" tokens
- {(#Cons x #Nil)
- (return 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 (#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
- (#UnivQ #Nil
- (#UnivQ #Nil
- (#Function (#Function (#Bound +3) (#Bound +1))
- (#Function ($' List (#Bound +3))
- ($' List (#Bound +1))))))
- ("lux case" xs
- {#Nil
- #Nil
+ #Nil
+ (#UnivQ #Nil
+ (#UnivQ #Nil
+ (#Function (#Function (#Bound +3) (#Bound +1))
+ (#Function ($' List (#Bound +3))
+ ($' List (#Bound +1))))))
+ ("lux case" xs
+ {#Nil
+ #Nil
- (#Cons x xs')
- (#Cons (f x) (map f xs'))}))
+ (#Cons x xs')
+ (#Cons (f x) (map f xs'))}))
(def:'' RepEnv
- #;Nil
- Type
- ($' List (#Product Text Code)))
+ #Nil
+ Type
+ ($' List (#Product Text Code)))
(def:'' (make-env xs ys)
- #;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'))
+ #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'))
- _
- #Nil}))
+ _
+ #Nil}))
(def:'' (text/= x y)
- #;Nil
- (#Function Text (#Function Text Bool))
- ("lux text =" x y))
+ #Nil
+ (#Function Text (#Function Text Bool))
+ ("lux text =" x y))
(def:'' (get-rep key env)
- #;Nil
- (#Function Text (#Function RepEnv ($' Maybe Code)))
- ("lux case" env
- {#Nil
- #None
+ #Nil
+ (#Function Text (#Function RepEnv ($' Maybe Code)))
+ ("lux case" env
+ {#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
+ #Nil
+ (#Function RepEnv (#Function Code Code))
+ ("lux case" syntax
+ {[_ (#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))
+ #Nil
+ (#Function Code Code)
+ ("lux case" code
+ {[_ (#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 nat +" +2 idx)) #Nil)))
+ [_ (#Form (#Cons [_ (#Tag "lux" "Bound")] (#Cons [_ (#Nat idx)] #Nil)))]
+ (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ ("lux 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
- ## (-> (List Code) (-> (List Text) (Meta (List Code))) (Meta (List Code)))
- (#Function ($' List Code)
- (#Function (#Function ($' List Text) (#Apply ($' List Code) Meta))
- (#Apply ($' List Code) Meta)
- ))
- ("lux case" args
- {#Nil
- (next #Nil)
-
- (#Cons [_ (#Symbol "" arg-name)] args')
- (parse-quantified-args args' (function'' [names] (next (#Cons arg-name names))))
+ #Nil
+ ## (-> (List Code) (-> (List Text) (Meta (List Code))) (Meta (List Code)))
+ (#Function ($' List Code)
+ (#Function (#Function ($' List Text) (#Apply ($' List Code) Meta))
+ (#Apply ($' List Code) Meta)
+ ))
+ ("lux case" args
+ {#Nil
+ (next #Nil)
- _
- (fail "Expected symbol.")}
- ))
+ (#Cons [_ (#Symbol "" arg-name)] args')
+ (parse-quantified-args args' (function'' [names] (next (#Cons arg-name names))))
+
+ _
+ (fail "Expected symbol.")}
+ ))
(def:'' (make-bound idx)
- #;Nil
- (#Function Nat Code)
- (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ idx) #Nil))))
+ #Nil
+ (#Function Nat Code)
+ (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ idx) #Nil))))
(def:'' (list/fold f init xs)
- #;Nil
- ## (All [a b] (-> (-> b a a) a (List b) a))
- (#UnivQ #Nil (#UnivQ #Nil (#Function (#Function (#Bound +1)
- (#Function (#Bound +3)
- (#Bound +3)))
- (#Function (#Bound +3)
- (#Function ($' List (#Bound +1))
- (#Bound +3))))))
- ("lux case" xs
- {#Nil
- init
+ #Nil
+ ## (All [a b] (-> (-> b a a) a (List b) a))
+ (#UnivQ #Nil (#UnivQ #Nil (#Function (#Function (#Bound +1)
+ (#Function (#Bound +3)
+ (#Bound +3)))
+ (#Function (#Bound +3)
+ (#Function ($' List (#Bound +1))
+ (#Bound +3))))))
+ ("lux case" xs
+ {#Nil
+ init
- (#Cons x xs')
- (list/fold f (f x init) xs')}))
+ (#Cons x xs')
+ (list/fold f (f x init) xs')}))
(def:'' (list/size list)
- #;Nil
- (#UnivQ #Nil
- (#Function ($' List (#Bound +1)) Nat))
- (list/fold (function'' [_ acc] ("lux nat +" +1 acc)) +0 list))
+ #Nil
+ (#UnivQ #Nil
+ (#Function ($' List (#Bound +1)) Nat))
+ (list/fold (function'' [_ acc] ("lux nat +" +1 acc)) +0 list))
(macro:' #export (All tokens)
- (#Cons [(tag$ ["lux" "doc"])
- (text$ "## Universal quantification.
- (All [a]
- (-> a a))
-
- ## A name can be provided, to specify a recursive type.
- (All List [a]
- (| Unit
- [a (List a)]))")]
- #;Nil)
- (let'' [self-name tokens] ("lux case" tokens
- {(#Cons [_ (#Symbol "" self-name)] tokens)
- [self-name tokens]
-
- _
- ["" tokens]})
- ("lux case" tokens
- {(#Cons [_ (#Tuple args)] (#Cons body #Nil))
- (parse-quantified-args args
- (function'' [names]
- (let'' body' (list/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 nat *"
- +2 ("lux nat -"
- (list/size names)
- +1)))]
- #Nil)
- body')})
- #Nil)))))
-
- _
- (fail "Wrong syntax for All")})
- ))
+ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "## Universal quantification.
+ (All [a]
+ (-> a a))
+
+ ## A name can be provided, to specify a recursive type.
+ (All List [a]
+ (| Unit
+ [a (List a)]))")]
+ #Nil)
+ (let'' [self-name tokens] ("lux case" tokens
+ {(#Cons [_ (#Symbol "" self-name)] tokens)
+ [self-name tokens]
+
+ _
+ ["" tokens]})
+ ("lux case" tokens
+ {(#Cons [_ (#Tuple args)] (#Cons body #Nil))
+ (parse-quantified-args args
+ (function'' [names]
+ (let'' body' (list/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 nat *"
+ +2 ("lux nat -"
+ (list/size names)
+ +1)))]
+ #Nil)
+ body')})
+ #Nil)))))
+
+ _
+ (fail "Wrong syntax for All")})
+ ))
(macro:' #export (Ex tokens)
- (#Cons [(tag$ ["lux" "doc"])
- (text$ "## Existential quantification.
- (Ex [a]
- [(Codec Text a)
- a])
-
- ## A name can be provided, to specify a recursive type.
- (Ex Self [a]
- [(Codec Text a)
- a
- (List (Self a))])")]
- #;Nil)
- (let'' [self-name tokens] ("lux case" tokens
- {(#Cons [_ (#Symbol "" self-name)] tokens)
- [self-name tokens]
-
- _
- ["" tokens]})
- ("lux case" tokens
- {(#Cons [_ (#Tuple args)] (#Cons body #Nil))
- (parse-quantified-args args
- (function'' [names]
- (let'' body' (list/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 nat *"
- +2 ("lux nat -"
- (list/size names)
- +1)))]
- #Nil)
- body')})
- #Nil)))))
-
- _
- (fail "Wrong syntax for Ex")})
- ))
+ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "## Existential quantification.
+ (Ex [a]
+ [(Codec Text a)
+ a])
+
+ ## A name can be provided, to specify a recursive type.
+ (Ex Self [a]
+ [(Codec Text a)
+ a
+ (List (Self a))])")]
+ #Nil)
+ (let'' [self-name tokens] ("lux case" tokens
+ {(#Cons [_ (#Symbol "" self-name)] tokens)
+ [self-name tokens]
+
+ _
+ ["" tokens]})
+ ("lux case" tokens
+ {(#Cons [_ (#Tuple args)] (#Cons body #Nil))
+ (parse-quantified-args args
+ (function'' [names]
+ (let'' body' (list/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 nat *"
+ +2 ("lux nat -"
+ (list/size names)
+ +1)))]
+ #Nil)
+ body')})
+ #Nil)))))
+
+ _
+ (fail "Wrong syntax for Ex")})
+ ))
(def:'' (list/reverse list)
- #;Nil
- (All [a] (#Function ($' List a) ($' List a)))
- (list/fold ("lux check" (All [a] (#Function a (#Function ($' List a) ($' List a))))
- (function'' [head tail] (#Cons head tail)))
- #Nil
- list))
+ #Nil
+ (All [a] (#Function ($' List a) ($' List a)))
+ (list/fold ("lux check" (All [a] (#Function a (#Function ($' List a) ($' List a))))
+ (function'' [head tail] (#Cons head tail)))
+ #Nil
+ list))
(macro:' #export (-> tokens)
- (#Cons [(tag$ ["lux" "doc"])
- (text$ "## Function types:
+ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "## Function types:
(-> Int Int Int)
## This is the type of a function that takes 2 Ints and returns an Int.")]
- #;Nil)
- ("lux case" (list/reverse tokens)
- {(#Cons output inputs)
- (return (#Cons (list/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 ->")}))
+ #Nil)
+ ("lux case" (list/reverse tokens)
+ {(#Cons output inputs)
+ (return (#Cons (list/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"])
- (text$ "## List-construction macro.
+ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "## List-construction macro.
(list 1 2 3)")]
- #;Nil)
- (return (#Cons (list/fold (function'' [head tail]
- (form$ (#Cons (tag$ ["lux" "Cons"])
- (#Cons (tuple$ (#Cons [head (#Cons [tail #Nil])]))
- #Nil))))
- (tag$ ["lux" "Nil"])
- (list/reverse xs))
- #Nil)))
+ #Nil)
+ (return (#Cons (list/fold (function'' [head tail]
+ (form$ (#Cons (tag$ ["lux" "Cons"])
+ (#Cons (tuple$ (#Cons [head (#Cons [tail #Nil])]))
+ #Nil))))
+ (tag$ ["lux" "Nil"])
+ (list/reverse xs))
+ #Nil)))
(macro:' #export (list& xs)
- (#Cons [(tag$ ["lux" "doc"])
- (text$ "## List-construction macro, with the last element being a tail-list.
+ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "## List-construction macro, with the last element being a tail-list.
## In other words, this macro prepends elements to another list.
(list& 1 2 3 (list 4 5 6))")]
- #;Nil)
- ("lux case" (list/reverse xs)
- {(#Cons last init)
- (return (list (list/fold (function'' [head tail]
- (form$ (list (tag$ ["lux" "Cons"])
- (tuple$ (list head tail)))))
- last
- init)))
+ #Nil)
+ ("lux case" (list/reverse xs)
+ {(#Cons last init)
+ (return (list (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"])
- (text$ "## Tuple types:
- (& Text Int Bool)
-
- ## The empty tuple, a.k.a. Unit.
- (&)")]
- #;Nil)
- ("lux case" (list/reverse tokens)
- {#Nil
- (return (list (tag$ ["lux" "Unit"])))
-
- (#Cons last prevs)
- (return (list (list/fold (function'' [left right] (form$ (list (tag$ ["lux" "Product"]) left right)))
- last
- prevs)))}
- ))
+ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "## Tuple types:
+ (& Text Int Bool)
+
+ ## The empty tuple, a.k.a. Unit.
+ (&)")]
+ #Nil)
+ ("lux case" (list/reverse tokens)
+ {#Nil
+ (return (list (tag$ ["lux" "Unit"])))
+
+ (#Cons last prevs)
+ (return (list (list/fold (function'' [left right] (form$ (list (tag$ ["lux" "Product"]) left right)))
+ last
+ prevs)))}
+ ))
(macro:' #export (| tokens)
- (#Cons [(tag$ ["lux" "doc"])
- (text$ "## Variant types:
- (| Text Int Bool)
-
- ## The empty tuple, a.k.a. Void.
- (|)")]
- #;Nil)
- ("lux case" (list/reverse tokens)
- {#Nil
- (return (list (tag$ ["lux" "Void"])))
-
- (#Cons last prevs)
- (return (list (list/fold (function'' [left right] (form$ (list (tag$ ["lux" "Sum"]) left right)))
- last
- prevs)))}
- ))
+ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "## Variant types:
+ (| Text Int Bool)
+
+ ## The empty tuple, a.k.a. Void.
+ (|)")]
+ #Nil)
+ ("lux case" (list/reverse tokens)
+ {#Nil
+ (return (list (tag$ ["lux" "Void"])))
+
+ (#Cons last prevs)
+ (return (list (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']
+ (let'' [name tokens'] ("lux case" tokens
+ {(#Cons [[_ (#Symbol ["" name])] tokens'])
+ [name 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
- (list/fold (function'' [arg body']
- (form$ (list (text$ "lux function")
- (symbol$ ["" ""])
- arg
- body')))
- body
- (list/reverse targs))))))})
+ _
+ ["" 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
+ (list/fold (function'' [arg body']
+ (form$ (list (text$ "lux function")
+ (symbol$ ["" ""])
+ arg
+ body')))
+ body
+ (list/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)))))))
+ ("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'''")}
- ))
+ _
+ (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'))
+ #Nil
+ (All [a] (-> ($' List a) ($' List (& a a))))
+ ("lux case" 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 (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
- (list/reverse (as-pairs bindings)))))
+ ("lux case" tokens
+ {(#Cons [[_ (#Tuple bindings)] (#Cons [body #Nil])])
+ (return (list (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
+ (list/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
-
- (#Cons x xs')
- ("lux case" (p x)
- {true true
- false (any? p xs')})}))
+ #Nil
+ (All [a]
+ (-> (-> a Bool) ($' List a) Bool))
+ ("lux case" xs
+ {#Nil
+ false
+
+ (#Cons x xs')
+ ("lux case" (p x)
+ {true true
+ false (any? p xs')})}))
(def:''' (wrap-meta content)
- #;Nil
- (-> Code Code)
- (tuple$ (list (tuple$ (list (text$ "") (nat$ +0) (nat$ +0)))
- content)))
+ #Nil
+ (-> Code Code)
+ (tuple$ (list (tuple$ (list (text$ "") (nat$ +0) (nat$ +0)))
+ content)))
(def:''' (untemplate-list tokens)
- #;Nil
- (-> ($' List Code) Code)
- ("lux case" tokens
- {#Nil
- (_ann (#Tag ["lux" "Nil"]))
+ #Nil
+ (-> ($' List Code) Code)
+ ("lux case" tokens
+ {#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))
+ #Nil
+ (All [a] (-> ($' List a) ($' List a) ($' List a)))
+ ("lux case" xs
+ {(#Cons x xs')
+ (#Cons x (list/compose xs' ys))
- #Nil
- ys}))
+ #Nil
+ ys}))
(def:''' #export (splice-helper xs ys)
- (#Cons [(tag$ ["lux" "hidden?"])
- (bool$ true)]
- #;Nil)
- (-> ($' List Code) ($' List Code) ($' List Code))
- ("lux case" xs
- {(#Cons x xs')
- (#Cons x (splice-helper xs' ys))
+ (#Cons [(tag$ ["lux" "hidden?"])
+ (bool$ true)]
+ #Nil)
+ (-> ($' List Code) ($' List Code) ($' List Code))
+ ("lux case" xs
+ {(#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)))
+ #Nil
+ (-> Code Code Code Code)
+ ("lux case" op
+ {[_ (#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"])
- (text$ "## Left-association for the application of binary functions over variadic arguments.
- (_$ text/compose \"Hello, \" name \".\\nHow are you?\")
-
- ## =>
- (text/compose (text/compose \"Hello, \" name) \".\\nHow are you?\")")]
- #;Nil)
- ("lux case" tokens
- {(#Cons op tokens')
- ("lux case" tokens'
- {(#Cons first nexts)
- (return (list (list/fold (_$_joiner op) first nexts)))
+ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "## Left-association for the application of binary functions over variadic arguments.
+ (_$ text/compose \"Hello, \" name \".\\nHow are you?\")
- _
- (fail "Wrong syntax for _$")})
-
- _
- (fail "Wrong syntax for _$")}))
+ ## =>
+ (text/compose (text/compose \"Hello, \" name) \".\\nHow are you?\")")]
+ #Nil)
+ ("lux case" tokens
+ {(#Cons op tokens')
+ ("lux case" tokens'
+ {(#Cons first nexts)
+ (return (list (list/fold (_$_joiner op) first nexts)))
+
+ _
+ (fail "Wrong syntax for _$")})
+
+ _
+ (fail "Wrong syntax for _$")}))
(macro:' #export ($_ tokens)
- (#Cons [(tag$ ["lux" "doc"])
- (text$ "## Right-association for the application of binary functions over variadic arguments.
- ($_ text/compose \"Hello, \" name \".\\nHow are you?\")
-
- ## =>
- (text/compose \"Hello, \" (text/compose name \".\\nHow are you?\"))")]
- #;Nil)
- ("lux case" tokens
- {(#Cons op tokens')
- ("lux case" (list/reverse tokens')
- {(#Cons last prevs)
- (return (list (list/fold (_$_joiner op) last prevs)))
+ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "## Right-association for the application of binary functions over variadic arguments.
+ ($_ text/compose \"Hello, \" name \".\\nHow are you?\")
- _
- (fail "Wrong syntax for $_")})
-
- _
- (fail "Wrong syntax for $_")}))
+ ## =>
+ (text/compose \"Hello, \" (text/compose name \".\\nHow are you?\"))")]
+ #Nil)
+ ("lux case" tokens
+ {(#Cons op tokens')
+ ("lux case" (list/reverse tokens')
+ {(#Cons last prevs)
+ (return (list (list/fold (_$_joiner op) last prevs)))
+
+ _
+ (fail "Wrong syntax for $_")})
+
+ _
+ (fail "Wrong syntax for $_")}))
## (sig: (Monad m)
## (: (All [a] (-> a (m a)))
@@ -1616,639 +1616,644 @@
## (: (All [a b] (-> (-> a (m b)) (m a) (m b)))
## bind))
(def:''' Monad
- (list& [(tag$ ["lux" "tags"])
- (tuple$ (list (text$ "wrap") (text$ "bind")))]
- default-def-meta-unexported)
- Type
- (#Named ["lux" "Monad"]
- (All [m]
- (& (All [a] (-> a ($' m a)))
- (All [a b] (-> (-> a ($' m b))
- ($' m a)
- ($' m b)))))))
+ (list& [(tag$ ["lux" "tags"])
+ (tuple$ (list (text$ "wrap") (text$ "bind")))]
+ default-def-meta-unexported)
+ Type
+ (#Named ["lux" "Monad"]
+ (All [m]
+ (& (All [a] (-> a ($' m a)))
+ (All [a b] (-> (-> a ($' m b))
+ ($' m a)
+ ($' m b)))))))
(def:''' Monad<Maybe>
- #Nil
- ($' Monad Maybe)
- {#wrap
- (function' [x] (#Some x))
-
- #bind
- (function' [f ma]
- ("lux case" ma
- {#None #None
- (#Some a) (f a)}))})
+ #Nil
+ ($' Monad Maybe)
+ {#wrap
+ (function' [x] (#Some x))
+
+ #bind
+ (function' [f ma]
+ ("lux case" ma
+ {#None #None
+ (#Some a) (f a)}))})
(def:''' Monad<Meta>
- #Nil
- ($' Monad Meta)
- {#wrap
- (function' [x]
- (function' [state]
- (#Right state x)))
-
- #bind
- (function' [f ma]
- (function' [state]
- ("lux case" (ma state)
- {(#Left msg)
- (#Left msg)
+ #Nil
+ ($' Monad Meta)
+ {#wrap
+ (function' [x]
+ (function' [state]
+ (#Right state x)))
+
+ #bind
+ (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
- {(#Cons monad (#Cons [_ (#Tuple bindings)] (#Cons body #Nil)))
- (let' [g!wrap (symbol$ ["" "wrap"])
- g!bind (symbol$ ["" " bind "])
- body' (list/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
- (list/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'])))))))
+ ("lux case" tokens
+ {(#Cons monad (#Cons [_ (#Tuple bindings)] (#Cons body #Nil)))
+ (let' [g!wrap (symbol$ ["" "wrap"])
+ g!bind (symbol$ ["" " bind "])
+ body' (list/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
+ (list/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:''' (monad/map m f xs)
- #Nil
- ## (All [m a b]
- ## (-> (Monad m) (-> a (m b)) (List a) (m (List b))))
- (All [m a b]
- (-> ($' Monad m)
- (-> a ($' m b))
- ($' List a)
- ($' m ($' List b))))
- (let' [{#;wrap wrap #;bind _} m]
- ("lux case" xs
- {#Nil
- (wrap #Nil)
-
- (#Cons x xs')
- (do m
- [y (f x)
- ys (monad/map m f xs')]
- (wrap (#Cons y ys)))
- })))
+ #Nil
+ ## (All [m a b]
+ ## (-> (Monad m) (-> a (m b)) (List a) (m (List b))))
+ (All [m a b]
+ (-> ($' Monad m)
+ (-> a ($' m b))
+ ($' List a)
+ ($' m ($' List b))))
+ (let' [{#wrap wrap #bind _} m]
+ ("lux case" xs
+ {#Nil
+ (wrap #Nil)
+
+ (#Cons x xs')
+ (do m
+ [y (f x)
+ ys (monad/map m f xs')]
+ (wrap (#Cons y ys)))
+ })))
(def:''' (monad/fold m f y xs)
- #Nil
- ## (All [m a b]
- ## (-> (Monad m) (-> a b (m b)) b (List a) (m b)))
- (All [m a b]
- (-> ($' Monad m)
- (-> a b ($' m b))
- b
- ($' List a)
- ($' m b)))
- (let' [{#;wrap wrap #;bind _} m]
- ("lux case" xs
- {#Nil
- (wrap y)
-
- (#Cons x xs')
- (do m
- [y' (f x y)]
- (monad/fold m f y' xs'))
- })))
+ #Nil
+ ## (All [m a b]
+ ## (-> (Monad m) (-> a b (m b)) b (List a) (m b)))
+ (All [m a b]
+ (-> ($' Monad m)
+ (-> a b ($' m b))
+ b
+ ($' List a)
+ ($' m b)))
+ (let' [{#wrap wrap #bind _} m]
+ ("lux case" xs
+ {#Nil
+ (wrap y)
+
+ (#Cons x xs')
+ (do m
+ [y' (f x y)]
+ (monad/fold m f y' xs'))
+ })))
(macro:' #export (if tokens)
- (list [(tag$ ["lux" "doc"])
- (text$ "Picks which expression to evaluate based on a boolean test value.
+ (list [(tag$ ["lux" "doc"])
+ (text$ "Picks which expression to evaluate based on a boolean test value.
- (if true
- \"Oh, yeah!\"
- \"Aw hell naw!\")
+ (if true
+ \"Oh, yeah!\"
+ \"Aw hell naw!\")
- => \"Oh, yeah!\"")])
- ("lux case" tokens
- {(#Cons test (#Cons then (#Cons else #Nil)))
- (return (list (form$ (list (text$ "lux case") test
- (record$ (list [(bool$ true) then]
- [(bool$ false) else]))))))
+ => \"Oh, yeah!\"")])
+ ("lux case" tokens
+ {(#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'))
-
- #Nil
- #None}))
+ #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'))
+
+ #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])
-
- (#Cons [[k' v'] dict'])
- (if (text/= k k')
- (#Cons [[k' v] dict'])
- (#Cons [[k' v'] (put k v dict')]))}))
+ #Nil
+ (All [a]
+ (-> Text a ($' List (& Text a)) ($' List (& Text a))))
+ ("lux case" dict
+ {#Nil
+ (list [k v])
+
+ (#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"])
- (text$ "Logs message to standard output.
+ (list [(tag$ ["lux" "doc"])
+ (text$ "Logs message to standard output.
- Useful for debugging.")])
- (-> Text Unit)
- ("lux io log" message))
+ Useful for debugging.")])
+ (-> Text Unit)
+ ("lux io log" message))
(def:''' (text/compose x y)
- #Nil
- (-> Text Text Text)
- ("lux text concat" x y))
+ #Nil
+ (-> Text Text Text)
+ ("lux text concat" x y))
(def:''' (ident/encode ident)
- #Nil
- (-> Ident Text)
- (let' [[module name] ident]
- ("lux case" module
- {"" name
- _ ($_ text/compose module ";" name)})))
+ #Nil
+ (-> Ident Text)
+ (let' [[module name] ident]
+ ("lux case" module
+ {"" 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)
+ #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)
- _
- (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
- (-> Ident ($' Meta Ident))
- (let' [[module name] ident
- {#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} 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])
+ #Nil
+ (-> Ident ($' Meta Ident))
+ (let' [[module name] ident
+ {#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} 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])
- _
- (#Right [state ident])})
+ _
+ (#Right [state ident])})
- #None
- (#Left ($_ text/compose "Unknown definition: " (ident/encode ident)))})
-
- #None
- (#Left ($_ text/compose "Unknown module: " module " @ " (ident/encode ident)))})))
+ #None
+ (#Left ($_ text/compose "Unknown definition: " (ident/encode ident)))})
+
+ #None
+ (#Left ($_ text/compose "Unknown module: " module " @ " (ident/encode ident)))})))
(def:''' (splice replace? untemplate elems)
- #Nil
- (-> Bool (-> Code ($' Meta Code)) ($' List Code) ($' Meta Code))
- ("lux case" replace?
- {true
- ("lux case" (list/reverse elems)
- {#Nil
- (return (tag$ ["lux" "Nil"]))
-
- (#Cons lastI inits)
- (do Monad<Meta>
- [lastO ("lux case" lastI
- {[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))]
- (wrap spliced)
+ #Nil
+ (-> Bool (-> Code ($' Meta Code)) ($' List Code) ($' Meta Code))
+ ("lux case" replace?
+ {true
+ ("lux case" (list/reverse elems)
+ {#Nil
+ (return (tag$ ["lux" "Nil"]))
+
+ (#Cons lastI inits)
+ (do Monad<Meta>
+ [lastO ("lux case" lastI
+ {[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))]
+ (wrap spliced)
- _
- (do Monad<Meta>
- [lastO (untemplate lastI)]
- (wrap (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list lastO (tag$ ["lux" "Nil"])))))))})]
- (monad/fold Monad<Meta>
- (function' [leftI rightO]
- ("lux case" leftI
- {[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))]
- (wrap (form$ (list (symbol$ ["lux" "splice-helper"])
- spliced
- rightO)))
+ _
+ (do Monad<Meta>
+ [lastO (untemplate lastI)]
+ (wrap (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list lastO (tag$ ["lux" "Nil"])))))))})]
+ (monad/fold Monad<Meta>
+ (function' [leftI rightO]
+ ("lux case" leftI
+ {[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))]
+ (wrap (form$ (list (symbol$ ["lux" "splice-helper"])
+ spliced
+ rightO)))
- _
- (do Monad<Meta>
- [leftO (untemplate leftI)]
- (wrap (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list leftO rightO))))))}))
- lastO
- inits))})
- false
- (do Monad<Meta>
- [=elems (monad/map Monad<Meta> untemplate elems)]
- (wrap (untemplate-list =elems)))}))
+ _
+ (do Monad<Meta>
+ [leftO (untemplate leftI)]
+ (wrap (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list leftO rightO))))))}))
+ lastO
+ inits))})
+ false
+ (do Monad<Meta>
+ [=elems (monad/map Monad<Meta> untemplate elems)]
+ (wrap (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)))))
-
- [_ [_ (#Nat value)]]
- (return (wrap-meta (form$ (list (tag$ ["lux" "Nat"]) (nat$ value)))))
-
- [_ [_ (#Int value)]]
- (return (wrap-meta (form$ (list (tag$ ["lux" "Int"]) (int$ value)))))
+ #Nil
+ (-> Bool Text Code ($' Meta Code))
+ ("lux case" [replace? token]
+ {[_ [_ (#Bool value)]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "Bool"]) (bool$ 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)))))
-
- [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
+ [_ [_ (#Nat value)]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "Nat"]) (nat$ value)))))
- _
- 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]))
+ [_ [_ (#Int value)]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "Int"]) (int$ value)))))
- _
- (wrap [module name])})
- #let [[module name] real-name]]
- (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (tuple$ (list (text$ module) (text$ name))))))))
+ [_ [_ (#Deg value)]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "Deg"]) (deg$ value)))))
+
+ [_ [_ (#Frac value)]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "Frac"]) (frac$ value)))))
- [false [_ (#Symbol [module name])]]
- (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (tuple$ (list (text$ module) (text$ name)))))))
+ [_ [_ (#Text value)]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "Text"]) (text$ value)))))
- [true [_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))]]
- (return unquoted)
+ [false [_ (#Tag [module name])]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module) (text$ name)))))))
- [true [_ (#Form (#Cons [[_ (#Symbol ["" "~'"])] (#Cons [keep-quoted #Nil])]))]]
- (untemplate false subst keep-quoted)
+ [true [_ (#Tag [module name])]]
+ (let' [module' ("lux case" module
+ {""
+ subst
- [_ [meta (#Form elems)]]
- (do Monad<Meta>
- [output (splice replace? (untemplate replace? subst) elems)
- #let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Form"]) output)))]]
- (wrap [meta output']))
+ _
+ module})]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module') (text$ name))))))))
- [_ [meta (#Tuple elems)]]
- (do Monad<Meta>
- [output (splice replace? (untemplate replace? subst) elems)
- #let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Tuple"]) output)))]]
- (wrap [meta output']))
+ [true [_ (#Symbol [module name])]]
+ (do Monad<Meta>
+ [real-name ("lux case" module
+ {""
+ (if (text/= "" subst)
+ (wrap [module name])
+ (resolve-global-symbol [subst name]))
- [_ [_ (#Record fields)]]
- (do Monad<Meta>
- [=fields (monad/map 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)))))))
+
+ [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) elems)
+ #let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Form"]) output)))]]
+ (wrap [meta output']))
+
+ [_ [meta (#Tuple elems)]]
+ (do Monad<Meta>
+ [output (splice replace? (untemplate replace? subst) elems)
+ #let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Tuple"]) output)))]]
+ (wrap [meta output']))
+
+ [_ [_ (#Record fields)]]
+ (do Monad<Meta>
+ [=fields (monad/map 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)
- (list [(tag$ ["lux" "doc"])
- (text$ "## Macro to treat define new primitive types.
- (primitive \"java.lang.Object\")
+ (list [(tag$ ["lux" "doc"])
+ (text$ "## Macro to treat define new primitive types.
+ (primitive \"java.lang.Object\")
- (primitive \"java.util.List\" [(primitive \"java.lang.Long\")])")])
- ("lux case" tokens
- {(#Cons [_ (#Text class-name)] #Nil)
- (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (tag$ ["lux" "Nil"])))))
+ (primitive \"java.util.List\" [(primitive \"java.lang.Long\")])")])
+ ("lux case" tokens
+ {(#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])
+ #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])
- _
- (#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"])
- (text$ "## Hygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms.
- ## All unprefixed macros will receive their parent module's prefix if imported; otherwise will receive the prefix of the module on which the quasi-quote is being used.
- (` (def: (~ name)
- (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)))))
+ (list [(tag$ ["lux" "doc"])
+ (text$ "## Hygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms.
+ ## All unprefixed macros will receive their parent module's prefix if imported; otherwise will receive the prefix of the module on which the quasi-quote is being used.
+ (` (def: (~ name)
+ (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)))))
- _
- (fail "Wrong syntax for `")}))
+ _
+ (fail "Wrong syntax for `")}))
(macro:' #export (`' tokens)
- (list [(tag$ ["lux" "doc"])
- (text$ "## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms.
- (`' (def: (~ name)
- (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)))))
+ (list [(tag$ ["lux" "doc"])
+ (text$ "## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms.
+ (`' (def: (~ name)
+ (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)))))
- _
- (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)))))
+ (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)))))
- _
- (fail "Wrong syntax for '")}))
+ _
+ (fail "Wrong syntax for '")}))
(macro:' #export (|> tokens)
- (list [(tag$ ["lux" "doc"])
- (text$ "## Piping macro.
- (|> elems (map int/encode) (interpose \" \") (fold text/compose \"\"))
-
- ## =>
- (fold text/compose \"\"
- (interpose \" \"
- (map int/encode elems)))")])
- ("lux case" tokens
- {(#Cons [init apps])
- (return (list (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)))
-
- _
- (` ((~ app) (~ acc)))})))
- init
- apps)))
+ (list [(tag$ ["lux" "doc"])
+ (text$ "## Piping macro.
+ (|> elems (map int/encode) (interpose \" \") (fold text/compose \"\"))
+
+ ## =>
+ (fold text/compose \"\"
+ (interpose \" \"
+ (map int/encode elems)))")])
+ ("lux case" tokens
+ {(#Cons [init apps])
+ (return (list (list/fold ("lux check" (-> Code Code Code)
+ (function' [app acc]
+ ("lux case" app
+ {[_ (#Tuple parts)]
+ (tuple$ (list/compose parts (list acc)))
- _
- (fail "Wrong syntax for |>")}))
+ [_ (#Form parts)]
+ (form$ (list/compose parts (list acc)))
+
+ _
+ (` ((~ app) (~ acc)))})))
+ init
+ apps)))
+
+ _
+ (fail "Wrong syntax for |>")}))
(macro:' #export (<| tokens)
- (list [(tag$ ["lux" "doc"])
- (text$ "## Reverse piping macro.
- (<| (fold text/compose \"\") (interpose \" \") (map int/encode) elems)
-
- ## =>
- (fold text/compose \"\"
- (interpose \" \"
- (map int/encode elems)))")])
- ("lux case" (list/reverse tokens)
- {(#Cons [init apps])
- (return (list (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)))
-
- _
- (` ((~ app) (~ acc)))})))
- init
- apps)))
+ (list [(tag$ ["lux" "doc"])
+ (text$ "## Reverse piping macro.
+ (<| (fold text/compose \"\") (interpose \" \") (map int/encode) elems)
+
+ ## =>
+ (fold text/compose \"\"
+ (interpose \" \"
+ (map int/encode elems)))")])
+ ("lux case" (list/reverse tokens)
+ {(#Cons [init apps])
+ (return (list (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)))
+
+ _
+ (` ((~ app) (~ acc)))})))
+ init
+ apps)))
- _
- (fail "Wrong syntax for <|")}))
+ _
+ (fail "Wrong syntax for <|")}))
(def:''' (compose f g)
- (list [(tag$ ["lux" "doc"])
- (text$ "Function composition.")])
- (All [a b c]
- (-> (-> b c) (-> a b) (-> a c)))
- (function' [x] (f (g x))))
+ (list [(tag$ ["lux" "doc"])
+ (text$ "Function composition.")])
+ (All [a b c]
+ (-> (-> b c) (-> a b) (-> a c)))
+ (function' [x] (f (g x))))
(def:''' (get-ident x)
- #Nil
- (-> Code ($' Maybe Ident))
- ("lux case" x
- {[_ (#Symbol sname)]
- (#Some sname)
+ #Nil
+ (-> Code ($' Maybe Ident))
+ ("lux case" x
+ {[_ (#Symbol sname)]
+ (#Some sname)
- _
- #None}))
+ _
+ #None}))
(def:''' (get-tag x)
- #Nil
- (-> Code ($' Maybe Ident))
- ("lux case" x
- {[_ (#Tag sname)]
- (#Some sname)
+ #Nil
+ (-> Code ($' Maybe Ident))
+ ("lux case" x
+ {[_ (#Tag sname)]
+ (#Some sname)
- _
- #None}))
+ _
+ #None}))
(def:''' (get-name x)
- #Nil
- (-> Code ($' Maybe Text))
- ("lux case" x
- {[_ (#Symbol "" sname)]
- (#Some sname)
+ #Nil
+ (-> Code ($' Maybe Text))
+ ("lux case" x
+ {[_ (#Symbol "" sname)]
+ (#Some sname)
- _
- #None}))
+ _
+ #None}))
(def:''' (tuple->list tuple)
- #Nil
- (-> Code ($' Maybe ($' List Code)))
- ("lux case" tuple
- {[_ (#Tuple members)]
- (#Some members)
+ #Nil
+ (-> Code ($' Maybe ($' List Code)))
+ ("lux case" tuple
+ {[_ (#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
+ #Nil
+ (-> RepEnv Code Code)
+ ("lux case" template
+ {[_ (#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
+ (All [a b]
+ (-> (-> a ($' List b)) ($' List a) ($' List b)))
+ ("lux case" xs
+ {#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
- (All [a]
- (-> (-> a Bool) ($' List a) Bool))
- (list/fold (function' [_2 _1] (if _1 (p _2) false)) true xs))
+ #Nil
+ (All [a]
+ (-> (-> a Bool) ($' List a) Bool))
+ (list/fold (function' [_2 _1] (if _1 (p _2) false)) true xs))
(macro:' #export (do-template tokens)
- (list [(tag$ ["lux" "doc"])
- (text$ "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary.
- (do-template [<name> <diff>]
- [(def: #export <name>
- (-> Int Int)
- (i/+ <diff>))]
-
- [i/inc 1]
- [i/dec -1])")])
- ("lux case" tokens
- {(#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])])
- ("lux case" [(monad/map Monad<Maybe> get-name bindings)
- (monad/map 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 (list/size bindings')]
- (if (every? (function' [sample] ("lux nat =" num-bindings sample))
- (map list/size data'))
- (|> data'
- (join-map (compose apply (make-env bindings')))
- return)
- (fail "Irregular arguments tuples for do-template.")))
+ (list [(tag$ ["lux" "doc"])
+ (text$ "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary.
+ (do-template [<name> <diff>]
+ [(def: #export <name>
+ (-> Int Int)
+ (i/+ <diff>))]
+
+ [i/inc 1]
+ [i/dec -1])")])
+ ("lux case" tokens
+ {(#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])])
+ ("lux case" [(monad/map Monad<Maybe> get-name bindings)
+ (monad/map 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 (list/size bindings')]
+ (if (every? (function' [sample] ("lux nat =" num-bindings sample))
+ (map list/size data'))
+ (|> data'
+ (join-map (compose 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>
<eq-proc> <lt-proc> <eq-name> <lt-name> <lte-name> <gt-name> <gte-name>
<eq-doc> <<-doc> <<=-doc> <>-doc> <>=-doc>]
[(def:''' #export (<eq-name> test subject)
- (list [(tag$ ["lux" "doc"]) (text$ <eq-doc>)])
- (-> <type> <type> Bool)
- (<eq-proc> subject test))
+ (list [(tag$ ["lux" "doc"])
+ (text$ <eq-doc>)])
+ (-> <type> <type> Bool)
+ (<eq-proc> subject test))
(def:''' #export (<lt-name> test subject)
- (list [(tag$ ["lux" "doc"]) (text$ <<-doc>)])
- (-> <type> <type> Bool)
- (<lt-proc> subject test))
+ (list [(tag$ ["lux" "doc"])
+ (text$ <<-doc>)])
+ (-> <type> <type> Bool)
+ (<lt-proc> subject test))
(def:''' #export (<lte-name> test subject)
- (list [(tag$ ["lux" "doc"]) (text$ <<=-doc>)])
- (-> <type> <type> Bool)
- (if (<lt-proc> subject test)
- true
- (<eq-proc> subject test)))
+ (list [(tag$ ["lux" "doc"])
+ (text$ <<=-doc>)])
+ (-> <type> <type> Bool)
+ (if (<lt-proc> subject test)
+ true
+ (<eq-proc> subject test)))
(def:''' #export (<gt-name> test subject)
- (list [(tag$ ["lux" "doc"]) (text$ <>-doc>)])
- (-> <type> <type> Bool)
- (<lt-proc> test subject))
+ (list [(tag$ ["lux" "doc"])
+ (text$ <>-doc>)])
+ (-> <type> <type> Bool)
+ (<lt-proc> test subject))
(def:''' #export (<gte-name> test subject)
- (list [(tag$ ["lux" "doc"]) (text$ <>=-doc>)])
- (-> <type> <type> Bool)
- (if (<lt-proc> test subject)
- true
- (<eq-proc> subject test)))]
+ (list [(tag$ ["lux" "doc"])
+ (text$ <>=-doc>)])
+ (-> <type> <type> Bool)
+ (if (<lt-proc> test subject)
+ true
+ (<eq-proc> subject test)))]
[ Nat "lux nat =" "lux nat <" n/= n/< n/<= n/> n/>=
"Nat(ural) equality." "Nat(ural) less-than." "Nat(ural) less-than-equal." "Nat(ural) greater-than." "Nat(ural) greater-than-equal."]
@@ -2265,9 +2270,10 @@
(do-template [<type> <name> <op> <doc>]
[(def:''' #export (<name> param subject)
- (list [(tag$ ["lux" "doc"]) (text$ <doc>)])
- (-> <type> <type> <type>)
- (<op> subject param))]
+ (list [(tag$ ["lux" "doc"])
+ (text$ <doc>)])
+ (-> <type> <type> <type>)
+ (<op> subject param))]
[ Nat n/+ "lux nat +" "Nat(ural) addition."]
[ Nat n/- "lux nat -" "Nat(ural) substraction."]
@@ -2296,9 +2302,10 @@
(do-template [<type> <name> <op> <doc>]
[(def:''' #export (<name> param subject)
- (list [(tag$ ["lux" "doc"]) (text$ <doc>)])
- (-> Nat <type> <type>)
- (<op> subject param))]
+ (list [(tag$ ["lux" "doc"])
+ (text$ <doc>)])
+ (-> Nat <type> <type>)
+ (<op> subject param))]
[ Deg d/scale "lux deg scale" "Deg(ree) scale."]
[ Deg d/reciprocal "lux deg reciprocal" "Deg(ree) reciprocal."]
@@ -2306,11 +2313,12 @@
(do-template [<name> <type> <test> <doc>]
[(def:''' #export (<name> left right)
- (list [(tag$ ["lux" "doc"]) (text$ <doc>)])
- (-> <type> <type> <type>)
- (if (<test> right left)
- left
- right))]
+ (list [(tag$ ["lux" "doc"])
+ (text$ <doc>)])
+ (-> <type> <type> <type>)
+ (if (<test> right left)
+ left
+ right))]
[n/min Nat n/< "Nat(ural) minimum."]
[n/max Nat n/> "Nat(ural) maximum."]
@@ -2326,903 +2334,903 @@
)
(def:''' (bool/encode x)
- #Nil
- (-> Bool Text)
- (if x "true" "false"))
+ #Nil
+ (-> Bool Text)
+ (if x "true" "false"))
(def:''' (digit-to-text digit)
- #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 io error" "undefined")}))
+ #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 io error" "undefined")}))
(def:''' (nat/encode value)
- #Nil
- (-> Nat Text)
- ("lux case" value
- {+0
- "+0"
+ #Nil
+ (-> Nat Text)
+ ("lux case" value
+ {+0
+ "+0"
- _
- (let' [loop ("lux check" (-> Nat Text Text)
- (function' recur [input output]
- (if (n/= +0 input)
- (text/compose "+" output)
- (recur (n// +10 input)
- (text/compose (|> input (n/% +10) digit-to-text)
- output)))))]
- (loop value ""))}))
+ _
+ (let' [loop ("lux check" (-> Nat Text Text)
+ (function' recur [input output]
+ (if (n/= +0 input)
+ (text/compose "+" output)
+ (recur (n// +10 input)
+ (text/compose (|> input (n/% +10) digit-to-text)
+ output)))))]
+ (loop value ""))}))
(def:''' (int/abs value)
- #Nil
- (-> Int Int)
- (if (i/< 0 value)
- (i/* -1 value)
- value))
+ #Nil
+ (-> Int Int)
+ (if (i/< 0 value)
+ (i/* -1 value)
+ value))
(def:''' (int/encode value)
- #Nil
- (-> Int Text)
- (if (i/= 0 value)
- "0"
- (let' [sign (if (i/> 0 value)
- ""
- "-")]
- (("lux check" (-> Int Text Text)
- (function' recur [input output]
- (if (i/= 0 input)
- (text/compose sign output)
- (recur (i// 10 input)
- (text/compose (|> input (i/% 10) ("lux coerce" Nat) digit-to-text)
- output)))))
- (|> value (i// 10) int/abs)
- (|> value (i/% 10) int/abs ("lux coerce" Nat) digit-to-text)))))
+ #Nil
+ (-> Int Text)
+ (if (i/= 0 value)
+ "0"
+ (let' [sign (if (i/> 0 value)
+ ""
+ "-")]
+ (("lux check" (-> Int Text Text)
+ (function' recur [input output]
+ (if (i/= 0 input)
+ (text/compose sign output)
+ (recur (i// 10 input)
+ (text/compose (|> input (i/% 10) ("lux coerce" Nat) digit-to-text)
+ output)))))
+ (|> value (i// 10) int/abs)
+ (|> value (i/% 10) int/abs ("lux coerce" Nat) digit-to-text)))))
(def:''' (frac/encode x)
- #Nil
- (-> Frac Text)
- ("lux frac encode" x))
+ #Nil
+ (-> Frac Text)
+ ("lux frac encode" x))
(def:''' (multiple? div n)
- #Nil
- (-> Nat Nat Bool)
- (|> n (n/% div) (n/= +0)))
+ #Nil
+ (-> Nat Nat Bool)
+ (|> n (n/% div) (n/= +0)))
(def:''' #export (not x)
- (list [(tag$ ["lux" "doc"])
- (text$ "## Boolean negation.
+ (list [(tag$ ["lux" "doc"])
+ (text$ "## Boolean negation.
- (not true) => false
+ (not true) => false
- (not false) => true")])
- (-> Bool Bool)
- (if x false true))
+ (not false) => true")])
+ (-> Bool Bool)
+ (if x false true))
(def:''' (find-macro' modules current-module module name)
- #Nil
- (-> ($' List (& Text Module))
- Text Text Text
- ($' Maybe Macro))
- (do Monad<Maybe>
- [$module (get module modules)
- gdef (let' [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-annotations _ #module-state _} ("lux check" Module $module)]
- (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))
+ #Nil
+ (-> ($' List (& Text Module))
+ Text Text Text
+ ($' Maybe Macro))
+ (do Monad<Maybe>
+ [$module (get module modules)
+ gdef (let' [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-annotations _ #module-state _} ("lux check" Module $module)]
+ (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 ("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)})
+
+ _
+ ("lux case" (get-meta ["lux" "alias"] def-meta)
+ {(#Some [_ (#Symbol [r-module r-name])])
+ (find-macro' modules current-module r-module r-name)
- _
- #None})}
+ _
+ #None})}
+ ))
))
- ))
(def:''' (normalize ident)
- #Nil
- (-> Ident ($' Meta Ident))
- ("lux case" ident
- {["" name]
- (do Monad<Meta>
- [module-name current-module-name]
- (wrap [module-name name]))
+ #Nil
+ (-> Ident ($' Meta Ident))
+ ("lux case" ident
+ {["" name]
+ (do Monad<Meta>
+ [module-name current-module-name]
+ (wrap [module-name name]))
- _
- (return ident)}))
+ _
+ (return ident)}))
(def:''' (find-macro ident)
- #Nil
- (-> Ident ($' Meta ($' Maybe Macro)))
- (do Monad<Meta>
- [current-module current-module-name]
- (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))})))))
+ #Nil
+ (-> Ident ($' Meta ($' Maybe Macro)))
+ (do Monad<Meta>
+ [current-module current-module-name]
+ (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))})))))
(def:''' (macro? ident)
- #Nil
- (-> Ident ($' Meta Bool))
- (do Monad<Meta>
- [ident (normalize ident)
- output (find-macro ident)]
- (wrap ("lux case" output
- {(#Some _) true
- #None false}))))
+ #Nil
+ (-> Ident ($' Meta Bool))
+ (do Monad<Meta>
+ [ident (normalize ident)
+ output (find-macro ident)]
+ (wrap ("lux case" output
+ {(#Some _) true
+ #None false}))))
(def:''' (list/join xs)
- #Nil
- (All [a]
- (-> ($' List ($' List a)) ($' List a)))
- (list/fold list/compose #Nil (list/reverse xs)))
+ #Nil
+ (All [a]
+ (-> ($' List ($' List a)) ($' List a)))
+ (list/fold list/compose #Nil (list/reverse xs)))
(def:''' (interpose sep xs)
- #Nil
- (All [a]
- (-> a ($' List a) ($' List a)))
- ("lux case" xs
- {#Nil
- xs
+ #Nil
+ (All [a]
+ (-> a ($' List a) ($' List a)))
+ ("lux case" 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))}))
+ #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))}))
- _
- (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' (monad/map Monad<Meta> macro-expand expansion)]
- (wrap (list/join expansion')))
-
- #None
- (return (list 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' (monad/map 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' (monad/map Monad<Meta> macro-expand-all expansion)]
- (wrap (list/join expansion')))
-
- #None
- (do Monad<Meta>
- [args' (monad/map Monad<Meta> macro-expand-all args)]
- (wrap (list (form$ (#Cons (symbol$ macro-name) (list/join args'))))))}))
-
- [_ (#Form members)]
- (do Monad<Meta>
- [members' (monad/map Monad<Meta> macro-expand-all members)]
- (wrap (list (form$ (list/join members')))))
+ #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' (monad/map Monad<Meta> macro-expand-all expansion)]
+ (wrap (list/join expansion')))
+
+ #None
+ (do Monad<Meta>
+ [args' (monad/map Monad<Meta> macro-expand-all args)]
+ (wrap (list (form$ (#Cons (symbol$ macro-name) (list/join args'))))))}))
+
+ [_ (#Form members)]
+ (do Monad<Meta>
+ [members' (monad/map Monad<Meta> macro-expand-all members)]
+ (wrap (list (form$ (list/join members')))))
+
+ [_ (#Tuple members)]
+ (do Monad<Meta>
+ [members' (monad/map Monad<Meta> macro-expand-all members)]
+ (wrap (list (tuple$ (list/join members')))))
+
+ [_ (#Record pairs)]
+ (do Monad<Meta>
+ [pairs' (monad/map 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'))))
- [_ (#Tuple members)]
- (do Monad<Meta>
- [members' (monad/map Monad<Meta> macro-expand-all members)]
- (wrap (list (tuple$ (list/join members')))))
-
- [_ (#Record pairs)]
- (do Monad<Meta>
- [pairs' (monad/map 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))}))
+ _
+ (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)]))
-
- [_ (#Tuple members)]
- (` (& (~@ (map walk-type members))))
-
- [_ (#Form (#Cons type-fn args))]
- (list/fold ("lux check" (-> Code Code Code)
- (function' [arg type-fn] (` (#;Apply (~ arg) (~ type-fn)))))
- (walk-type type-fn)
- (map walk-type args))
-
- _
- type}))
+ #Nil
+ (-> Code Code)
+ ("lux case" type
+ {[_ (#Form (#Cons [_ (#Tag tag)] parts))]
+ (form$ (#Cons [(tag$ tag) (map walk-type parts)]))
+
+ [_ (#Tuple members)]
+ (` (& (~@ (map walk-type members))))
+
+ [_ (#Form (#Cons type-fn args))]
+ (list/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.")}))
+ (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.")}))
- _
- (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)))))
+ (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)))))
- _
- (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)))))
+ (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)))))
- _
- (fail "Wrong syntax for :!")}))
+ _
+ (fail "Wrong syntax for :!")}))
(def:''' (empty? xs)
- #Nil
- (All [a] (-> ($' List a) Bool))
- ("lux case" xs
- {#Nil true
- _ false}))
+ #Nil
+ (All [a] (-> ($' List a) Bool))
+ ("lux case" xs
+ {#Nil true
+ _ false}))
(do-template [<name> <type> <value>]
[(def:''' (<name> xy)
- #Nil
- (All [a b] (-> (& a b) <type>))
- (let' [[x y] xy] <value>))]
+ #Nil
+ (All [a b] (-> (& a b) <type>))
+ (let' [[x y] xy] <value>))]
[first a x]
[second b y])
(def:''' (unfold-type-def type-codes)
- #Nil
- (-> ($' List Code) ($' Meta (& Code ($' Maybe ($' List Text)))))
- ("lux case" type-codes
- {(#Cons [_ (#Record pairs)] #;Nil)
- (do Monad<Meta>
- [members (monad/map 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))])
-
- _
- (return [type #None])})
-
- (#Cons case cases)
- (do Monad<Meta>
- [members (monad/map 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)))])
+ #Nil
+ (-> ($' List Code) ($' Meta (& Code ($' Maybe ($' List Text)))))
+ ("lux case" type-codes
+ {(#Cons [_ (#Record pairs)] #Nil)
+ (do Monad<Meta>
+ [members (monad/map 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.")})))
- (list& case cases))]
- (return [(` (| (~@ (map second members))))
- (#Some (map first members))]))
+ _
+ (return [type #None])})
+
+ (#Cons case cases)
+ (do Monad<Meta>
+ [members (monad/map 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))]))}))
+ #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))]))}))
(macro:' #export (Rec tokens)
- (list [(tag$ ["lux" "doc"])
- (text$ "## Parameter-less recursive types.
- ## A name has to be given to the whole type, to use it within its body.
- (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")}))
+ (list [(tag$ ["lux" "doc"])
+ (text$ "## Parameter-less recursive types.
+ ## A name has to be given to the whole type, to use it within its body.
+ (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")}))
(macro:' #export (exec tokens)
- (list [(tag$ ["lux" "doc"])
- (text$ "## Sequential execution of expressions (great for side-effects).
- (exec
- (log! \"#1\")
- (log! \"#2\")
- (log! \"#3\")
- \"YOLO\")")])
- ("lux case" (list/reverse tokens)
- {(#Cons value actions)
- (let' [dummy (symbol$ ["" ""])]
- (return (list (list/fold ("lux check" (-> Code Code Code)
- (function' [pre post] (` ("lux case" (~ pre) {(~ dummy) (~ post)}))))
- value
- actions))))
+ (list [(tag$ ["lux" "doc"])
+ (text$ "## Sequential execution of expressions (great for side-effects).
+ (exec
+ (log! \"#1\")
+ (log! \"#2\")
+ (log! \"#3\")
+ \"YOLO\")")])
+ ("lux case" (list/reverse tokens)
+ {(#Cons value actions)
+ (let' [dummy (symbol$ ["" ""])]
+ (return (list (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']
-
- _
- [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)
+ (let' [[export? tokens'] ("lux case" tokens
+ {(#Cons [_ (#Tag ["" "export"])] tokens')
+ [true 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)
- _
- #None}))]
- ("lux case" parts
- {(#Some name args ?type body)
- (let' [body' ("lux case" args
- {#Nil
- body
+ _
+ #None}))]
+ ("lux case" parts
+ {(#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))
- (let' [[left right] pair]
- (list left right)))
+ (-> [Code Code] (List Code))
+ (let' [[left right] pair]
+ (list left right)))
(def:' (code-to-text code)
- (-> Code Text)
- ("lux case" code
- {[_ (#Bool value)]
- (bool/encode value)
-
- [_ (#Nat value)]
- (nat/encode value)
-
- [_ (#Int value)]
- (int/encode value)
-
- [_ (#Deg value)]
- ("lux 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 " ")
- list/reverse
- (list/fold text/compose "")) ")")
-
- [_ (#Tuple xs)]
- ($_ text/compose "[" (|> xs
- (map code-to-text)
- (interpose " ")
- list/reverse
- (list/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 " ")
- list/reverse
- (list/fold text/compose "")) "}")}
- ))
+ (-> Code Text)
+ ("lux case" code
+ {[_ (#Bool value)]
+ (bool/encode value)
+
+ [_ (#Nat value)]
+ (nat/encode value)
+
+ [_ (#Int value)]
+ (int/encode value)
+
+ [_ (#Deg value)]
+ ("lux 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 " ")
+ list/reverse
+ (list/fold text/compose "")) ")")
+
+ [_ (#Tuple xs)]
+ ($_ text/compose "[" (|> xs
+ (map code-to-text)
+ (interpose " ")
+ list/reverse
+ (list/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 " ")
+ list/reverse
+ (list/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)))))
+ (-> (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 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 " ")
- list/reverse
- (list/fold text/compose ""))))}))
+ _
+ (fail ($_ text/compose "\"lux.case\" expects an even number of tokens: " (|> branches
+ (map code-to-text)
+ (interpose " ")
+ list/reverse
+ (list/fold text/compose ""))))}))
(macro:' #export (case tokens)
- (list [(tag$ ["lux" "doc"])
- (text$ "## The pattern-matching macro.
- ## Allows the usage of macros within the patterns to provide custom syntax.
- (case (: (List Int) (list 1 2 3))
- (#Cons x (#Cons y (#Cons z #Nil)))
- (#Some ($_ i/* x y z))
+ (list [(tag$ ["lux" "doc"])
+ (text$ "## The pattern-matching macro.
+ ## Allows the usage of macros within the patterns to provide custom syntax.
+ (case (: (List Int) (list 1 2 3))
+ (#Cons x (#Cons y (#Cons z #Nil)))
+ (#Some ($_ i/* x y z))
- _
- #None)")])
- ("lux case" tokens
- {(#Cons value branches)
- (do Monad<Meta>
- [expansion (expander branches)]
- (wrap (list (` ("lux case" (~ value) (~ (record$ (as-pairs expansion))))))))
+ _
+ #None)")])
+ ("lux case" tokens
+ {(#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"])
- (text$ "## Macro-expanding patterns.
- ## It's a special macro meant to be used with 'case'.
- (case (: (List Int) (list 1 2 3))
- (^ (list x y z))
- (#Some ($_ i/* x y z))
+ (list [(tag$ ["lux" "doc"])
+ (text$ "## Macro-expanding patterns.
+ ## It's a special macro meant to be used with 'case'.
+ (case (: (List Int) (list 1 2 3))
+ (^ (list x y z))
+ (#Some ($_ i/* x y z))
- _
- #None)")])
- (case tokens
- (#Cons [_ (#Form (#Cons pattern #Nil))] (#Cons body branches))
- (do Monad<Meta>
- [pattern+ (macro-expand-all pattern)]
- (case pattern+
- (#Cons pattern' #Nil)
- (wrap (list& pattern' body branches))
-
- _
- (fail "^ can only expand to 1 pattern.")))
-
- _
- (fail "Wrong syntax for ^ macro")))
+ _
+ #None)")])
+ (case tokens
+ (#Cons [_ (#Form (#Cons pattern #Nil))] (#Cons body branches))
+ (do Monad<Meta>
+ [pattern+ (macro-expand-all pattern)]
+ (case pattern+
+ (#Cons pattern' #Nil)
+ (wrap (list& pattern' body branches))
+
+ _
+ (fail "^ can only expand to 1 pattern.")))
+
+ _
+ (fail "Wrong syntax for ^ macro")))
(macro:' #export (^or tokens)
- (list [(tag$ ["lux" "doc"])
- (text$ "## Or-patterns.
- ## It's a special macro meant to be used with 'case'.
- (type: Weekday
- #Monday
- #Tuesday
- #Wednesday
- #Thursday
- #Friday
- #Saturday
- #Sunday)
-
- (def: (weekend? day)
- (-> Weekday Bool)
- (case day
- (^or #Saturday #Sunday)
- true
-
- _
- false))")])
- (case tokens
- (^ (list& [_ (#Form patterns)] body branches))
- (case patterns
- #Nil
- (fail "^or cannot have 0 patterns")
+ (list [(tag$ ["lux" "doc"])
+ (text$ "## Or-patterns.
+ ## It's a special macro meant to be used with 'case'.
+ (type: Weekday
+ #Monday
+ #Tuesday
+ #Wednesday
+ #Thursday
+ #Friday
+ #Saturday
+ #Sunday)
+
+ (def: (weekend? day)
+ (-> Weekday Bool)
+ (case day
+ (^or #Saturday #Sunday)
+ true
+
+ _
+ false))")])
+ (case tokens
+ (^ (list& [_ (#Form patterns)] body branches))
+ (case patterns
+ #Nil
+ (fail "^or cannot have 0 patterns")
- _
- (let' [pairs (|> patterns
- (map (function' [pattern] (list pattern body)))
- (list/join))]
- (return (list/compose pairs branches))))
- _
- (fail "Wrong syntax for ^or")))
+ _
+ (let' [pairs (|> patterns
+ (map (function' [pattern] (list pattern body)))
+ (list/join))]
+ (return (list/compose pairs branches))))
+ _
+ (fail "Wrong syntax for ^or")))
(def:' (symbol? code)
- (-> Code Bool)
- (case code
- [_ (#Symbol _)]
- true
+ (-> Code Bool)
+ (case code
+ [_ (#Symbol _)]
+ true
- _
- false))
+ _
+ false))
(macro:' #export (let tokens)
- (list [(tag$ ["lux" "doc"])
- (text$ "## Creates local bindings.
- ## Can (optionally) use pattern-matching macros when binding.
- (let [x (foo bar)
- y (baz quux)]
- (op x y))")])
- (case tokens
- (^ (list [_ (#Tuple bindings)] body))
- (if (multiple? +2 (list/size bindings))
- (|> bindings as-pairs list/reverse
- (list/fold (: (-> [Code Code] Code Code)
- (function' [lr body']
- (let' [[l r] lr]
- (if (symbol? l)
- (` ("lux case" (~ r) {(~ l) (~ body')}))
- (` (case (~ r) (~ l) (~ body')))))))
- body)
- list
- return)
- (fail "let requires an even number of parts"))
+ (list [(tag$ ["lux" "doc"])
+ (text$ "## Creates local bindings.
+ ## Can (optionally) use pattern-matching macros when binding.
+ (let [x (foo bar)
+ y (baz quux)]
+ (op x y))")])
+ (case tokens
+ (^ (list [_ (#Tuple bindings)] body))
+ (if (multiple? +2 (list/size bindings))
+ (|> bindings as-pairs list/reverse
+ (list/fold (: (-> [Code Code] Code Code)
+ (function' [lr body']
+ (let' [[l r] lr]
+ (if (symbol? l)
+ (` ("lux case" (~ r) {(~ l) (~ body')}))
+ (` (case (~ r) (~ l) (~ body')))))))
+ body)
+ list
+ return)
+ (fail "let requires an even number of parts"))
- _
- (fail "Wrong syntax for let")))
+ _
+ (fail "Wrong syntax for let")))
(macro:' #export (function tokens)
- (list [(tag$ ["lux" "doc"])
- (text$ "## Syntax for creating functions.
- ## Allows for giving the function itself a name, for the sake of recursion.
- (: (All [a b] (-> a b a))
- (function [x y] x))
-
- (: (All [a b] (-> a b a))
- (function const [x y] x))")])
- (case (: (Maybe [Ident Code (List Code) Code])
- (case tokens
- (^ (list [_ (#Tuple (#Cons head tail))] body))
- (#Some ["" ""] head tail body)
-
- (^ (list [_ (#Symbol ["" name])] [_ (#Tuple (#Cons head tail))] body))
- (#Some ["" name] head tail body)
-
- _
- #None))
- (#Some ident head tail body)
- (let [g!blank (symbol$ ["" ""])
- g!name (symbol$ ident)
- body+ (list/fold (: (-> Code Code Code)
- (function' [arg body']
- (if (symbol? arg)
- (` ("lux function" (~ g!blank) (~ arg) (~ body')))
- (` ("lux function" (~ g!blank) (~ g!blank)
- (case (~ g!blank) (~ arg) (~ body')))))))
- body
- (list/reverse tail))]
- (return (list (if (symbol? head)
- (` ("lux function" (~ g!name) (~ head) (~ body+)))
- (` ("lux function" (~ g!name) (~ g!blank) (case (~ g!blank) (~ head) (~ body+))))))))
-
- #None
- (fail "Wrong syntax for function")))
+ (list [(tag$ ["lux" "doc"])
+ (text$ "## Syntax for creating functions.
+ ## Allows for giving the function itself a name, for the sake of recursion.
+ (: (All [a b] (-> a b a))
+ (function [x y] x))
+
+ (: (All [a b] (-> a b a))
+ (function const [x y] x))")])
+ (case (: (Maybe [Ident Code (List Code) Code])
+ (case tokens
+ (^ (list [_ (#Tuple (#Cons head tail))] body))
+ (#Some ["" ""] head tail body)
+
+ (^ (list [_ (#Symbol ["" name])] [_ (#Tuple (#Cons head tail))] body))
+ (#Some ["" name] head tail body)
+
+ _
+ #None))
+ (#Some ident head tail body)
+ (let [g!blank (symbol$ ["" ""])
+ g!name (symbol$ ident)
+ body+ (list/fold (: (-> Code Code Code)
+ (function' [arg body']
+ (if (symbol? arg)
+ (` ("lux function" (~ g!blank) (~ arg) (~ body')))
+ (` ("lux function" (~ g!blank) (~ g!blank)
+ (case (~ g!blank) (~ arg) (~ body')))))))
+ body
+ (list/reverse tail))]
+ (return (list (if (symbol? head)
+ (` ("lux function" (~ g!name) (~ head) (~ body+)))
+ (` ("lux function" (~ g!name) (~ g!blank) (case (~ g!blank) (~ head) (~ body+))))))))
+
+ #None
+ (fail "Wrong syntax for function")))
(def:' (process-def-meta-value code)
- (-> Code Code)
- (case code
- [_ (#Bool value)]
- (meta-code ["lux" "Bool"] (bool$ value))
-
- [_ (#Nat value)]
- (meta-code ["lux" "Nat"] (nat$ value))
-
- [_ (#Int value)]
- (meta-code ["lux" "Int"] (int$ value))
-
- [_ (#Deg value)]
- (meta-code ["lux" "Deg"] (deg$ value))
-
- [_ (#Frac value)]
- (meta-code ["lux" "Frac"] (frac$ value))
-
- [_ (#Text value)]
- (meta-code ["lux" "Text"] (text$ value))
-
- [_ (#Tag [prefix name])]
- (meta-code ["lux" "Tag"] (` [(~ (text$ prefix)) (~ (text$ name))]))
-
- (^or [_ (#Form _)] [_ (#Symbol _)])
- code
-
- [_ (#Tuple xs)]
- (|> xs
- (map process-def-meta-value)
- untemplate-list
- (meta-code ["lux" "Tuple"]))
-
- [_ (#Record kvs)]
- (|> kvs
- (map (: (-> [Code Code] Code)
- (function [[k v]]
- (` [(~ (process-def-meta-value k))
- (~ (process-def-meta-value v))]))))
- untemplate-list
- (meta-code ["lux" "Record"]))
- ))
+ (-> Code Code)
+ (case code
+ [_ (#Bool value)]
+ (meta-code ["lux" "Bool"] (bool$ value))
+
+ [_ (#Nat value)]
+ (meta-code ["lux" "Nat"] (nat$ value))
+
+ [_ (#Int value)]
+ (meta-code ["lux" "Int"] (int$ value))
+
+ [_ (#Deg value)]
+ (meta-code ["lux" "Deg"] (deg$ value))
+
+ [_ (#Frac value)]
+ (meta-code ["lux" "Frac"] (frac$ value))
+
+ [_ (#Text value)]
+ (meta-code ["lux" "Text"] (text$ value))
+
+ [_ (#Tag [prefix name])]
+ (meta-code ["lux" "Tag"] (` [(~ (text$ prefix)) (~ (text$ name))]))
+
+ (^or [_ (#Form _)] [_ (#Symbol _)])
+ code
+
+ [_ (#Tuple xs)]
+ (|> xs
+ (map process-def-meta-value)
+ untemplate-list
+ (meta-code ["lux" "Tuple"]))
+
+ [_ (#Record kvs)]
+ (|> kvs
+ (map (: (-> [Code Code] Code)
+ (function [[k v]]
+ (` [(~ (process-def-meta-value k))
+ (~ (process-def-meta-value v))]))))
+ untemplate-list
+ (meta-code ["lux" "Record"]))
+ ))
(def:' (process-def-meta kvs)
- (-> (List [Code Code]) Code)
- (untemplate-list (map (: (-> [Code Code] Code)
- (function [[k v]]
- (` [(~ (process-def-meta-value k))
- (~ (process-def-meta-value v))])))
- kvs)))
+ (-> (List [Code Code]) Code)
+ (untemplate-list (map (: (-> [Code Code] Code)
+ (function [[k v]]
+ (` [(~ (process-def-meta-value k))
+ (~ (process-def-meta-value v))])))
+ kvs)))
(def:' (with-func-args args meta)
- (-> (List Code) Code Code)
- (case args
- #;Nil
- meta
-
- _
- (` (#;Cons [[(~ cursor-code) (#;Tag ["lux" "func-args"])]
- [(~ cursor-code) (#;Tuple (;list (~@ (map (function [arg]
- (` [(~ cursor-code) (#;Text (~ (text$ (code-to-text arg))))]))
- args))))]]
- (~ meta)))))
+ (-> (List Code) Code Code)
+ (case args
+ #Nil
+ meta
+
+ _
+ (` (#.Cons [[(~ cursor-code) (#.Tag ["lux" "func-args"])]
+ [(~ cursor-code) (#.Tuple (.list (~@ (map (function [arg]
+ (` [(~ cursor-code) (#.Text (~ (text$ (code-to-text arg))))]))
+ args))))]]
+ (~ meta)))))
(def:' (with-type-args args)
- (-> (List Code) Code)
- (` {#;type-args [(~@ (map (function [arg] (text$ (code-to-text arg)))
- args))]}))
+ (-> (List Code) Code)
+ (` {#.type-args [(~@ (map (function [arg] (text$ (code-to-text arg)))
+ args))]}))
(def:' Export-Level
- Type
- ($' Either
- Unit ## Exported
- Unit ## Hidden
- ))
+ Type
+ ($' Either
+ Unit ## Exported
+ Unit ## Hidden
+ ))
(def:' (export-level^ tokens)
- (-> (List Code) [(Maybe Export-Level) (List Code)])
- (case tokens
- (#Cons [_ (#Tag [_ "export"])] tokens')
- [(#;Some (#;Left [])) tokens']
+ (-> (List Code) [(Maybe Export-Level) (List Code)])
+ (case tokens
+ (#Cons [_ (#Tag [_ "export"])] tokens')
+ [(#Some (#Left [])) tokens']
- (#Cons [_ (#Tag [_ "hidden"])] tokens')
- [(#;Some (#;Right [])) tokens']
+ (#Cons [_ (#Tag [_ "hidden"])] tokens')
+ [(#Some (#Right [])) tokens']
- _
- [#;None tokens]))
+ _
+ [#None tokens]))
(def:' (export-level ?el)
- (-> (Maybe Export-Level) (List Code))
- (case ?el
- #;None
- (list)
+ (-> (Maybe Export-Level) (List Code))
+ (case ?el
+ #None
+ (list)
- (#;Some (#;Left []))
- (list (' #export))
+ (#Some (#Left []))
+ (list (' #export))
- (#;Some (#;Right []))
- (list (' #hidden))))
+ (#Some (#Right []))
+ (list (' #hidden))))
(macro:' #export (def: tokens)
- (list [(tag$ ["lux" "doc"])
- (text$ "## Defines global constants/functions.
- (def: (rejoin-pair pair)
- (-> [Code Code] (List Code))
- (let [[left right] pair]
- (list left right)))
-
- (def: branching-exponent
- Int
- 5)")])
- (let [[export? tokens'] (export-level^ tokens)
- parts (: (Maybe [Code (List Code) (Maybe Code) Code (List [Code Code])])
- (case tokens'
- (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta-kvs)] type body))
- (#Some [name args (#Some type) body meta-kvs])
-
- (^ (list name [_ (#Record meta-kvs)] type body))
- (#Some [name #Nil (#Some type) body meta-kvs])
+ (list [(tag$ ["lux" "doc"])
+ (text$ "## Defines global constants/functions.
+ (def: (rejoin-pair pair)
+ (-> [Code Code] (List Code))
+ (let [[left right] pair]
+ (list left right)))
+
+ (def: branching-exponent
+ Int
+ 5)")])
+ (let [[export? tokens'] (export-level^ tokens)
+ parts (: (Maybe [Code (List Code) (Maybe Code) Code (List [Code Code])])
+ (case tokens'
+ (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta-kvs)] type body))
+ (#Some [name args (#Some type) body meta-kvs])
+
+ (^ (list name [_ (#Record meta-kvs)] type body))
+ (#Some [name #Nil (#Some type) body meta-kvs])
- (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta-kvs)] body))
- (#Some [name args #None body meta-kvs])
+ (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta-kvs)] body))
+ (#Some [name args #None body meta-kvs])
- (^ (list name [_ (#Record meta-kvs)] body))
- (#Some [name #Nil #None body meta-kvs])
-
- (^ (list [_ (#Form (#Cons name args))] type body))
- (#Some [name args (#Some type) body #Nil])
-
- (^ (list name type body))
- (#Some [name #Nil (#Some type) body #Nil])
-
- (^ (list [_ (#Form (#Cons name args))] body))
- (#Some [name args #None body #Nil])
-
- (^ (list name body))
- (#Some [name #Nil #None body #Nil])
+ (^ (list name [_ (#Record meta-kvs)] body))
+ (#Some [name #Nil #None body meta-kvs])
+
+ (^ (list [_ (#Form (#Cons name args))] type body))
+ (#Some [name args (#Some type) body #Nil])
+
+ (^ (list name type body))
+ (#Some [name #Nil (#Some type) body #Nil])
+
+ (^ (list [_ (#Form (#Cons name args))] body))
+ (#Some [name args #None body #Nil])
+
+ (^ (list name body))
+ (#Some [name #Nil #None body #Nil])
- _
- #None))]
- (case parts
- (#Some name args ?type body meta)
- (let [body (case args
- #Nil
- body
+ _
+ #None))]
+ (case parts
+ (#Some name args ?type body meta)
+ (let [body (case args
+ #Nil
+ body
- _
- (` (function (~ name) [(~@ args)] (~ body))))
- body (case ?type
- (#Some type)
- (` (: (~ type) (~ body)))
-
- #None
- body)
- =meta (process-def-meta meta)]
- (return (list (` ("lux def" (~ name)
- (~ body)
- [(~ cursor-code)
- (#;Record (~ (with-func-args args
- (case export?
- #;None
- =meta
-
- (#;Some (#;Left []))
- (with-export-meta =meta)
-
- (#;Some (#;Right []))
- (|> =meta
- with-export-meta
- with-hidden-meta)
- ))))])))))
-
- #None
- (fail "Wrong syntax for def:"))))
+ _
+ (` (function (~ name) [(~@ args)] (~ body))))
+ body (case ?type
+ (#Some type)
+ (` (: (~ type) (~ body)))
+
+ #None
+ body)
+ =meta (process-def-meta meta)]
+ (return (list (` ("lux def" (~ name)
+ (~ body)
+ [(~ cursor-code)
+ (#Record (~ (with-func-args args
+ (case export?
+ #None
+ =meta
+
+ (#Some (#Left []))
+ (with-export-meta =meta)
+
+ (#Some (#Right []))
+ (|> =meta
+ with-export-meta
+ with-hidden-meta)
+ ))))])))))
+
+ #None
+ (fail "Wrong syntax for def:"))))
(def: (meta-code-add addition meta)
(-> [Code Code] Code Code)
(case [addition meta]
- [[name value] [cursor (#;Record pairs)]]
- [cursor (#;Record (#;Cons [name value] pairs))]
+ [[name value] [cursor (#Record pairs)]]
+ [cursor (#Record (#Cons [name value] pairs))]
_
meta))
@@ -3230,62 +3238,62 @@
(def: (meta-code-merge addition base)
(-> Code Code Code)
(case addition
- [cursor (#;Record pairs)]
+ [cursor (#Record pairs)]
(list/fold meta-code-add base pairs)
_
base))
(macro:' #export (macro: tokens)
- (list [(tag$ ["lux" "doc"])
- (text$ "Macro-definition macro.
+ (list [(tag$ ["lux" "doc"])
+ (text$ "Macro-definition macro.
+
+ (macro: #export (ident-for tokens)
+ (case tokens
+ (^template [<tag>]
+ (^ (list [_ (<tag> [prefix name])]))
+ (return (list (` [(~ (text$ prefix)) (~ (text$ name))]))))
+ ([#Symbol] [#Tag])
+
+ _
+ (fail \"Wrong syntax for ident-for\")))")])
+ (let [[exported? tokens] (export-level^ tokens)
+ name+args+meta+body?? (: (Maybe [Ident (List Code) Code Code])
+ (case tokens
+ (^ (list [_ (#Form (list& [_ (#Symbol name)] args))] body))
+ (#Some [name args (` {}) body])
+
+ (^ (list [_ (#Symbol name)] body))
+ (#Some [name #Nil (` {}) body])
- (macro: #export (ident-for tokens)
- (case tokens
- (^template [<tag>]
- (^ (list [_ (<tag> [prefix name])]))
- (return (list (` [(~ (text$ prefix)) (~ (text$ name))]))))
- ([#;Symbol] [#;Tag])
+ (^ (list [_ (#Form (list& [_ (#Symbol name)] args))] [meta-rec-cursor (#Record meta-rec-parts)] body))
+ (#Some [name args [meta-rec-cursor (#Record meta-rec-parts)] body])
+
+ (^ (list [_ (#Symbol name)] [meta-rec-cursor (#Record meta-rec-parts)] body))
+ (#Some [name #Nil [meta-rec-cursor (#Record meta-rec-parts)] body])
- _
- (fail \"Wrong syntax for ident-for\")))")])
- (let [[exported? tokens] (export-level^ tokens)
- name+args+meta+body?? (: (Maybe [Ident (List Code) Code Code])
- (case tokens
- (^ (list [_ (#;Form (list& [_ (#Symbol name)] args))] body))
- (#Some [name args (` {}) body])
-
- (^ (list [_ (#;Symbol name)] body))
- (#Some [name #Nil (` {}) body])
-
- (^ (list [_ (#;Form (list& [_ (#Symbol name)] args))] [meta-rec-cursor (#;Record meta-rec-parts)] body))
- (#Some [name args [meta-rec-cursor (#;Record meta-rec-parts)] body])
-
- (^ (list [_ (#;Symbol name)] [meta-rec-cursor (#;Record meta-rec-parts)] body))
- (#Some [name #Nil [meta-rec-cursor (#;Record meta-rec-parts)] body])
-
- _
- #None))]
- (case name+args+meta+body??
- (#Some [name args meta body])
- (let [name (symbol$ name)
- def-sig (case args
- #;Nil name
- _ (` ((~ name) (~@ args))))]
- (return (list (` (;;def: (~@ (export-level exported?))
- (~ def-sig)
- (~ (meta-code-merge (` {#;macro? true})
- meta))
-
- ;;Macro
- (~ body))))))
-
+ _
+ #None))]
+ (case name+args+meta+body??
+ (#Some [name args meta body])
+ (let [name (symbol$ name)
+ def-sig (case args
+ #Nil name
+ _ (` ((~ name) (~@ args))))]
+ (return (list (` (..def: (~@ (export-level exported?))
+ (~ def-sig)
+ (~ (meta-code-merge (` {#.macro? true})
+ meta))
+
+ ..Macro
+ (~ body))))))
+
- #None
- (fail "Wrong syntax for macro:"))))
+ #None
+ (fail "Wrong syntax for macro:"))))
(macro: #export (sig: tokens)
- {#;doc "## Definition of signatures ala ML.
+ {#.doc "## Definition of signatures ala ML.
(sig: #export (Ord a)
(: (Eq a)
eq)
@@ -3300,11 +3308,11 @@
(let [[exported? tokens'] (export-level^ tokens)
?parts (: (Maybe [Ident (List Code) Code (List Code)])
(case tokens'
- (^ (list& [_ (#Form (list& [_ (#Symbol name)] args))] [meta-rec-cursor (#;Record meta-rec-parts)] sigs))
- (#Some name args [meta-rec-cursor (#;Record meta-rec-parts)] sigs)
+ (^ (list& [_ (#Form (list& [_ (#Symbol name)] args))] [meta-rec-cursor (#Record meta-rec-parts)] sigs))
+ (#Some name args [meta-rec-cursor (#Record meta-rec-parts)] sigs)
- (^ (list& [_ (#Symbol name)] [meta-rec-cursor (#;Record meta-rec-parts)] sigs))
- (#Some name #Nil [meta-rec-cursor (#;Record meta-rec-parts)] sigs)
+ (^ (list& [_ (#Symbol name)] [meta-rec-cursor (#Record meta-rec-parts)] sigs))
+ (#Some name #Nil [meta-rec-cursor (#Record meta-rec-parts)] sigs)
(^ (list& [_ (#Form (list& [_ (#Symbol name)] args))] sigs))
(#Some name args (` {}) sigs)
@@ -3336,15 +3344,15 @@
(function [[m-name m-type]]
[(tag$ ["" m-name]) m-type]))
members))
- sig-meta (meta-code-merge (` {#;sig? true})
+ sig-meta (meta-code-merge (` {#.sig? true})
meta)
usage (case args
- #;Nil
+ #Nil
def-name
_
(` ((~ def-name) (~@ args))))]]
- (return (list (` (;;type: (~@ (export-level exported?)) (~ usage) (~ sig-meta) (~ sig-type))))))
+ (return (list (` (..type: (~@ (export-level exported?)) (~ usage) (~ sig-meta) (~ sig-type))))))
#None
(fail "Wrong syntax for sig:"))))
@@ -3366,7 +3374,7 @@
(do-template [<name> <form> <message> <doc-msg>]
[(macro: #export (<name> tokens)
- {#;doc <doc-msg>}
+ {#.doc <doc-msg>}
(case (list/reverse tokens)
(^ (list& last init))
(return (list (list/fold (: (-> Code Code Code)
@@ -3387,20 +3395,20 @@
(def: (last-index-of' part part-size since text)
(-> Text Nat Nat Text (Maybe Nat))
(case ("lux text index" text part (n/+ part-size since))
- #;None
- (#;Some since)
+ #None
+ (#Some since)
- (#;Some since')
+ (#Some since')
(last-index-of' part part-size since' text)))
(def: (last-index-of part text)
(-> Text Text (Maybe Nat))
(case ("lux text index" text part +0)
- (#;Some since)
+ (#Some since)
(last-index-of' part ("lux text size" part) since text)
- #;None
- #;None))
+ #None
+ #None))
(def: (clip1 from text)
(-> Nat Text (Maybe Text))
@@ -3411,38 +3419,38 @@
("lux text clip" text from to))
(def: #export (error! message)
- {#;doc "## Causes an error, with the given error message.
+ {#.doc "## Causes an error, with the given error message.
(error! \"OH NO!\")"}
(-> Text Bottom)
("lux io error" message))
(macro: (default tokens state)
- {#;doc "## Allows you to provide a default value that will be used
- ## if a (Maybe x) value turns out to be #;None.
- (default 20 (#;Some 10)) => 10
+ {#.doc "## Allows you to provide a default value that will be used
+ ## if a (Maybe x) value turns out to be #.None.
+ (default 20 (#.Some 10)) => 10
- (default 20 #;None) => 20"}
+ (default 20 #.None) => 20"}
(case tokens
(^ (list else maybe))
- (let [g!temp (: Code [dummy-cursor (#;Symbol ["" ""])])
+ (let [g!temp (: Code [dummy-cursor (#Symbol ["" ""])])
code (` (case (~ maybe)
- (#;Some (~ g!temp))
+ (#.Some (~ g!temp))
(~ g!temp)
- #;None
+ #.None
(~ else)))]
- (#;Right [state (list code)]))
+ (#Right [state (list code)]))
_
- (#;Left "Wrong syntax for default")))
+ (#Left "Wrong syntax for default")))
(def: (text/split splitter input)
(-> Text Text (List Text))
(case (index-of splitter input)
- #;None
+ #None
(list input)
- (#;Some idx)
+ (#Some idx)
(list& (default (error! "UNDEFINED")
(clip2 +0 idx input))
(text/split splitter
@@ -3538,17 +3546,17 @@
_
(list type)))]
- [flatten-variant #;Sum]
- [flatten-tuple #;Product]
- [flatten-lambda #;Function]
+ [flatten-variant #Sum]
+ [flatten-tuple #Product]
+ [flatten-lambda #Function]
)
(def: (flatten-app type)
(-> Type [Type (List Type)])
(case type
- (#;Apply head func')
+ (#Apply head func')
(let [[func tail] (flatten-app func')]
- [func (#;Cons head tail)])
+ [func (#Cons head tail)])
_
[type (list)]))
@@ -3657,7 +3665,7 @@
(#Left "Not expecting any type.")))))
(macro: #export (struct tokens)
- {#;doc "Not meant to be used directly. Prefer \"struct:\"."}
+ {#.doc "Not meant to be used directly. Prefer \"struct:\"."}
(do Monad<Meta>
[tokens' (monad/map Monad<Meta> macro-expand tokens)
struct-type get-expected-type
@@ -3694,27 +3702,27 @@
(|> parts list/reverse (list/fold text/compose "")))
(macro: #export (struct: tokens)
- {#;doc "## Definition of structures ala ML.
+ {#.doc "## Definition of structures ala ML.
(struct: #export Ord<Int> (Ord Int)
(def: eq Eq<Int>)
(def: (< test subject)
- (lux;< test subject))
+ (lux.< test subject))
(def: (<= test subject)
- (or (lux;< test subject)
- (lux;= test subject)))
- (def: (lux;> test subject)
- (lux;> test subject))
- (def: (lux;>= test subject)
- (or (lux;> test subject)
- (lux;= test subject))))"}
+ (or (lux.< test subject)
+ (lux.= test subject)))
+ (def: (lux.> test subject)
+ (lux.> test subject))
+ (def: (lux.>= test subject)
+ (or (lux.> test subject)
+ (lux.= test subject))))"}
(let [[exported? tokens'] (export-level^ tokens)
?parts (: (Maybe [Code (List Code) Code Code (List Code)])
(case tokens'
- (^ (list& [_ (#Form (list& name args))] [meta-rec-cursor (#;Record meta-rec-parts)] type defs))
- (#Some name args type [meta-rec-cursor (#;Record meta-rec-parts)] defs)
+ (^ (list& [_ (#Form (list& name args))] [meta-rec-cursor (#Record meta-rec-parts)] type defs))
+ (#Some name args type [meta-rec-cursor (#Record meta-rec-parts)] defs)
- (^ (list& name [meta-rec-cursor (#;Record meta-rec-parts)] type defs))
- (#Some name #Nil type [meta-rec-cursor (#;Record meta-rec-parts)] defs)
+ (^ (list& name [meta-rec-cursor (#Record meta-rec-parts)] type defs))
+ (#Some name #Nil type [meta-rec-cursor (#Record meta-rec-parts)] defs)
(^ (list& [_ (#Form (list& name args))] type defs))
(#Some name args type (` {}) defs)
@@ -3727,59 +3735,59 @@
(case ?parts
(#Some [name args type meta defs])
(case (case name
- [_ (#;Symbol ["" "_"])]
+ [_ (#Symbol ["" "_"])]
(case type
- (^ [_ (#;Form (list& [_ (#;Symbol [_ sig-name])] sig-args))])
+ (^ [_ (#Form (list& [_ (#Symbol [_ sig-name])] sig-args))])
(case (: (Maybe (List Text))
(monad/map Monad<Maybe>
(function [sa]
(case sa
- [_ (#;Symbol [_ arg-name])]
- (#;Some arg-name)
+ [_ (#Symbol [_ arg-name])]
+ (#Some arg-name)
_
- #;None))
+ #None))
sig-args))
- (^ (#;Some params))
- (#;Some (symbol$ ["" ($_ text/compose sig-name "<" (|> params (interpose ",") text/join) ">")]))
+ (^ (#Some params))
+ (#Some (symbol$ ["" ($_ text/compose sig-name "<" (|> params (interpose ",") text/join) ">")]))
_
- #;None)
+ #None)
_
- #;None)
+ #None)
_
- (#;Some name)
+ (#Some name)
)
- (#;Some name)
+ (#Some name)
(let [usage (case args
#Nil
name
_
(` ((~ name) (~@ args))))]
- (return (list (` (;;def: (~@ (export-level exported?)) (~ usage)
- (~ (meta-code-merge (` {#;struct? true})
+ (return (list (` (..def: (~@ (export-level exported?)) (~ usage)
+ (~ (meta-code-merge (` {#.struct? true})
meta))
(~ type)
(struct (~@ defs)))))))
- #;None
+ #None
(fail "Cannot infer name, so struct must have a name other than \"_\"!"))
#None
(fail "Wrong syntax for struct:"))))
(def: #export (id x)
- {#;doc "Identity function.
+ {#.doc "Identity function.
Does nothing to it's argument and just returns it."}
(All [a] (-> a a))
x)
(macro: #export (type: tokens)
- {#;doc "## The type-definition macro.
+ {#.doc "## The type-definition macro.
(type: (List a)
#Nil
(#Cons a (List a)))"}
@@ -3792,20 +3800,20 @@
[false tokens'])
parts (: (Maybe [Text (List Code) Code (List Code)])
(case tokens'
- (^ (list [_ (#Symbol "" name)] [meta-cursor (#;Record meta-parts)] [type-cursor (#;Record type-parts)]))
- (#Some [name #Nil [meta-cursor (#;Record meta-parts)] (list [type-cursor (#;Record type-parts)])])
+ (^ (list [_ (#Symbol "" name)] [meta-cursor (#Record meta-parts)] [type-cursor (#Record type-parts)]))
+ (#Some [name #Nil [meta-cursor (#Record meta-parts)] (list [type-cursor (#Record type-parts)])])
- (^ (list& [_ (#Symbol "" name)] [meta-cursor (#;Record meta-parts)] type-code1 type-codes))
- (#Some [name #Nil [meta-cursor (#;Record meta-parts)] (#;Cons type-code1 type-codes)])
+ (^ (list& [_ (#Symbol "" name)] [meta-cursor (#Record meta-parts)] type-code1 type-codes))
+ (#Some [name #Nil [meta-cursor (#Record meta-parts)] (#Cons type-code1 type-codes)])
(^ (list& [_ (#Symbol "" name)] type-codes))
(#Some [name #Nil (` {}) type-codes])
- (^ (list [_ (#Form (#Cons [_ (#Symbol "" name)] args))] [meta-cursor (#;Record meta-parts)] [type-cursor (#;Record type-parts)]))
- (#Some [name args [meta-cursor (#;Record meta-parts)] (list [type-cursor (#;Record type-parts)])])
+ (^ (list [_ (#Form (#Cons [_ (#Symbol "" name)] args))] [meta-cursor (#Record meta-parts)] [type-cursor (#Record type-parts)]))
+ (#Some [name args [meta-cursor (#Record meta-parts)] (list [type-cursor (#Record type-parts)])])
- (^ (list& [_ (#Form (#Cons [_ (#Symbol "" name)] args))] [meta-cursor (#;Record meta-parts)] type-code1 type-codes))
- (#Some [name args [meta-cursor (#;Record meta-parts)] (#;Cons type-code1 type-codes)])
+ (^ (list& [_ (#Form (#Cons [_ (#Symbol "" name)] args))] [meta-cursor (#Record meta-parts)] type-code1 type-codes))
+ (#Some [name args [meta-cursor (#Record meta-parts)] (#Cons type-code1 type-codes)])
(^ (list& [_ (#Form (#Cons [_ (#Symbol "" name)] args))] type-codes))
(#Some [name args (` {}) type-codes])
@@ -3822,19 +3830,19 @@
type-meta (: Code
(case tags??
(#Some tags)
- (` {#;tags [(~@ (map text$ tags))]
- #;type? true})
+ (` {#.tags [(~@ (map text$ tags))]
+ #.type? true})
_
- (` {#;type? true})))
+ (` {#.type? true})))
type' (: (Maybe Code)
(if rec?
(if (empty? args)
(let [g!param (symbol$ ["" ""])
prime-name (symbol$ ["" name])
- type+ (replace-syntax (list [name (` ((~ prime-name) #;Void))]) type)]
+ type+ (replace-syntax (list [name (` ((~ prime-name) #.Void))]) type)]
(#Some (` ((All (~ prime-name) [(~ g!param)] (~ type+))
- #;Void))))
+ #.Void))))
#None)
(case args
#Nil
@@ -3844,13 +3852,13 @@
(#Some (` (All (~ type-name) [(~@ args)] (~ type)))))))]
(case type'
(#Some type'')
- (return (list (` (;;def: (~@ (export-level exported?)) (~ type-name)
+ (return (list (` (..def: (~@ (export-level exported?)) (~ type-name)
(~ ($_ meta-code-merge (with-type-args args)
- (if rec? (' {#;type-rec? true}) (' {}))
+ (if rec? (' {#.type-rec? true}) (' {}))
type-meta
meta))
Type
- (#;Named [(~ (text$ module-name))
+ (#.Named [(~ (text$ module-name))
(~ (text$ name))]
(type (~ type'')))))))
@@ -4064,10 +4072,10 @@
(def: (count-ups ups input)
(-> Nat Text Nat)
(case ("lux text index" input "/" ups)
- #;None
+ #None
ups
- (#;Some found)
+ (#Some found)
(if (n/= ups found)
(count-ups (n/+ +1 ups) input)
ups)))
@@ -4075,10 +4083,10 @@
(def: (list/drop amount a+)
(All [a] (-> Nat (List a) (List a)))
(case [amount a+]
- (^or [+0 _] [_ #;Nil])
+ (^or [+0 _] [_ #Nil])
a+
- [_ (#;Cons _ a+')]
+ [_ (#Cons _ a+')]
(list/drop (n/- +1 amount) a+')))
(def: (clean-module relative-root module)
@@ -4146,7 +4154,7 @@
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-alias (#Some (replace-all "." m-name alias))
#import-refer {#refer-defs referral
#refer-open openings}})))
@@ -4158,7 +4166,7 @@
openings+extra (parse-short-openings extra)
#let [[openings extra] openings+extra]]
(wrap (list {#import-name m-name
- #import-alias (#;Some raw-m-name)
+ #import-alias (#Some raw-m-name)
#import-refer {#refer-defs referral
#refer-open openings}})))
@@ -4184,7 +4192,7 @@
(function [[name [def-type def-meta def-value]]]
(case [(get-meta ["lux" "export?"] def-meta)
(get-meta ["lux" "hidden?"] def-meta)]
- [(#Some [_ (#Bool true)]) #;None]
+ [(#Some [_ (#Bool true)]) #None]
(list name)
_
@@ -4200,12 +4208,12 @@
(def: (filter p xs)
(All [a] (-> (-> a Bool) (List a) (List a)))
(case xs
- #;Nil
+ #Nil
(list)
- (#;Cons x xs')
+ (#Cons x xs')
(if (p x)
- (#;Cons x (filter p xs'))
+ (#Cons x (filter p xs'))
(filter p xs'))))
(def: (is-member? cases name)
@@ -4221,8 +4229,8 @@
(All [a b]
(-> (-> a (Maybe b)) a a (Maybe b)))
(case (f x1)
- #;None (f x2)
- (#;Some y) (#;Some y)))
+ #None (f x2)
+ (#Some y) (#Some y)))
(def: (find-in-env name state)
(-> Text Compiler (Maybe Type))
@@ -4288,10 +4296,10 @@
(def: (find-type-var idx bindings)
(-> Nat (List [Nat (Maybe Type)]) (Maybe Type))
(case bindings
- #;Nil
- #;Nil
+ #Nil
+ #Nil
- (#;Cons [var bound] bindings')
+ (#Cons [var bound] bindings')
(if (n/= idx var)
bound
(find-type-var idx bindings'))))
@@ -4328,10 +4336,10 @@
#scope-type-vars _} compiler
{#ex-counter _ #var-counter _ #var-bindings var-bindings} type-context]
(case (find-type-var type-id var-bindings)
- #;None
+ #None
temp
- (#;Some actualT)
+ (#Some actualT)
(#Right [compiler actualT])))
_
@@ -4357,7 +4365,7 @@
(case type
(#Primitive name params)
(case params
- #;Nil
+ #Nil
name
_
@@ -4401,7 +4409,7 @@
")"))
(#Named [prefix name] _)
- ($_ text/compose prefix ";" name)
+ ($_ text/compose prefix "." name)
))
(macro: #hidden (^open' tokens)
@@ -4411,10 +4419,10 @@
[init-type (find-type name)
struct-evidence (resolve-type-tags init-type)]
(case struct-evidence
- #;None
+ #None
(fail (text/compose "Can only \"open\" structs: " (type/show init-type)))
- (#;Some tags&members)
+ (#Some tags&members)
(do Monad<Meta>
[full-body ((: (-> Ident [(List Ident) (List Type)] Code (Meta Code))
(function recur [source [tags members] target]
@@ -4428,12 +4436,12 @@
(do Monad<Meta>
[m-structure (resolve-type-tags m-type)]
(case m-structure
- (#;Some m-tags&members)
+ (#Some m-tags&members)
(recur ["" (text/compose prefix m-name)]
m-tags&members
enhanced-target)
- #;None
+ #None
(wrap enhanced-target))))
target
(zip2 tags members))]
@@ -4445,7 +4453,7 @@
(fail "Wrong syntax for ^open")))
(macro: #export (^open tokens)
- {#;doc "## Same as the \"open\" macro, but meant to be used as a pattern-matching macro for generating local bindings.
+ {#.doc "## Same as the \"open\" macro, but meant to be used as a pattern-matching macro for generating local bindings.
## Can optionally take a \"prefix\" text for the generated local bindings.
(def: #export (range (^open) from to)
(All [a] (-> (Enum a) a a (List a)))
@@ -4457,13 +4465,13 @@
(return (list& g!temp (` (^open' (~ g!temp) (~ (text$ prefix)) (~ body))) branches)))
(^ (list& [_ (#Form (list))] body branches))
- (return (list& (` (;;^open "")) body branches))
+ (return (list& (` (..^open "")) body branches))
_
(fail "Wrong syntax for ^open")))
(macro: #export (cond tokens)
- {#;doc "## Branching structures with multiple test conditions.
+ {#.doc "## Branching structures with multiple test conditions.
(cond (n/even? num) \"even\"
(n/odd? num) \"odd\"
## else-branch
@@ -4496,7 +4504,7 @@
(enumerate' +0 xs))
(macro: #export (get@ tokens)
- {#;doc "## Accesses the value of a record at a given tag.
+ {#.doc "## Accesses the value of a record at a given tag.
(get@ #field my-record)
## Can also work with multiple levels of nesting:
@@ -4530,14 +4538,14 @@
(^ (list [_ (#Tuple slots)] record))
(return (list (list/fold (: (-> Code Code Code)
(function [slot inner]
- (` (;;get@ (~ slot) (~ inner)))))
+ (` (..get@ (~ slot) (~ inner)))))
record
slots)))
(^ (list selector))
(do Monad<Meta>
[g!record (gensym "record")]
- (wrap (list (` (function [(~ g!record)] (;;get@ (~ selector) (~ g!record)))))))
+ (wrap (list (` (function [(~ g!record)] (..get@ (~ selector) (~ g!record)))))))
_
(fail "Wrong syntax for get@")))
@@ -4558,10 +4566,10 @@
_
(return (list (` ("lux def" (~ (symbol$ ["" (text/compose prefix name)])) (~ source+)
- [(~ cursor-code) (#;Record #Nil)])))))))
+ [(~ cursor-code) (#.Record #Nil)])))))))
(macro: #export (open tokens)
- {#;doc "## Opens a structure and generates a definition for each of its members (including nested members).
+ {#.doc "## Opens a structure and generates a definition for each of its members (including nested members).
## For example:
(open Number<Int> \"i:\")
## Will generate:
@@ -4597,7 +4605,7 @@
(fail "Wrong syntax for open")))
(macro: #export (|>> tokens)
- {#;doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it.
+ {#.doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it.
(|>> (map int/encode) (interpose \" \") (fold text/compose \"\"))
## =>
(function [<arg>]
@@ -4609,7 +4617,7 @@
(return (list (` (function [(~ g!arg)] (|> (~ g!arg) (~@ tokens))))))))
(macro: #export (<<| tokens)
- {#;doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it.
+ {#.doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it.
(<<| (fold text/compose \"\") (interpose \" \") (map int/encode))
## =>
(function [<arg>]
@@ -4645,7 +4653,7 @@
(fail ($_ text/compose _def " is not defined in module " module-name " @ " current-module)))))
referred-defs)))]]
(case options
- #;Nil
+ #Nil
(wrap {#refer-defs referral
#refer-open openings})
@@ -4692,8 +4700,8 @@
(` ("lux def" (~ (symbol$ ["" def]))
(~ (symbol$ [module-name def]))
[(~ cursor-code)
- (#;Record (#Cons [[(~ cursor-code) (#;Tag ["lux" "alias"])]
- [(~ cursor-code) (#;Symbol [(~ (text$ module-name)) (~ (text$ def))])]]
+ (#.Record (#Cons [[(~ cursor-code) (#.Tag ["lux" "alias"])]
+ [(~ cursor-code) (#.Symbol [(~ (text$ module-name)) (~ (text$ def))])]]
#Nil))]))))
defs')
openings (join-map (: (-> Openings (List Code))
@@ -4734,17 +4742,17 @@
=opens (join-map (function [[prefix structs]]
(list& (text$ prefix) (map symbol$ structs)))
r-opens)]
- (` (;;refer (~ (text$ module-name))
+ (` (..refer (~ (text$ module-name))
(~@ =defs)
(~' #open) ((~@ =opens))))))
(macro: #export (module: tokens)
- {#;doc "Module-definition macro.
+ {#.doc "Module-definition macro.
Can take optional annotations and allows the specification of modules to import.
## Examples
- (;module: {#;doc \"Some documentation...\"}
+ (.module: {#.doc \"Some documentation...\"}
lux
(lux (control (monad #as M #refer #all))
(data (text #open (\"text/\" Monoid<Text>))
@@ -4755,7 +4763,7 @@
(macro code))
(// (type #open (\"\" Eq<Type>))))
- (;module: {#;doc \"Some documentation...\"}
+ (.module: {#.doc \"Some documentation...\"}
lux
(lux (control [\"M\" monad #*])
(data [text \"text/\" Monoid<Text>]
@@ -4783,14 +4791,14 @@
(function [[m-name m-alias =refer]]
(refer-to-code m-name =refer)))
imports)
- =meta (process-def-meta (list& [(` #;imports) (` [(~@ =imports)])]
+ =meta (process-def-meta (list& [(` #.imports) (` [(~@ =imports)])]
_meta))
=module (` ("lux module" [(~ cursor-code)
- (#;Record (~ =meta))]))]]
- (wrap (#;Cons =module =refers))))
+ (#.Record (~ =meta))]))]]
+ (wrap (#Cons =module =refers))))
(macro: #export (:: tokens)
- {#;doc "## Allows accessing the value of a structure's member.
+ {#.doc "## Allows accessing the value of a structure's member.
(:: Codec<Text,Int> encode)
## Also allows using that value as a function.
@@ -4806,7 +4814,7 @@
(fail "Wrong syntax for ::")))
(macro: #export (set@ tokens)
- {#;doc "## Sets the value of a record at a given tag.
+ {#.doc "## Sets the value of a record at a given tag.
(set@ #name \"Lux\" lang)
## Can also work with multiple levels of nesting:
@@ -4852,7 +4860,7 @@
(^ (list [_ (#Tuple slots)] value record))
(case slots
- #;Nil
+ #Nil
(fail "Wrong syntax for set@")
_
@@ -4864,14 +4872,14 @@
#let [pairs (zip2 slots bindings)
update-expr (list/fold (: (-> [Code Code] Code Code)
(function [[s b] v]
- (` (;;set@ (~ s) (~ v) (~ b)))))
+ (` (..set@ (~ s) (~ v) (~ b)))))
value
(list/reverse pairs))
[_ accesses'] (list/fold (: (-> [Code Code] [Code (List (List Code))] [Code (List (List Code))])
(function [[new-slot new-binding] [old-record accesses']]
[(` (get@ (~ new-slot) (~ new-binding)))
- (#;Cons (list new-binding old-record) accesses')]))
- [record (: (List (List Code)) #;Nil)]
+ (#Cons (list new-binding old-record) accesses')]))
+ [record (: (List (List Code)) #Nil)]
pairs)
accesses (list/join (list/reverse accesses'))]]
(wrap (list (` (let [(~@ accesses)]
@@ -4880,19 +4888,19 @@
(^ (list selector value))
(do Monad<Meta>
[g!record (gensym "record")]
- (wrap (list (` (function [(~ g!record)] (;;set@ (~ selector) (~ value) (~ g!record)))))))
+ (wrap (list (` (function [(~ g!record)] (..set@ (~ selector) (~ value) (~ g!record)))))))
(^ (list selector))
(do Monad<Meta>
[g!value (gensym "value")
g!record (gensym "record")]
- (wrap (list (` (function [(~ g!value) (~ g!record)] (;;set@ (~ selector) (~ g!value) (~ g!record)))))))
+ (wrap (list (` (function [(~ g!value) (~ g!record)] (..set@ (~ selector) (~ g!value) (~ g!record)))))))
_
(fail "Wrong syntax for set@")))
(macro: #export (update@ tokens)
- {#;doc "## Modifies the value of a record at a given tag, based on some function.
+ {#.doc "## Modifies the value of a record at a given tag, based on some function.
(update@ #age i/inc person)
## Can also work with multiple levels of nesting:
@@ -4938,7 +4946,7 @@
(^ (list [_ (#Tuple slots)] fun record))
(case slots
- #;Nil
+ #Nil
(fail "Wrong syntax for update@")
_
@@ -4952,49 +4960,49 @@
(^ (list selector fun))
(do Monad<Meta>
[g!record (gensym "record")]
- (wrap (list (` (function [(~ g!record)] (;;update@ (~ selector) (~ fun) (~ g!record)))))))
+ (wrap (list (` (function [(~ g!record)] (..update@ (~ selector) (~ fun) (~ g!record)))))))
(^ (list selector))
(do Monad<Meta>
[g!fun (gensym "fun")
g!record (gensym "record")]
- (wrap (list (` (function [(~ g!fun) (~ g!record)] (;;update@ (~ selector) (~ g!fun) (~ g!record)))))))
+ (wrap (list (` (function [(~ g!fun) (~ g!record)] (..update@ (~ selector) (~ g!fun) (~ g!record)))))))
_
(fail "Wrong syntax for update@")))
(macro: #export (^template tokens)
- {#;doc "## It's similar to do-template, but meant to be used during pattern-matching.
+ {#.doc "## It's similar to do-template, but meant to be used during pattern-matching.
(def: (beta-reduce env type)
(-> (List Type) Type Type)
(case type
- (#;Primitive name params)
- (#;Primitive name (list/map (beta-reduce env) params))
+ (#.Primitive name params)
+ (#.Primitive name (list/map (beta-reduce env) params))
(^template [<tag>]
(<tag> left right)
(<tag> (beta-reduce env left) (beta-reduce env right)))
- ([#;Sum] [#;Product])
+ ([#.Sum] [#.Product])
(^template [<tag>]
(<tag> left right)
(<tag> (beta-reduce env left) (beta-reduce env right)))
- ([#;Function]
- [#;Apply])
+ ([#.Function]
+ [#.Apply])
(^template [<tag>]
(<tag> old-env def)
(case old-env
- #;Nil
+ #.Nil
(<tag> env def)
_
type))
- ([#;UnivQ]
- [#;ExQ])
+ ([#.UnivQ]
+ [#.ExQ])
- (#;Bound idx)
- (default type (list;nth idx env))
+ (#.Bound idx)
+ (default type (list.nth idx env))
_
type
@@ -5013,7 +5021,7 @@
(|> data'
(join-map (compose apply (make-env bindings')))
wrap))
- #;None)))
+ #None)))
(#Some output)
(return (list/compose output branches))
@@ -5066,7 +5074,7 @@
(def: (identify-doc-fragment code)
(-> Code Doc-Fragment)
(case code
- [_ (#;Text comment)]
+ [_ (#Text comment)]
(#Doc-Comment comment)
_
@@ -5088,7 +5096,7 @@
(do-template [<name> <op> <one> <type> <doc>]
[(def: #export (<name> value)
- {#;doc <doc>}
+ {#.doc <doc>}
(-> <type> <type>)
(<op> <one> value))]
@@ -5116,8 +5124,8 @@
(def: (repeat n x)
(All [a] (-> Int a (List a)))
(if (i/> 0 n)
- (#;Cons x (repeat (i/+ -1 n) x))
- #;Nil))
+ (#Cons x (repeat (i/+ -1 n) x))
+ #Nil))
(def: (cursor-padding baseline [_ old-line old-column] [_ new-line new-column])
(-> Nat Cursor Cursor Text)
@@ -5200,7 +5208,7 @@
(text/compose text "\n\n"))))
(macro: #export (doc tokens)
- {#;doc "## Creates code documentation, embedding text as comments and properly formatting the forms it's being given.
+ {#.doc "## Creates code documentation, embedding text as comments and properly formatting the forms it's being given.
## For Example:
(doc \"Allows arbitrary looping, using the \\\"recur\\\" form to re-start the loop.
@@ -5211,7 +5219,7 @@
(recur (i/inc count) (f x))
x)))"}
(return (list (` [(~ cursor-code)
- (#;Text (~ (|> tokens
+ (#.Text (~ (|> tokens
(map (|>> identify-doc-fragment doc-fragment->Text))
text/join
text$)))]))))
@@ -5275,7 +5283,7 @@
))
(macro: #export (loop tokens)
- {#;doc (doc "Allows arbitrary looping, using the \"recur\" form to re-start the loop."
+ {#.doc (doc "Allows arbitrary looping, using the \"recur\" form to re-start the loop."
"Can be used in monadic code to create monadic loops."
(loop [count 0
x init]
@@ -5306,14 +5314,14 @@
(function [_] (gensym "")))
inits)]
(return (list (` (let [(~@ (interleave aliases inits))]
- (;loop [(~@ (interleave vars aliases))]
+ (.loop [(~@ (interleave vars aliases))]
(~ body)))))))))
_
(fail "Wrong syntax for loop")))
(macro: #export (^slots tokens)
- {#;doc (doc "Allows you to extract record members as local variables with the same names."
+ {#.doc (doc "Allows you to extract record members as local variables with the same names."
"For example:"
(let [(^slots [#foo #bar #baz]) quux]
(f foo bar baz)))}
@@ -5391,7 +5399,7 @@
))
(macro: #export (with-expansions tokens)
- {#;doc (doc "Controlled macro-expansion."
+ {#.doc (doc "Controlled macro-expansion."
"Bind an arbitraty number of Codes resulting from macro-expansion to local bindings."
"Wherever a binding appears, the bound Codes will be spliced in there."
(test: "Code operations & structures"
@@ -5401,18 +5409,18 @@
(compare <text> (:: Code/encode show <expr>))
(compare true (:: Eq<Code> = <expr> <expr>))]
- [(bool true) "true" [_ (#;Bool true)]]
- [(bool false) "false" [_ (#;Bool false)]]
- [(int 123) "123" [_ (#;Int 123)]]
- [(frac 123.0) "123.0" [_ (#;Frac 123.0)]]
- [(text "\n") "\"\\n\"" [_ (#;Text "\n")]]
- [(tag ["yolo" "lol"]) "#yolo;lol" [_ (#;Tag ["yolo" "lol"])]]
- [(symbol ["yolo" "lol"]) "yolo;lol" [_ (#;Symbol ["yolo" "lol"])]]
- [(form (list (bool true) (int 123))) "(true 123)" (^ [_ (#;Form (list [_ (#;Bool true)] [_ (#;Int 123)]))])]
- [(tuple (list (bool true) (int 123))) "[true 123]" (^ [_ (#;Tuple (list [_ (#;Bool true)] [_ (#;Int 123)]))])]
- [(record (list [(bool true) (int 123)])) "{true 123}" (^ [_ (#;Record (list [[_ (#;Bool true)] [_ (#;Int 123)]]))])]
- [(local-tag "lol") "#lol" [_ (#;Tag ["" "lol"])]]
- [(local-symbol "lol") "lol" [_ (#;Symbol ["" "lol"])]]
+ [(bool true) "true" [_ (#.Bool true)]]
+ [(bool false) "false" [_ (#.Bool false)]]
+ [(int 123) "123" [_ (#.Int 123)]]
+ [(frac 123.0) "123.0" [_ (#.Frac 123.0)]]
+ [(text "\n") "\"\\n\"" [_ (#.Text "\n")]]
+ [(tag ["yolo" "lol"]) "#yolo.lol" [_ (#.Tag ["yolo" "lol"])]]
+ [(symbol ["yolo" "lol"]) "yolo.lol" [_ (#.Symbol ["yolo" "lol"])]]
+ [(form (list (bool true) (int 123))) "(true 123)" (^ [_ (#.Form (list [_ (#.Bool true)] [_ (#.Int 123)]))])]
+ [(tuple (list (bool true) (int 123))) "[true 123]" (^ [_ (#.Tuple (list [_ (#.Bool true)] [_ (#.Int 123)]))])]
+ [(record (list [(bool true) (int 123)])) "{true 123}" (^ [_ (#.Record (list [[_ (#.Bool true)] [_ (#.Int 123)]]))])]
+ [(local-tag "lol") "#lol" [_ (#.Tag ["" "lol"])]]
+ [(local-symbol "lol") "lol" [_ (#.Symbol ["" "lol"])]]
)]
(test-all <tests>))))}
(case tokens
@@ -5421,7 +5429,7 @@
(^ (list& [_ (#Symbol ["" var-name])] macro-expr bindings'))
(do Monad<Meta>
[expansion (macro-expand-once macro-expr)]
- (case (place-tokens var-name expansion (` (;with-expansions
+ (case (place-tokens var-name expansion (` (.with-expansions
[(~@ bindings')]
(~@ bodies))))
(#Some output)
@@ -5509,12 +5517,12 @@
))
(macro: #export (^~ tokens)
- {#;doc (doc "Use global defs with simple values, such as text, int, frac and bool in place of literals in patterns."
+ {#.doc (doc "Use global defs with simple values, such as text, int, frac and bool in place of literals in patterns."
"The definitions must be properly-qualified (though you may use one of the short-cuts Lux provides)."
(def: (empty?' node)
(All [K V] (-> (Node K V) Bool))
(case node
- (^~ (#Base ;;clean-bitmap _))
+ (^~ (#Base ..clean-bitmap _))
true
_
@@ -5542,7 +5550,7 @@
(def: (case-level^ level)
(-> Code (Meta [Code Code]))
(case level
- (^ [_ (#;Tuple (list expr binding))])
+ (^ [_ (#Tuple (list expr binding))])
(return [expr binding])
_
@@ -5552,10 +5560,10 @@
(def: (multi-level-case^ levels)
(-> (List Code) (Meta Multi-Level-Case))
(case levels
- #;Nil
+ #Nil
(fail "Multi-level patterns cannot be empty.")
- (#;Cons init extras)
+ (#Cons init extras)
(do Monad<Meta>
[extras' (monad/map Monad<Meta> case-level^ extras)]
(wrap [init extras']))))
@@ -5568,47 +5576,47 @@
(~ success)
(~ g!_)
- #;None)))
- (` (#;Some (~ body)))
+ #.None)))
+ (` (#.Some (~ body)))
(: (List [Code Code]) (list/reverse levels)))]
(list init-pattern inner-pattern-body)))
(macro: #export (^multi tokens)
- {#;doc (doc "Multi-level pattern matching."
+ {#.doc (doc "Multi-level pattern matching."
"Useful in situations where the result of a branch depends on further refinements on the values being matched."
"For example:"
(case (split (size static) uri)
- (^multi (#;Some [chunk uri']) [(text/= static chunk) true])
+ (^multi (#.Some [chunk uri']) [(text/= static chunk) true])
(match-uri endpoint? parts' uri')
_
- (#;Left (format "Static part " (%t static) " does not match URI: " uri)))
+ (#.Left (format "Static part " (%t static) " does not match URI: " uri)))
"Short-cuts can be taken when using boolean tests."
"The example above can be rewritten as..."
(case (split (size static) uri)
- (^multi (#;Some [chunk uri']) (text/= static chunk))
+ (^multi (#.Some [chunk uri']) (text/= static chunk))
(match-uri endpoint? parts' uri')
_
- (#;Left (format "Static part " (%t static) " does not match URI: " uri))))}
+ (#.Left (format "Static part " (%t static) " does not match URI: " uri))))}
(case tokens
- (^ (list& [_meta (#;Form levels)] body next-branches))
+ (^ (list& [_meta (#Form levels)] body next-branches))
(do Monad<Meta>
[mlc (multi-level-case^ levels)
expected get-expected-type
g!temp (gensym "temp")]
(let [output (list g!temp
- (` ("lux case" ("lux check" (#;Apply (~ (type-to-code expected)) Maybe)
+ (` ("lux case" ("lux check" (#.Apply (~ (type-to-code expected)) Maybe)
(case (~ g!temp)
(~@ (multi-level-case$ g!temp [mlc body]))
(~ g!temp)
- #;None))
- {(#;Some (~ g!temp))
+ #.None))
+ {(#Some (~ g!temp))
(~ g!temp)
- #;None
+ #None
(case (~ g!temp)
(~@ next-branches))})))]
(wrap output)))
@@ -5617,15 +5625,15 @@
(fail "Wrong syntax for ^multi")))
(macro: #export (ident-for tokens)
- {#;doc (doc "Given a symbol or a tag, gives back a 2 tuple with the prefix and name parts, both as Text."
- (ident-for #;doc)
+ {#.doc (doc "Given a symbol or a tag, gives back a 2 tuple with the prefix and name parts, both as Text."
+ (ident-for #.doc)
"=>"
["lux" "doc"])}
(case tokens
(^template [<tag>]
(^ (list [_ (<tag> [prefix name])]))
(return (list (` [(~ (text$ prefix)) (~ (text$ name))]))))
- ([#;Symbol] [#;Tag])
+ ([#Symbol] [#Tag])
_
(fail "Wrong syntax for ident-for")))
@@ -5655,16 +5663,16 @@
(def: (list-at idx xs)
(All [a] (-> Nat (List a) (Maybe a)))
(case xs
- #;Nil
- #;None
+ #Nil
+ #None
- (#;Cons x xs')
+ (#Cons x xs')
(if (n/= +0 idx)
- (#;Some x)
+ (#Some x)
(list-at (n/dec idx) xs'))))
(macro: #export ($ tokens)
- {#;doc (doc "Allows you to refer to the type-variables in a polymorphic function's type, by their index."
+ {#.doc (doc "Allows you to refer to the type-variables in a polymorphic function's type, by their index."
"In the example below, +0 corresponds to the 'a' variable."
(def: #export (from-list list)
(All [a] (-> (List a) (Sequence a)))
@@ -5677,17 +5685,17 @@
(do Monad<Meta>
[stvs get-scope-type-vars]
(case (list-at idx (list/reverse stvs))
- (#;Some var-id)
+ (#Some var-id)
(wrap (list (` (#Ex (~ (nat$ var-id))))))
- #;None
+ #None
(fail (text/compose "Indexed-type does not exist: " (nat/encode idx)))))
_
(fail "Wrong syntax for $")))
(def: #export (is reference sample)
- {#;doc (doc "Tests whether the 2 values are identical (not just \"equal\")."
+ {#.doc (doc "Tests whether the 2 values are identical (not just \"equal\")."
"This one should succeed:"
(let [value 5]
(is value value))
@@ -5698,13 +5706,13 @@
("lux is" reference sample))
(macro: #export (^@ tokens)
- {#;doc (doc "Allows you to simultaneously bind and de-structure a value."
+ {#.doc (doc "Allows you to simultaneously bind and de-structure a value."
(def: (hash (^@ set [Hash<a> _]))
(list/fold (function [elem acc] (n/+ (:: Hash<a> hash elem) acc))
+0
(to-list set))))}
(case tokens
- (^ (list& [_meta (#;Form (list [_ (#;Symbol ["" name])] pattern))] body branches))
+ (^ (list& [_meta (#Form (list [_ (#Symbol ["" name])] pattern))] body branches))
(let [g!whole (symbol$ ["" name])]
(return (list& g!whole
(` (case (~ g!whole) (~ pattern) (~ body)))
@@ -5714,12 +5722,12 @@
(fail "Wrong syntax for ^@")))
(macro: #export (^|> tokens)
- {#;doc (doc "Pipes the value being pattern-matched against prior to binding it to a variable."
+ {#.doc (doc "Pipes the value being pattern-matched against prior to binding it to a variable."
(case input
(^|> value [n/inc (n/% +10) (n/max +1)])
(foo value)))}
(case tokens
- (^ (list& [_meta (#;Form (list [_ (#;Symbol ["" name])] [_ (#;Tuple steps)]))] body branches))
+ (^ (list& [_meta (#Form (list [_ (#Symbol ["" name])] [_ (#Tuple steps)]))] body branches))
(let [g!name (symbol$ ["" name])]
(return (list& g!name
(` (let [(~ g!name) (|> (~ g!name) (~@ steps))]
@@ -5730,7 +5738,7 @@
(fail "Wrong syntax for ^|>")))
(macro: #export (:!! tokens)
- {#;doc (doc "Coerces the given expression to the type of whatever is expected."
+ {#.doc (doc "Coerces the given expression to the type of whatever is expected."
(: Dinosaur (:!! (list 1 2 3))))}
(case tokens
(^ (list expr))
@@ -5742,27 +5750,27 @@
(fail "Wrong syntax for :!!")))
(macro: #export (undefined tokens)
- {#;doc (doc "Meant to be used as a stand-in for functions with undefined implementations."
+ {#.doc (doc "Meant to be used as a stand-in for functions with undefined implementations."
"Undefined expressions will type-check against everything, so they make good dummy implementations."
"However, if an undefined expression is ever evaluated, it will raise a runtime error."
(def: (square x)
(-> Int Int)
(undefined)))}
(case tokens
- #;Nil
+ #Nil
(return (list (` (error! "Undefined behavior."))))
_
(fail "Wrong syntax for undefined")))
(macro: #export (type-of tokens)
- {#;doc (doc "Generates the type corresponding to a given definition or variable."
+ {#.doc (doc "Generates the type corresponding to a given definition or variable."
(let [my-num (: Int 123)]
(type-of my-num))
"=="
Int)}
(case tokens
- (^ (list [_ (#;Symbol var-name)]))
+ (^ (list [_ (#Symbol var-name)]))
(do Monad<Meta>
[var-type (find-type var-name)]
(wrap (list (type-to-code var-type))))
@@ -5778,25 +5786,25 @@
(-> (List Code) (Meta [(Maybe Export-Level') (List Code)]))
(case tokens
(^ (list& [_ (#Tag ["" "export"])] tokens'))
- (return [(#;Some #Export) tokens'])
+ (return [(#Some #Export) tokens'])
(^ (list& [_ (#Tag ["" "hidden"])] tokens'))
- (return [(#;Some #Hidden) tokens'])
+ (return [(#Some #Hidden) tokens'])
_
- (return [#;None tokens])
+ (return [#None tokens])
))
(def: (gen-export-level ?export-level)
(-> (Maybe Export-Level') (List Code))
(case ?export-level
- #;None
+ #None
(list)
- (#;Some #Export)
+ (#Some #Export)
(list (' #export))
- (#;Some #Hidden)
+ (#Some #Hidden)
(list (' #hidden))
))
@@ -5851,7 +5859,7 @@
))
(macro: #export (template: tokens)
- {#;doc (doc "Define macros in the style of do-template and ^template."
+ {#.doc (doc "Define macros in the style of do-template and ^template."
"For simple macros that do not need any fancy features."
(template: (square x)
(i/* x x)))}
@@ -5876,16 +5884,16 @@
(~ anns)
(case (~ g!tokens)
(^ (list (~@ (map (|>> [""] symbol$) args))))
- (#;Right [(~ g!compiler)
+ (#.Right [(~ g!compiler)
(list (` (~ (replace-syntax rep-env input-template))))])
(~ g!_)
- (#;Left (~ (text$ (text/compose "Wrong syntax for " name))))
+ (#.Left (~ (text$ (text/compose "Wrong syntax for " name))))
)))))
))
(macro: #export (as-is tokens compiler)
- (#;Right [compiler tokens]))
+ (#Right [compiler tokens]))
(macro: #export (char tokens compiler)
(case tokens
@@ -5894,10 +5902,10 @@
(|> ("lux text char" input +0)
(default (undefined))
nat$ list
- [compiler] #;Right)
+ [compiler] #Right)
_
- (#;Left "Wrong syntax for char")))
+ (#Left "Wrong syntax for char")))
(def: #export (when test f)
(All [a] (-> Bool (-> a a) (-> a a)))
@@ -5907,25 +5915,25 @@
value)))
(type: #export (Array a)
- {#;doc "Mutable arrays."}
- (#;Primitive "#Array" (#;Cons a #;Nil)))
+ {#.doc "Mutable arrays."}
+ (#.Primitive "#Array" (#.Cons a #.Nil)))
(def: target
(Meta Text)
(function [compiler]
- (#;Right [compiler (get@ [#info #target] compiler)])))
+ (#Right [compiler (get@ [#info #target] compiler)])))
(def: (pick-for-target target options)
(-> Text (List [Code Code]) (Maybe Code))
(case options
- #;Nil
- #;None
+ #Nil
+ #None
- (#;Cons [key value] options')
+ (#Cons [key value] options')
(case key
(^multi [_ (#Text platform)]
(text/= target platform))
- (#;Some value)
+ (#Some value)
_
(pick-for-target target options'))
@@ -5937,14 +5945,14 @@
(case tokens
(^ (list [_ (#Record options)]))
(case (pick-for-target target options)
- (#;Some pick)
+ (#Some pick)
(wrap (list pick))
- #;None
+ #None
(fail ($_ text/compose "No code for target platform: " target)))
(^ (list [_ (#Record options)] default))
- (wrap (list (;;default default (pick-for-target target options))))
+ (wrap (list (..default default (pick-for-target target options))))
_
(fail "Wrong syntax for 'for'"))))
@@ -6017,7 +6025,7 @@
last
(#Cons [init inits'])
- (` (#;Cons (~ init) (~ (untemplate-list& last inits'))))))
+ (` (#.Cons (~ init) (~ (untemplate-list& last inits'))))))
(def: (untemplate-pattern pattern)
(-> Code (Meta Code))
@@ -6046,7 +6054,7 @@
(wrap (` [(~ =key) (~ =value)]))))
fields)
g!meta (gensym "g!meta")]
- (wrap (` [(~ g!meta) (#;Record (~ (untemplate-list =fields)))])))
+ (wrap (` [(~ g!meta) (#.Record (~ (untemplate-list =fields)))])))
[_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))]
(return unquoted)
@@ -6057,8 +6065,8 @@
(^template [<tag>]
[_ (<tag> elems)]
(case (list/reverse elems)
- (#;Cons [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))]
- inits)
+ (#Cons [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))]
+ inits)
(do Monad<Meta>
[=inits (monad/map Monad<Meta> untemplate-pattern (list/reverse inits))
g!meta (gensym "g!meta")]
@@ -6069,12 +6077,12 @@
[=elems (monad/map Monad<Meta> untemplate-pattern elems)
g!meta (gensym "g!meta")]
(wrap (` [(~ g!meta) (<tag> (~ (untemplate-list =elems)))])))))
- ([#;Tuple] [#;Form])
+ ([#Tuple] [#Form])
))
(macro: #export (^code tokens)
(case tokens
- (^ (list& [_meta (#;Form (list template))] body branches))
+ (^ (list& [_meta (#Form (list template))] body branches))
(do Monad<Meta>
[pattern (untemplate-pattern template)]
(wrap (list& pattern body branches)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-26 22:31:01 +0000