aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2017-10-11 17:10:16 -0400
committerEduardo Julian2017-10-11 17:10:16 -0400
commit6608f998bca38022af2ebe4f7557f20b20f58acf (patch)
treeb1c7a7bf6492a973756d23f2845802198087e5d9 /stdlib
parentede56371f52b63b92cf0dc35a22ae243053268c3 (diff)
- Eliminated the Anns and Ann-Value types, and now only using Code for definition annotations.
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux.lux2073
-rw-r--r--stdlib/source/lux/concurrency/actor.lux2
-rw-r--r--stdlib/source/lux/data/format/json.lux112
-rw-r--r--stdlib/source/lux/data/text/lexer.lux5
-rw-r--r--stdlib/source/lux/macro.lux168
-rw-r--r--stdlib/source/lux/macro/syntax.lux86
-rw-r--r--stdlib/source/lux/macro/syntax/common/reader.lux50
-rw-r--r--stdlib/source/lux/test.lux4
-rw-r--r--stdlib/source/lux/type/object.lux4
-rw-r--r--stdlib/source/lux/type/opaque.lux22
10 files changed, 1318 insertions, 1208 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 480bc3468..3c1edac4b 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -1,116 +1,172 @@
## Basic types
+(_lux_def dummy-cursor
+ (_lux_: (+4 (+0 "#Text" (+0)) (+4 (+0 "#Nat" (+0)) (+0 "#Nat" (+0))))
+ ["" +0 +0])
+ [["" +0 +0]
+ (+10 (+1 [[["" +0 +0] (+7 ["lux" "export?"])]
+ [["" +0 +0] (+0 true)]]
+ (+0)))])
+
+## (type: (List a)
+## #Nil
+## (#Cons a (List a)))
+(_lux_def List
+ (+12 ["lux" "List"]
+ (+9 (+0)
+ (+3 ## "lux;Nil"
+ (+2)
+ ## "lux;Cons"
+ (+4 (+6 +1)
+ (+11 (+6 +1) (+6 +0))))))
+ [dummy-cursor
+ (+10 (+1 [[dummy-cursor (+7 ["lux" "type?"])]
+ [dummy-cursor (+0 true)]]
+ (+1 [[dummy-cursor (+7 ["lux" "export?"])]
+ [dummy-cursor (+0 true)]]
+ (+1 [[dummy-cursor (+7 ["lux" "tags"])]
+ [dummy-cursor (+9 (+1 [dummy-cursor (+5 "Nil")] (+1 [dummy-cursor (+5 "Cons")] (+0))))]]
+ (+1 [[dummy-cursor (+7 ["lux" "type-args"])]
+ [dummy-cursor (+9 (+1 [dummy-cursor (+5 "a")] (+0)))]]
+ (+1 [[dummy-cursor (+7 ["lux" "doc"])]
+ [dummy-cursor (+5 "A potentially empty list of values.")]]
+ (+0)))))))])
+
(_lux_def Bool
(+12 ["lux" "Bool"]
- (+0 "#Bool" (+0)))
- (+1 [["lux" "type?"] (+0 true)]
- (+1 [["lux" "export?"] (+0 true)]
- (+1 [["lux" "doc"] (+5 "Your standard, run-of-the-mill boolean values.")]
- (+0)))))
+ (+0 "#Bool" #Nil))
+ [dummy-cursor
+ (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "export?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "doc"])]
+ [dummy-cursor (+5 "Your standard, run-of-the-mill boolean values.")]]
+ #Nil))))])
(_lux_def Nat
(+12 ["lux" "Nat"]
- (+0 "#Nat" (+0)))
- (+1 [["lux" "type?"] (+0 true)]
- (+1 [["lux" "export?"] (+0 true)]
- (+1 [["lux" "doc"] (+5 "Natural numbers (unsigned integers).
-
- They start at zero (+0) and extend in the positive direction.")]
- (+0)))))
+ (+0 "#Nat" #Nil))
+ [dummy-cursor
+ (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "export?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "doc"])]
+ [dummy-cursor (+5 "Natural numbers (unsigned integers).
+
+ They start at zero (+0) and extend in the positive direction.")]]
+ #Nil))))])
(_lux_def Int
(+12 ["lux" "Int"]
- (+0 "#Int" (+0)))
- (+1 [["lux" "type?"] (+0 true)]
- (+1 [["lux" "export?"] (+0 true)]
- (+1 [["lux" "doc"] (+5 "Your standard, run-of-the-mill integer numbers.")]
- (+0)))))
+ (+0 "#Int" #Nil))
+ [dummy-cursor
+ (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "export?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "doc"])]
+ [dummy-cursor (+5 "Your standard, run-of-the-mill integer numbers.")]]
+ #Nil))))])
(_lux_def Frac
(+12 ["lux" "Frac"]
- (+0 "#Frac" (+0)))
- (+1 [["lux" "type?"] (+0 true)]
- (+1 [["lux" "export?"] (+0 true)]
- (+1 [["lux" "doc"] (+5 "Your standard, run-of-the-mill floating-point numbers.")]
- (+0)))))
+ (+0 "#Frac" #Nil))
+ [dummy-cursor
+ (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "export?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "doc"])]
+ [dummy-cursor (+5 "Your standard, run-of-the-mill floating-point (fractional) numbers.")]]
+ #Nil))))])
(_lux_def Deg
(+12 ["lux" "Deg"]
- (+0 "#Deg" (+0)))
- (+1 [["lux" "type?"] (+0 true)]
- (+1 [["lux" "export?"] (+0 true)]
- (+1 [["lux" "doc"] (+5 "Fractional numbers that live in the interval [0,1).
-
- Useful for probability, and other domains that work within that interval.")]
- (+0)))))
+ (+0 "#Deg" #Nil))
+ [dummy-cursor
+ (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "export?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "doc"])]
+ [dummy-cursor (+5 "Fractional numbers that live in the interval [0,1).
+
+ Useful for probability, and other domains that work within that interval.")]]
+ #Nil))))])
(_lux_def Text
(+12 ["lux" "Text"]
- (+0 "#Text" (+0)))
- (+1 [["lux" "type?"] (+0 true)]
- (+1 [["lux" "export?"] (+0 true)]
- (+1 [["lux" "doc"] (+5 "Your standard, run-of-the-mill string values.")]
- (+0)))))
+ (+0 "#Text" #Nil))
+ [dummy-cursor
+ (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "export?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "doc"])]
+ [dummy-cursor (+5 "Your standard, run-of-the-mill string values.")]]
+ #Nil))))])
(_lux_def Void
(+12 ["lux" "Void"]
(+1))
- (+1 [["lux" "type?"] (+0 true)]
- (+1 [["lux" "export?"] (+0 true)]
- (+1 [["lux" "doc"] (+5 "An unusual type that possesses no value, and thus cannot be instantiated.")]
- (+0)))))
+ [dummy-cursor
+ (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "export?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "doc"])]
+ [dummy-cursor (+5 "An unusual type that possesses no value, and thus cannot be instantiated.")]]
+ #Nil))))])
(_lux_def Unit
(+12 ["lux" "Unit"]
(+2))
- (+1 [["lux" "type?"] (+0 true)]
- (+1 [["lux" "export?"] (+0 true)]
- (+1 [["lux" "doc"] (+5 "An unusual type that only possesses a single value: []")]
- (+0)))))
+ [dummy-cursor
+ (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "export?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "doc"])]
+ [dummy-cursor (+5 "An unusual type that only possesses a single value: []")]]
+ #Nil))))])
(_lux_def Ident
(+12 ["lux" "Ident"]
(+4 Text Text))
- (+1 [["lux" "type?"] (+0 true)]
- (+1 [["lux" "export?"] (+0 true)]
- (+1 [["lux" "doc"] (+5 "An identifier.
+ [dummy-cursor
+ (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "export?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "doc"])]
+ [dummy-cursor (+5 "An identifier.
- It is used as part of Lux syntax to represent symbols and tags.")]
- (+0)))))
-
-## (type: (List a)
-## #Nil
-## (#Cons a (List a)))
-(_lux_def List
- (+12 ["lux" "List"]
- (+9 (+0)
- (+3 ## "lux;Nil"
- (+2)
- ## "lux;Cons"
- (+4 (+6 +1)
- (+11 (+6 +1) (+6 +0))))))
- (+1 [["lux" "type?"] (+0 true)]
- (+1 [["lux" "export?"] (+0 true)]
- (+1 [["lux" "tags"] (+7 (+1 (+5 "Nil") (+1 (+5 "Cons") (+0))))]
- (+1 [["lux" "type-args"] (+7 (+1 (+5 "a") (+0)))]
- (+1 [["lux" "doc"] (+5 "A potentially empty list of values.")]
- (+0)))))))
+ It is used as part of Lux syntax to represent symbols and tags.")]]
+ #Nil))))])
## (type: (Maybe a)
## #None
## (#Some a))
(_lux_def Maybe
(+12 ["lux" "Maybe"]
- (+9 (+0)
+ (+9 #Nil
(+3 ## "lux;None"
(+2)
## "lux;Some"
(+6 +1))))
- (#Cons [["lux" "type?"] (+0 true)]
- (#Cons [["lux" "export?"] (+0 true)]
- (#Cons [["lux" "tags"] (+7 (#Cons (+5 "None") (#Cons (+5 "Some") #Nil)))]
- (#Cons [["lux" "type-args"] (+7 (#Cons (+5 "a") #Nil))]
- (#Cons [["lux" "doc"] (+5 "A potentially missing value.")]
- #Nil))))))
+ [dummy-cursor
+ (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "export?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "tags"])]
+ [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "None")] (#Cons [dummy-cursor (+5 "Some")] #Nil)))]]
+ (#Cons [[dummy-cursor (+7 ["lux" "type-args"])]
+ [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "a")] #Nil))]]
+ (#Cons [[dummy-cursor (+7 ["lux" "doc"])]
+ [dummy-cursor (+5 "A potentially missing value.")]]
+ #Nil))))))])
## (type: #rec Type
## (#Host Text (List Type))
@@ -132,23 +188,23 @@
(_lux_case (+11 (+6 +1) (+6 +0))
Type
(_lux_case (+11 Type List)
- TypeList
+ Type-List
(_lux_case (+4 Type Type)
- TypePair
+ Type-Pair
(+11 Void
(+9 #Nil
(+3 ## "lux;Host"
- (+4 Text TypeList)
+ (+4 Text Type-List)
(+3 ## "lux;Void"
(+2)
(+3 ## "lux;Unit"
(+2)
(+3 ## "lux;Sum"
- TypePair
+ Type-Pair
(+3 ## "lux;Product"
- TypePair
+ Type-Pair
(+3 ## "lux;Function"
- TypePair
+ Type-Pair
(+3 ## "lux;Bound"
Nat
(+3 ## "lux;Var"
@@ -156,158 +212,70 @@
(+3 ## "lux;Ex"
Nat
(+3 ## "lux;UnivQ"
- (+4 TypeList Type)
+ (+4 Type-List Type)
(+3 ## "lux;ExQ"
- (+4 TypeList Type)
+ (+4 Type-List Type)
(+3 ## "lux;App"
- TypePair
+ Type-Pair
## "lux;Named"
(+4 Ident Type)))))))))))))))))))
- (#Cons [["lux" "type?"] (+0 true)]
- (#Cons [["lux" "export?"] (+0 true)]
- (#Cons [["lux" "tags"] (+7 (#Cons (+5 "Host")
- (#Cons (+5 "Void")
- (#Cons (+5 "Unit")
- (#Cons (+5 "Sum")
- (#Cons (+5 "Product")
- (#Cons (+5 "Function")
- (#Cons (+5 "Bound")
- (#Cons (+5 "Var")
- (#Cons (+5 "Ex")
- (#Cons (+5 "UnivQ")
- (#Cons (+5 "ExQ")
- (#Cons (+5 "Apply")
- (#Cons (+5 "Named")
- #Nil))))))))))))))]
- (#Cons [["lux" "doc"] (+5 "This type represents the data-structures that are used to specify types themselves.")]
- (#Cons [["lux" "type-rec?"] (+0 true)]
- #Nil))))))
+ [dummy-cursor
+ (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "export?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "tags"])]
+ [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "Host")]
+ (#Cons [dummy-cursor (+5 "Void")]
+ (#Cons [dummy-cursor (+5 "Unit")]
+ (#Cons [dummy-cursor (+5 "Sum")]
+ (#Cons [dummy-cursor (+5 "Product")]
+ (#Cons [dummy-cursor (+5 "Function")]
+ (#Cons [dummy-cursor (+5 "Bound")]
+ (#Cons [dummy-cursor (+5 "Var")]
+ (#Cons [dummy-cursor (+5 "Ex")]
+ (#Cons [dummy-cursor (+5 "UnivQ")]
+ (#Cons [dummy-cursor (+5 "ExQ")]
+ (#Cons [dummy-cursor (+5 "Apply")]
+ (#Cons [dummy-cursor (+5 "Named")]
+ #Nil))))))))))))))]]
+ (#Cons [[dummy-cursor (+7 ["lux" "doc"])]
+ [dummy-cursor (+5 "This type represents the data-structures that are used to specify types themselves.")]]
+ (#Cons [[dummy-cursor (+7 ["lux" "type-rec?"])]
+ [dummy-cursor (+0 true)]]
+ #Nil))))))])
## (type: Top
## (Ex [a] a))
(_lux_def Top
(#Named ["lux" "Top"]
(#ExQ #Nil (#Bound +1)))
- (#Cons [["lux" "type?"] (+0 true)]
- (#Cons [["lux" "export?"] (+0 true)]
- (#Cons [["lux" "doc"] (+5 "The type of things whose type does not matter.
+ [dummy-cursor
+ (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "export?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "doc"])]
+ [dummy-cursor (+5 "The type of things whose type does not matter.
- It can be used to write functions or data-structures that can take, or return, anything.")]
- #Nil))))
+ It can be used to write functions or data-structures that can take, or return, anything.")]]
+ #Nil))))])
## (type: Bottom
## (All [a] a))
(_lux_def Bottom
(#Named ["lux" "Bottom"]
(#UnivQ #Nil (#Bound +1)))
- (#Cons [["lux" "type?"] (+0 true)]
- (#Cons [["lux" "export?"] (+0 true)]
- (#Cons [["lux" "doc"] (+5 "The type of things whose type is unknown or undefined.
-
- Useful for expressions that cause errors or other \"extraordinary\" conditions.")]
- #Nil))))
-
-## (type: #rec Ann-Value
-## (#BoolA Bool)
-## (#NatA Nat)
-## (#IntA Int)
-## (#DegA Deg)
-## (#FracA Frac)
-## (#TextA Text)
-## (#IdentA Ident)
-## (#ListA (List Ann-Value))
-## (#DictA (List [Text Ann-Value])))
-(_lux_def Ann-Value
- (#Named ["lux" "Ann-Value"]
- (_lux_case (#Apply (#Bound +1) (#Bound +0))
- Ann-Value
- (#Apply Void
- (#UnivQ #Nil
- (#Sum ## #BoolA
- Bool
- (#Sum ## #NatA
- Nat
- (#Sum ## #IntA
- Int
- (#Sum ## #DegA
- Deg
- (#Sum ## #FracA
- Frac
- (#Sum ## #TextA
- Text
- (#Sum ## #IdentA
- Ident
- (#Sum ## #ListA
- (#Apply Ann-Value List)
- ## #DictA
- (#Apply (#Product Text Ann-Value) List)))))))))
- ))
- ))
- (#Cons [["lux" "type?"] (+0 true)]
- (#Cons [["lux" "export?"] (+0 true)]
- (#Cons [["lux" "tags"] (+7 (#Cons (+5 "BoolA")
- (#Cons (+5 "NatA")
- (#Cons (+5 "IntA")
- (#Cons (+5 "DegA")
- (#Cons (+5 "FracA")
- (#Cons (+5 "TextA")
- (#Cons (+5 "IdentA")
- (#Cons (+5 "ListA")
- (#Cons (+5 "DictA")
- #Nil))))))))))]
- (#Cons [["lux" "type-rec?"] (+0 true)]
- (#Cons [["lux" "doc"] (+5 "The value of an individual annotation.")]
- #Nil))))))
-
-## (type: Anns
-## (List [Ident Ann-Value]))
-(_lux_def Anns
- (#Named ["lux" "Anns"]
- (#Apply (#Product Ident Ann-Value) List))
- (#Cons [["lux" "type?"] (#BoolA true)]
- (#Cons [["lux" "export?"] (#BoolA true)]
- (#Cons [["lux" "doc"] (#TextA "A set of annotations associated with a definition.")]
- #Nil))))
+ [dummy-cursor
+ (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "export?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "doc"])]
+ [dummy-cursor (+5 "The type of things whose type is unknown or undefined.
-(_lux_def default-def-meta-exported
- (_lux_: Anns
- (#Cons [["lux" "type?"] (#BoolA true)]
- (#Cons [["lux" "export?"] (#BoolA true)]
- #Nil)))
- #Nil)
-
-(_lux_def default-def-meta-unexported
- (_lux_: Anns
- (#Cons [["lux" "type?"] (#BoolA true)]
- #Nil))
- #Nil)
-
-## (type: Def
-## [Type Anns Top])
-(_lux_def Def
- (#Named ["lux" "Def"]
- (#Product Type (#Product Anns Top)))
- (#Cons [["lux" "doc"] (#TextA "Represents all the data associated with a definition: its type, its annotations, and its value.")]
- default-def-meta-exported))
-
-## (type: (Bindings k v)
-## {#counter Nat
-## #mappings (List [k v])})
-(_lux_def Bindings
- (#Named ["lux" "Bindings"]
- (#UnivQ #Nil
- (#UnivQ #Nil
- (#Product ## "lux;counter"
- Nat
- ## "lux;mappings"
- (#Apply (#Product (#Bound +3)
- (#Bound +1))
- List)))))
- (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "counter")
- (#Cons (#TextA "mappings")
- #Nil)))]
- (#Cons [["lux" "type-args"] (#ListA (#Cons (#TextA "k") (#Cons (#TextA "v") #;Nil)))]
- default-def-meta-exported)))
+ Useful for expressions that cause errors or other \"extraordinary\" conditions.")]]
+ #Nil))))])
## (type: Cursor
## {#module Text
@@ -316,12 +284,19 @@
(_lux_def Cursor
(#Named ["lux" "Cursor"]
(#Product Text (#Product Nat Nat)))
- (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "module")
- (#Cons (#TextA "line")
- (#Cons (#TextA "column")
- #Nil))))]
- (#Cons [["lux" "doc"] (#TextA "Cursors are for specifying the location of Code nodes in Lux files during compilation.")]
- default-def-meta-exported)))
+ [dummy-cursor
+ (+10 (#Cons [[dummy-cursor (+7 ["lux" "tags"])]
+ [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "module")]
+ (#Cons [dummy-cursor (+5 "line")]
+ (#Cons [dummy-cursor (+5 "column")]
+ #Nil))))]]
+ (#Cons [[dummy-cursor (+7 ["lux" "doc"])]
+ [dummy-cursor (+5 "Cursors are for specifying the location of Code nodes in Lux files during compilation.")]]
+ (#Cons [[dummy-cursor (+7 ["lux" "type?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "export?"])]
+ [dummy-cursor (+0 true)]]
+ #Nil)))))])
## (type: (Meta m v)
## {#meta m
@@ -332,48 +307,20 @@
(#UnivQ #Nil
(#Product (#Bound +3)
(#Bound +1)))))
- (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "meta")
- (#Cons (#TextA "datum")
- #Nil)))]
- (#Cons [["lux" "doc"] (#TextA "The type of things that can have meta-data of arbitrary types.")]
- (#Cons [["lux" "type-args"] (#ListA (#Cons (#TextA "m") (#Cons (#TextA "v") #;Nil)))]
- default-def-meta-exported))))
-
-## (type: #export Ref
-## (#Local Nat)
-## (#Captured Nat))
-(_lux_def Ref
- (#Named ["lux" "Ref"]
- (#Sum ## Local
- Nat
- ## Captured
- Nat))
- (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "Local")
- (#Cons (#TextA "Captured")
- #Nil)))]
- default-def-meta-exported))
-
-## (type: Scope
-## {#name (List Text)
-## #inner Nat
-## #locals (Bindings Text [Type Nat])
-## #captured (Bindings Text [Type Ref])})
-(_lux_def Scope
- (#Named ["lux" "Scope"]
- (#Product ## name
- (#Apply Text List)
- (#Product ## inner
- Nat
- (#Product ## locals
- (#Apply (#Product Type Nat) (#Apply Text Bindings))
- ## captured
- (#Apply (#Product Type Ref) (#Apply Text Bindings))))))
- (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "name")
- (#Cons (#TextA "inner")
- (#Cons (#TextA "locals")
- (#Cons (#TextA "captured")
- #Nil)))))]
- default-def-meta-exported))
+ [dummy-cursor
+ (+10 (#Cons [[dummy-cursor (+7 ["lux" "tags"])]
+ [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "meta")]
+ (#Cons [dummy-cursor (+5 "datum")]
+ #Nil)))]]
+ (#Cons [[dummy-cursor (+7 ["lux" "doc"])]
+ [dummy-cursor (+5 "The type of things that can have 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)))]]
+ (#Cons [[dummy-cursor (+7 ["lux" "type?"])]
+ [dummy-cursor (+0 true)]]
+ (#Cons [[dummy-cursor (+7 ["lux" "export?"])]
+ [dummy-cursor (+0 true)]]
+ #Nil))))))])
## (type: (Code' w)
## (#Bool Bool)
@@ -420,20 +367,27 @@
(#Apply (#Product Code Code) List)
))))))))))
))))
- (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "Bool")
- (#Cons (#TextA "Nat")
- (#Cons (#TextA "Int")
- (#Cons (#TextA "Deg")
- (#Cons (#TextA "Frac")
- (#Cons (#TextA "Text")
- (#Cons (#TextA "Symbol")
- (#Cons (#TextA "Tag")
- (#Cons (#TextA "Form")
- (#Cons (#TextA "Tuple")
- (#Cons (#TextA "Record")
- #Nil))))))))))))]
- (#Cons [["lux" "type-args"] (#ListA (#Cons (#TextA "w") #;Nil))]
- default-def-meta-exported)))
+ [dummy-cursor
+ (+10 (#Cons [[dummy-cursor (+7 ["lux" "tags"])]
+ [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "Bool")]
+ (#Cons [dummy-cursor (+5 "Nat")]
+ (#Cons [dummy-cursor (+5 "Int")]
+ (#Cons [dummy-cursor (+5 "Deg")]
+ (#Cons [dummy-cursor (+5 "Frac")]
+ (#Cons [dummy-cursor (+5 "Text")]
+ (#Cons [dummy-cursor (+5 "Symbol")]
+ (#Cons [dummy-cursor (+5 "Tag")]
+ (#Cons [dummy-cursor (+5 "Form")]
+ (#Cons [dummy-cursor (+5 "Tuple")]
+ (#Cons [dummy-cursor (+5 "Record")]
+ #Nil))))))))))))]]
+ (#Cons [[dummy-cursor (+7 ["lux" "type-args"])]
+ [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?"])]
+ [dummy-cursor (+0 true)]]
+ #Nil)))))])
## (type: Code
## (Meta Cursor (Code' (Meta Cursor))))
@@ -442,12 +396,157 @@
(_lux_case (#Apply Cursor Meta)
w
(#Apply (#Apply w Code') w)))
- (#Cons [["lux" "doc"] (#TextA "The type of Code nodes for Lux syntax.")]
- default-def-meta-exported))
+ [dummy-cursor
+ (#Record (#Cons [[dummy-cursor (#Tag ["lux" "doc"])]
+ [dummy-cursor (#Text "The type of Code nodes for Lux syntax.")]]
+ (#Cons [[dummy-cursor (#Tag ["lux" "type?"])]
+ [dummy-cursor (#Bool true)]]
+ (#Cons [[dummy-cursor (#Tag ["lux" "export?"])]
+ [dummy-cursor (#Bool true)]]
+ #Nil))))])
+
+(_lux_def _meta
+ (_lux_: (#Function (#Apply (#Apply Cursor Meta)
+ Code')
+ Code)
+ (_lux_function _ data
+ [dummy-cursor data]))
+ [dummy-cursor (#Record #Nil)])
+
+(_lux_def bool$
+ (_lux_: (#Function Bool Code)
+ (_lux_function _ value (_meta (#Bool value))))
+ [dummy-cursor (#Record #Nil)])
+
+(_lux_def nat$
+ (_lux_: (#Function Nat Code)
+ (_lux_function _ value (_meta (#Nat value))))
+ [dummy-cursor (#Record #Nil)])
+
+(_lux_def int$
+ (_lux_: (#Function Int Code)
+ (_lux_function _ value (_meta (#Int value))))
+ [dummy-cursor (#Record #Nil)])
+
+(_lux_def deg$
+ (_lux_: (#Function Deg Code)
+ (_lux_function _ value (_meta (#Deg value))))
+ [dummy-cursor (#Record #Nil)])
+
+(_lux_def frac$
+ (_lux_: (#Function Frac Code)
+ (_lux_function _ value (_meta (#Frac value))))
+ [dummy-cursor (#Record #Nil)])
+
+(_lux_def text$
+ (_lux_: (#Function Text Code)
+ (_lux_function _ text (_meta (#Text text))))
+ [dummy-cursor (#Record #Nil)])
+
+(_lux_def symbol$
+ (_lux_: (#Function Ident Code)
+ (_lux_function _ ident (_meta (#Symbol ident))))
+ [dummy-cursor (#Record #Nil)])
+
+(_lux_def tag$
+ (_lux_: (#Function Ident Code)
+ (_lux_function _ ident (_meta (#Tag ident))))
+ [dummy-cursor (#Record #Nil)])
+
+(_lux_def form$
+ (_lux_: (#Function (#Apply Code List) Code)
+ (_lux_function _ tokens (_meta (#Form tokens))))
+ [dummy-cursor (#Record #Nil)])
+
+(_lux_def tuple$
+ (_lux_: (#Function (#Apply Code List) Code)
+ (_lux_function _ tokens (_meta (#Tuple tokens))))
+ [dummy-cursor (#Record #Nil)])
+
+(_lux_def record$
+ (_lux_: (#Function (#Apply (#Product Code Code) List) Code)
+ (_lux_function _ tokens (_meta (#Record tokens))))
+ [dummy-cursor (#Record #Nil)])
+
+(_lux_def default-def-meta-exported
+ (_lux_: (#Apply (#Product Code Code) List)
+ (#Cons [(tag$ ["lux" "type?"])
+ (bool$ true)]
+ (#Cons [(tag$ ["lux" "export?"])
+ (bool$ true)]
+ #Nil)))
+ (record$ #Nil))
+
+(_lux_def default-def-meta-unexported
+ (_lux_: (#Apply (#Product Code Code) List)
+ (#Cons [(tag$ ["lux" "type?"])
+ (bool$ true)]
+ #Nil))
+ (record$ #Nil))
+
+## (type: Def
+## [Type Code Top])
+(_lux_def Def
+ (#Named ["lux" "Def"]
+ (#Product Type (#Product Code Top)))
+ (record$ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "Represents all the data associated with a definition: its type, its annotations, and its value.")]
+ default-def-meta-exported)))
+
+## (type: (Bindings k v)
+## {#counter Nat
+## #mappings (List [k v])})
+(_lux_def Bindings
+ (#Named ["lux" "Bindings"]
+ (#UnivQ #Nil
+ (#UnivQ #Nil
+ (#Product ## "lux;counter"
+ Nat
+ ## "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)))]
+ default-def-meta-exported))))
+
+## (type: #export Ref
+## (#Local Nat)
+## (#Captured Nat))
+(_lux_def Ref
+ (#Named ["lux" "Ref"]
+ (#Sum ## Local
+ Nat
+ ## Captured
+ Nat))
+ (record$ (#Cons [(tag$ ["lux" "tags"])
+ (tuple$ (#Cons (text$ "Local") (#Cons (text$ "Captured") #Nil)))]
+ default-def-meta-exported)))
+
+## (type: Scope
+## {#name (List Text)
+## #inner Nat
+## #locals (Bindings Text [Type Nat])
+## #captured (Bindings Text [Type Ref])})
+(_lux_def Scope
+ (#Named ["lux" "Scope"]
+ (#Product ## name
+ (#Apply Text List)
+ (#Product ## inner
+ Nat
+ (#Product ## locals
+ (#Apply (#Product Type Nat) (#Apply Text Bindings))
+ ## captured
+ (#Apply (#Product Type Ref) (#Apply Text Bindings))))))
+ (record$ (#Cons [(tag$ ["lux" "tags"])
+ (tuple$ (#Cons (text$ "name") (#Cons (text$ "inner") (#Cons (text$ "locals") (#Cons (text$ "captured") #Nil)))))]
+ default-def-meta-exported)))
(_lux_def Code-List
(#Apply Code List)
- default-def-meta-unexported)
+ (record$ default-def-meta-unexported))
## (type: (Either l r)
## (#Left l)
@@ -460,19 +559,20 @@
(#Bound +3)
## "lux;Right"
(#Bound +1)))))
- (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "Left")
- (#Cons (#TextA "Right")
- #Nil)))]
- (#Cons [["lux" "type-args"] (#ListA (#Cons (#TextA "l") (#Cons (#TextA "r") #;Nil)))]
- (#Cons [["lux" "doc"] (#TextA "A choice between two values of different types.")]
- default-def-meta-exported))))
+ (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)))]
+ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "A choice between two values of different types.")]
+ default-def-meta-exported)))))
## (type: Source
## [Cursor Text])
(_lux_def Source
(#Named ["lux" "Source"]
(#Product Cursor Text))
- default-def-meta-exported)
+ (record$ default-def-meta-exported))
## (type: Module-State
## #Active
@@ -488,11 +588,9 @@
Unit
## #Cached
Unit)))
- (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "Active")
- (#Cons (#TextA "Compiled")
- (#Cons (#TextA "Cached")
- #Nil))))]
- default-def-meta-exported))
+ (record$ (#Cons [(tag$ ["lux" "tags"])
+ (tuple$ (#Cons (text$ "Active") (#Cons (text$ "Compiled") (#Cons (text$ "Cached") #Nil))))]
+ default-def-meta-exported)))
## (type: Module
## {#module-hash Nat
@@ -526,21 +624,23 @@
(#Product Bool
Type)))
List)
- (#Product ## "lux;module-anns"
- Anns
+ (#Product ## "lux;module-annotations"
+ Code
Module-State))
))))))
- (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "module-hash")
- (#Cons (#TextA "module-aliases")
- (#Cons (#TextA "defs")
- (#Cons (#TextA "imports")
- (#Cons (#TextA "tags")
- (#Cons (#TextA "types")
- (#Cons (#TextA "module-anns")
- (#Cons (#TextA "module-state")
- #Nil)))))))))]
- (#Cons [["lux" "doc"] (#TextA "All the information contained within a Lux module.")]
- default-def-meta-exported)))
+ (record$ (#Cons [(tag$ ["lux" "tags"])
+ (tuple$ (#Cons (text$ "module-hash")
+ (#Cons (text$ "module-aliases")
+ (#Cons (text$ "defs")
+ (#Cons (text$ "imports")
+ (#Cons (text$ "tags")
+ (#Cons (text$ "types")
+ (#Cons (text$ "module-annotations")
+ (#Cons (text$ "module-state")
+ #Nil)))))))))]
+ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "All the information contained within a Lux module.")]
+ default-def-meta-exported))))
## (type: Type-Context
## {#ex-counter Nat
@@ -555,11 +655,12 @@
## var-bindings
(#Apply (#Product Nat (#Apply Type Maybe))
List))))
- (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "ex-counter")
- (#Cons (#TextA "var-counter")
- (#Cons (#TextA "var-bindings")
- #Nil))))]
- default-def-meta-exported))
+ (record$ (#Cons [(tag$ ["lux" "tags"])
+ (tuple$ (#Cons (text$ "ex-counter")
+ (#Cons (text$ "var-counter")
+ (#Cons (text$ "var-bindings")
+ #Nil))))]
+ default-def-meta-exported)))
## (type: Compiler-Mode
## #Build
@@ -573,12 +674,14 @@
#Unit
## REPL
#Unit)))
- (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "Build")
- (#Cons (#TextA "Eval")
- (#Cons (#TextA "REPL")
- #Nil))))]
- (#Cons [["lux" "doc"] (#TextA "A sign that shows the conditions under which the compiler is running.")]
- default-def-meta-exported)))
+ (record$ (#Cons [(tag$ ["lux" "tags"])
+ (tuple$ (#Cons (text$ "Build")
+ (#Cons (text$ "Eval")
+ (#Cons (text$ "REPL")
+ #Nil))))]
+ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "A sign that shows the conditions under which the compiler is running.")]
+ default-def-meta-exported))))
## (type: Compiler-Info
## {#compiler-name Text
@@ -594,12 +697,14 @@
Text
## compiler-mode
Compiler-Mode)))
- (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "compiler-name")
- (#Cons (#TextA "compiler-version")
- (#Cons (#TextA "compiler-mode")
- #Nil))))]
- (#Cons [["lux" "doc"] (#TextA "Information about the current version and type of compiler that is running.")]
- default-def-meta-exported)))
+ (record$ (#Cons [(tag$ ["lux" "tags"])
+ (tuple$ (#Cons (text$ "compiler-name")
+ (#Cons (text$ "compiler-version")
+ (#Cons (text$ "compiler-mode")
+ #Nil))))]
+ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "Information about the current version and type of compiler that is running.")]
+ default-def-meta-exported))))
## (type: Compiler
## {#info Compiler-Info
@@ -634,23 +739,25 @@
(#Apply Nat List)
## "lux;host"
Void))))))))))
- (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "info")
- (#Cons (#TextA "source")
- (#Cons (#TextA "cursor")
- (#Cons (#TextA "modules")
- (#Cons (#TextA "scopes")
- (#Cons (#TextA "type-context")
- (#Cons (#TextA "expected")
- (#Cons (#TextA "seed")
- (#Cons (#TextA "scope-type-vars")
- (#Cons (#TextA "host")
- #Nil)))))))))))]
- (#Cons [["lux" "doc"] (#TextA "Represents the state of the Lux compiler during a run.
-
- It is provided to macros during their invocation, so they can access compiler data.
-
- Caveat emptor: Avoid fiddling with it, unless you know what you're doing.")]
- default-def-meta-exported)))
+ (record$ (#Cons [(tag$ ["lux" "tags"])
+ (tuple$ (#Cons (text$ "info")
+ (#Cons (text$ "source")
+ (#Cons (text$ "cursor")
+ (#Cons (text$ "modules")
+ (#Cons (text$ "scopes")
+ (#Cons (text$ "type-context")
+ (#Cons (text$ "expected")
+ (#Cons (text$ "seed")
+ (#Cons (text$ "scope-type-vars")
+ (#Cons (text$ "host")
+ #Nil)))))))))))]
+ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "Represents the state of the Lux compiler during a run.
+
+ It is provided to macros during their invocation, so they can access compiler data.
+
+ Caveat emptor: Avoid fiddling with it, unless you know what you're doing.")]
+ default-def-meta-exported))))
## (type: (Lux a)
## (-> Compiler (Either Text [Compiler a])))
@@ -660,34 +767,24 @@
(#Function Compiler
(#Apply (#Product Compiler (#Bound +1))
(#Apply Text Either)))))
- (#Cons [["lux" "doc"] (#TextA "Computations that can have access to the state of the compiler.
+ (record$ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "Computations that can have access to the state of the compiler.
- These computations may fail, or modify the state of the compiler.")]
- (#Cons [["lux" "type-args"] (#ListA (#Cons (#TextA "a") #;Nil))]
- default-def-meta-exported)))
+ These computations may fail, or modify the state of the compiler.")]
+ (#Cons [(tag$ ["lux" "type-args"])
+ (tuple$ (#Cons (text$ "a") #;Nil))]
+ default-def-meta-exported))))
## (type: Macro
## (-> (List Code) (Lux (List Code))))
(_lux_def Macro
(#Named ["lux" "Macro"]
(#Function Code-List (#Apply Code-List Lux)))
- (#Cons [["lux" "doc"] (#TextA "Functions that run at compile-time and allow you to transform and extend the language in powerful ways.")]
- default-def-meta-exported))
+ (record$ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "Functions that run at compile-time and allow you to transform and extend the language in powerful ways.")]
+ default-def-meta-exported)))
## Base functions & macros
-(_lux_def dummy-cursor
- (_lux_: Cursor ["" +0 +0])
- (#Cons [["lux" "export?"] (#BoolA true)]
- #Nil))
-
-(_lux_def _meta
- (_lux_: (#Function (#Apply (#Apply Cursor Meta)
- Code')
- Code)
- (_lux_function _ data
- [dummy-cursor data]))
- #Nil)
-
(_lux_def return
(_lux_: (#UnivQ #Nil
(#Function (#Bound +1)
@@ -698,7 +795,7 @@
(_lux_function _ val
(_lux_function _ state
(#Right state val))))
- #Nil)
+ (record$ #Nil))
(_lux_def fail
(_lux_: (#UnivQ #Nil
@@ -710,68 +807,14 @@
(_lux_function _ msg
(_lux_function _ state
(#Left msg))))
- #Nil)
-
-(_lux_def bool$
- (_lux_: (#Function Bool Code)
- (_lux_function _ value (_meta (#Bool value))))
- #Nil)
-
-(_lux_def nat$
- (_lux_: (#Function Nat Code)
- (_lux_function _ value (_meta (#Nat value))))
- #Nil)
-
-(_lux_def int$
- (_lux_: (#Function Int Code)
- (_lux_function _ value (_meta (#Int value))))
- #Nil)
-
-(_lux_def deg$
- (_lux_: (#Function Deg Code)
- (_lux_function _ value (_meta (#Deg value))))
- #Nil)
-
-(_lux_def frac$
- (_lux_: (#Function Frac Code)
- (_lux_function _ value (_meta (#Frac value))))
- #Nil)
-
-(_lux_def text$
- (_lux_: (#Function Text Code)
- (_lux_function _ text (_meta (#Text text))))
- #Nil)
-
-(_lux_def symbol$
- (_lux_: (#Function Ident Code)
- (_lux_function _ ident (_meta (#Symbol ident))))
- #Nil)
-
-(_lux_def tag$
- (_lux_: (#Function Ident Code)
- (_lux_function _ ident (_meta (#Tag ident))))
- #Nil)
-
-(_lux_def form$
- (_lux_: (#Function (#Apply Code List) Code)
- (_lux_function _ tokens (_meta (#Form tokens))))
- #Nil)
-
-(_lux_def tuple$
- (_lux_: (#Function (#Apply Code List) Code)
- (_lux_function _ tokens (_meta (#Tuple tokens))))
- #Nil)
-
-(_lux_def record$
- (_lux_: (#Function (#Apply (#Product Code Code) List) Code)
- (_lux_function _ tokens (_meta (#Record tokens))))
- #Nil)
+ (record$ #Nil))
(_lux_def default-macro-meta
- (_lux_: Anns
- (#Cons [["lux" "macro?"] (#BoolA true)]
+ (_lux_: (#Apply (#Product Code Code) List)
+ (#Cons [(tag$ ["lux" "macro?"])
+ (bool$ true)]
#Nil))
- #Nil)
+ (record$ #Nil))
(_lux_def let''
(_lux_: Macro
@@ -784,7 +827,7 @@
_
(fail "Wrong syntax for let''"))))
- default-macro-meta)
+ (record$ default-macro-meta))
(_lux_def function''
(_lux_: Macro
@@ -822,34 +865,44 @@
_
(fail "Wrong syntax for function''"))))
- default-macro-meta)
+ (record$ default-macro-meta))
+
+(_lux_def cursor-code
+ (_lux_: Code
+ (tuple$ (#Cons (text$ "") (#Cons (nat$ +0) (#Cons (nat$ +0) #Nil)))))
+ (record$ #Nil))
+
+(_lux_def meta-code
+ (_lux_: (#Function Ident (#Function Code Code))
+ (_lux_function _ tag
+ (_lux_function _ value
+ (tuple$ (#Cons cursor-code
+ (#Cons (form$ (#Cons (tag$ tag) (#Cons value #Nil)))
+ #Nil))))))
+ (record$ #Nil))
+
+(_lux_def flag-meta
+ (_lux_: (#Function Text Code)
+ (_lux_function _ tag
+ (tuple$ (#Cons [(meta-code ["lux" "Tag"] (tuple$ (#Cons (text$ "lux") (#Cons (text$ tag) #Nil))))
+ (#Cons [(meta-code ["lux" "Bool"] (bool$ true))
+ #Nil])]))))
+ (record$ #Nil))
(_lux_def export?-meta
(_lux_: Code
- (tuple$ (#Cons [(tuple$ (#Cons [(text$ "lux") (#Cons [(text$ "export?") #Nil])]))
- (#Cons [(form$ (#Cons [(tag$ ["lux" "BoolA"])
- (#Cons [(bool$ true)
- #Nil])]))
- #Nil])])))
- #Nil)
+ (flag-meta "export?"))
+ (record$ #Nil))
(_lux_def hidden?-meta
(_lux_: Code
- (tuple$ (#Cons [(tuple$ (#Cons [(text$ "lux") (#Cons [(text$ "hidden?") #Nil])]))
- (#Cons [(form$ (#Cons [(tag$ ["lux" "BoolA"])
- (#Cons [(bool$ true)
- #Nil])]))
- #Nil])])))
- #Nil)
+ (flag-meta "hidden?"))
+ (record$ #Nil))
(_lux_def macro?-meta
(_lux_: Code
- (tuple$ (#Cons [(tuple$ (#Cons [(text$ "lux") (#Cons [(text$ "macro?") #Nil])]))
- (#Cons [(form$ (#Cons [(tag$ ["lux" "BoolA"])
- (#Cons [(bool$ true)
- #Nil])]))
- #Nil])])))
- #Nil)
+ (flag-meta "macro?"))
+ (record$ #Nil))
(_lux_def with-export-meta
(_lux_: (#Function Code Code)
@@ -857,7 +910,7 @@
(form$ (#Cons (tag$ ["lux" "Cons"])
(#Cons export?-meta
(#Cons tail #Nil))))))
- #Nil)
+ (record$ #Nil))
(_lux_def with-hidden-meta
(_lux_: (#Function Code Code)
@@ -865,7 +918,7 @@
(form$ (#Cons (tag$ ["lux" "Cons"])
(#Cons hidden?-meta
(#Cons tail #Nil))))))
- #Nil)
+ (record$ #Nil))
(_lux_def with-macro-meta
(_lux_: (#Function Code Code)
@@ -873,7 +926,7 @@
(form$ (#Cons (tag$ ["lux" "Cons"])
(#Cons macro?-meta
(#Cons tail #Nil))))))
- #Nil)
+ (record$ #Nil))
(_lux_def def:''
(_lux_: Macro
@@ -891,7 +944,10 @@
(#Cons [(_meta (#Tuple args))
(#Cons [body #Nil])])])])))
#Nil])])])))
- (#Cons (with-export-meta meta) #Nil)])])])))
+ (#Cons (form$ (#Cons (symbol$ ["lux" "record$"])
+ (#Cons (with-export-meta meta)
+ #Nil)))
+ #Nil)])])])))
#Nil]))
(#Cons [[_ (#Tag ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])])
@@ -901,7 +957,10 @@
(#Cons [type
(#Cons [body
#Nil])])])))
- (#Cons (with-export-meta meta) #Nil)])])])))
+ (#Cons (form$ (#Cons (symbol$ ["lux" "record$"])
+ (#Cons (with-export-meta meta)
+ #Nil)))
+ #Nil)])])])))
#Nil]))
(#Cons [[_ (#Form (#Cons [name args]))]
@@ -915,7 +974,10 @@
(#Cons [(_meta (#Tuple args))
(#Cons [body #Nil])])])])))
#Nil])])])))
- (#Cons meta #Nil)])])])))
+ (#Cons (form$ (#Cons (symbol$ ["lux" "record$"])
+ (#Cons meta
+ #Nil)))
+ #Nil)])])])))
#Nil]))
(#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])
@@ -925,13 +987,16 @@
(#Cons [type
(#Cons [body
#Nil])])])))
- (#Cons meta #Nil)])])])))
+ (#Cons (form$ (#Cons (symbol$ ["lux" "record$"])
+ (#Cons meta
+ #Nil)))
+ #Nil)])])])))
#Nil]))
_
(fail "Wrong syntax for def''"))
))
- default-macro-meta)
+ (record$ default-macro-meta))
(def:'' (macro:' tokens)
default-macro-meta
@@ -973,9 +1038,10 @@
(fail "Wrong syntax for macro:'")))
(macro:' #export (comment tokens)
- (#Cons [["lux" "doc"] (#TextA "## 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)")]
+ (#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))
@@ -995,7 +1061,7 @@
(fail "Wrong syntax for $'")))
(def:'' (map f xs)
- #Nil
+ #;Nil
(#UnivQ #Nil
(#UnivQ #Nil
(#Function (#Function (#Bound +3) (#Bound +1))
@@ -1009,12 +1075,12 @@
(#Cons (f x) (map f xs'))))
(def:'' RepEnv
- #Nil
+ #;Nil
Type
($' List (#Product Text Code)))
(def:'' (make-env xs ys)
- #Nil
+ #;Nil
(#Function ($' List Text) (#Function ($' List Code) RepEnv))
(_lux_case [xs ys]
[(#Cons x xs') (#Cons y ys')]
@@ -1023,20 +1089,20 @@
_
#Nil))
-(def:'' (Text/= x y)
- #Nil
+(def:'' (text/= x y)
+ #;Nil
(#Function Text (#Function Text Bool))
(_lux_proc ["text" "="] [x y]))
(def:'' (get-rep key env)
- #Nil
+ #;Nil
(#Function Text (#Function RepEnv ($' Maybe Code)))
(_lux_case env
#Nil
#None
(#Cons [k v] env')
- (_lux_case (Text/= k key)
+ (_lux_case (text/= k key)
true
(#Some v)
@@ -1044,7 +1110,7 @@
(get-rep key env'))))
(def:'' (replace-syntax reps syntax)
- #Nil
+ #;Nil
(#Function RepEnv (#Function Code Code))
(_lux_case syntax
[_ (#Symbol "" name)]
@@ -1073,10 +1139,10 @@
syntax)
)
-(def:'' (update-bounds ast)
- #Nil
+(def:'' (update-bounds code)
+ #;Nil
(#Function Code Code)
- (_lux_case ast
+ (_lux_case code
[_ (#Tuple members)]
(tuple$ (map update-bounds members))
@@ -1094,10 +1160,10 @@
(form$ (map update-bounds members))
_
- ast))
+ code))
(def:'' (parse-quantified-args args next)
- #Nil
+ #;Nil
## (-> (List Code) (-> (List Text) (Lux (List Code))) (Lux (List Code)))
(#Function ($' List Code)
(#Function (#Function ($' List Text) (#Apply ($' List Code) Lux))
@@ -1115,12 +1181,12 @@
))
(def:'' (make-bound idx)
- #Nil
+ #;Nil
(#Function Nat Code)
(form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ idx) #Nil))))
(def:'' (fold f init xs)
- #Nil
+ #;Nil
## (All [a b] (-> (-> b a a) a (List b) a))
(#UnivQ #Nil (#UnivQ #Nil (#Function (#Function (#Bound +1)
(#Function (#Bound +3)
@@ -1136,20 +1202,21 @@
(fold f (f x init) xs')))
(def:'' (length list)
- #Nil
+ #;Nil
(#UnivQ #Nil
(#Function ($' List (#Bound +1)) Int))
(fold (function'' [_ acc] (_lux_proc ["int" "+"] [1 acc])) 0 list))
(macro:' #export (All tokens)
- (#Cons [["lux" "doc"] (#TextA "## Universal quantification.
- (All [a]
- (-> a a))
-
- ## A name can be provided, to specify a recursive type.
- (All List [a]
- (| Unit
- [a (List a)]))")]
+ (#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)
@@ -1169,7 +1236,7 @@
(update-bounds body')) #Nil))))))
body
names)
- (return (#Cons (_lux_case [(Text/= "" self-name) names]
+ (return (#Cons (_lux_case [(text/= "" self-name) names]
[true _]
body'
@@ -1191,16 +1258,17 @@
))
(macro:' #export (Ex tokens)
- (#Cons [["lux" "doc"] (#TextA "## 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))])")]
+ (#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)
@@ -1220,7 +1288,7 @@
(update-bounds body')) #Nil))))))
body
names)
- (return (#Cons (_lux_case [(Text/= "" self-name) names]
+ (return (#Cons (_lux_case [(text/= "" self-name) names]
[true _]
body'
@@ -1242,17 +1310,18 @@
))
(def:'' (reverse list)
- #Nil
+ #;Nil
(All [a] (#Function ($' List a) ($' List a)))
(fold (function'' [head tail] (#Cons head tail))
#Nil
list))
(macro:' #export (-> tokens)
- (#Cons [["lux" "doc"] (#TextA "## Function types:
- (-> Int Int Int)
+ (#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.")]
+ ## This is the type of a function that takes 2 Ints and returns an Int.")]
#;Nil)
(_lux_case (reverse tokens)
(#Cons output inputs)
@@ -1266,8 +1335,9 @@
(fail "Wrong syntax for ->")))
(macro:' #export (list xs)
- (#Cons [["lux" "doc"] (#TextA "## List-construction macro.
- (list 1 2 3)")]
+ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "## List-construction macro.
+ (list 1 2 3)")]
#;Nil)
(return (#Cons (fold (function'' [head tail]
(form$ (#Cons (tag$ ["lux" "Cons"])
@@ -1278,9 +1348,10 @@
#Nil)))
(macro:' #export (list& xs)
- (#Cons [["lux" "doc"] (#TextA "## 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))")]
+ (#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 (reverse xs)
(#Cons last init)
@@ -1294,11 +1365,12 @@
(fail "Wrong syntax for list&")))
(macro:' #export (& tokens)
- (#Cons [["lux" "doc"] (#TextA "## Tuple types:
- (& Text Int Bool)
+ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "## Tuple types:
+ (& Text Int Bool)
- ## The empty tuple, a.k.a. Unit.
- (&)")]
+ ## The empty tuple, a.k.a. Unit.
+ (&)")]
#;Nil)
(_lux_case (reverse tokens)
#Nil
@@ -1311,11 +1383,12 @@
))
(macro:' #export (| tokens)
- (#Cons [["lux" "doc"] (#TextA "## Variant types:
- (| Text Int Bool)
+ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "## Variant types:
+ (| Text Int Bool)
- ## The empty tuple, a.k.a. Void.
- (|)")]
+ ## The empty tuple, a.k.a. Void.
+ (|)")]
#;Nil)
(_lux_case (reverse tokens)
#Nil
@@ -1368,7 +1441,9 @@
name
(tuple$ args)
body))))
- (with-export-meta meta)))))
+ (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 (symbol$ ["" "_lux_def"])
@@ -1376,7 +1451,9 @@
(form$ (list (symbol$ ["" "_lux_:"])
type
body))
- (with-export-meta meta)))))
+ (form$ (#Cons (symbol$ ["lux" "record$"])
+ (#Cons (with-export-meta meta)
+ #Nil)))))))
(#Cons [[_ (#Form (#Cons [name args]))]
(#Cons [meta (#Cons [type (#Cons [body #Nil])])])])
@@ -1388,20 +1465,24 @@
name
(tuple$ args)
body))))
- meta))))
+ (form$ (#Cons (symbol$ ["lux" "record$"])
+ (#Cons meta
+ #Nil)))))))
(#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])
(return (list (form$ (list (symbol$ ["" "_lux_def"])
name
(form$ (list (symbol$ ["" "_lux_:"]) type body))
- meta))))
+ (form$ (#Cons (symbol$ ["lux" "record$"])
+ (#Cons meta
+ #Nil)))))))
_
(fail "Wrong syntax for def'''")
))
(def:''' (as-pairs xs)
- #Nil
+ #;Nil
(All [a] (-> ($' List a) ($' List (& a a))))
(_lux_case xs
(#Cons x (#Cons y xs'))
@@ -1426,7 +1507,7 @@
(fail "Wrong syntax for let'")))
(def:''' (any? p xs)
- #Nil
+ #;Nil
(All [a]
(-> (-> a Bool) ($' List a) Bool))
(_lux_case xs
@@ -1439,7 +1520,7 @@
false (any? p xs'))))
(def:''' (spliced? token)
- #Nil
+ #;Nil
(-> Code Bool)
(_lux_case token
[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [_ #Nil])]))]
@@ -1449,13 +1530,13 @@
false))
(def:''' (wrap-meta content)
- #Nil
+ #;Nil
(-> Code Code)
(tuple$ (list (tuple$ (list (text$ "") (nat$ +0) (nat$ +0)))
content)))
(def:''' (untemplate-list tokens)
- #Nil
+ #;Nil
(-> ($' List Code) Code)
(_lux_case tokens
#Nil
@@ -1464,18 +1545,19 @@
(#Cons [token tokens'])
(_meta (#Form (list (_meta (#Tag ["lux" "Cons"])) token (untemplate-list tokens'))))))
-(def:''' (List/compose xs ys)
- #Nil
+(def:''' (list/compose xs ys)
+ #;Nil
(All [a] (-> ($' List a) ($' List a) ($' List a)))
(_lux_case xs
(#Cons x xs')
- (#Cons x (List/compose xs' ys))
+ (#Cons x (list/compose xs' ys))
#Nil
ys))
(def:''' #export (splice-helper xs ys)
- (#Cons [["lux" "hidden?"] (#BoolA true)]
+ (#Cons [(tag$ ["lux" "hidden?"])
+ (bool$ true)]
#;Nil)
(-> ($' List Code) ($' List Code) ($' List Code))
(_lux_case xs
@@ -1490,17 +1572,18 @@
(-> Code Code Code Code)
(_lux_case op
[_ (#Form parts)]
- (form$ (List/compose parts (list a1 a2)))
+ (form$ (list/compose parts (list a1 a2)))
_
(form$ (list op a1 a2))))
(macro:' #export (_$ tokens)
- (#Cons [["lux" "doc"] (#TextA "## Left-association for the application of binary functions over variadic arguments.
- (_$ Text/compose \"Hello, \" name \".\\nHow are you?\")
+ (#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?\")")]
+ ## =>
+ (text/compose (text/compose \"Hello, \" name) \".\\nHow are you?\")")]
#;Nil)
(_lux_case tokens
(#Cons op tokens')
@@ -1515,11 +1598,12 @@
(fail "Wrong syntax for _$")))
(macro:' #export ($_ tokens)
- (#Cons [["lux" "doc"] (#TextA "## Right-association for the application of binary functions over variadic arguments.
- ($_ Text/compose \"Hello, \" name \".\\nHow are you?\")
+ (#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?\"))")]
+ ## =>
+ (text/compose \"Hello, \" (text/compose name \".\\nHow are you?\"))")]
#;Nil)
(_lux_case tokens
(#Cons op tokens')
@@ -1539,7 +1623,8 @@
## (: (All [a b] (-> (-> a (m b)) (m a) (m b)))
## bind))
(def:''' Monad
- (list& [["lux" "tags"] (#ListA (list (#TextA "wrap") (#TextA "bind")))]
+ (list& [(tag$ ["lux" "tags"])
+ (tuple$ (list (text$ "wrap") (text$ "bind")))]
default-def-meta-unexported)
Type
(#Named ["lux" "Monad"]
@@ -1627,13 +1712,14 @@
)))
(macro:' #export (if tokens)
- (list [["lux" "doc"] (#TextA "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!\"")])
+ => \"Oh, yeah!\"")])
(_lux_case tokens
(#Cons test (#Cons then (#Cons else #Nil)))
(return (list (form$ (list (symbol$ ["" "_lux_case"]) test
@@ -1649,7 +1735,7 @@
(-> Text ($' List (& Text a)) ($' Maybe a)))
(_lux_case plist
(#Cons [[k' v] plist'])
- (if (Text/= k k')
+ (if (text/= k k')
(#Some v)
(get k plist'))
@@ -1665,45 +1751,56 @@
(list [k v])
(#Cons [[k' v'] dict'])
- (if (Text/= k k')
+ (if (text/= k k')
(#Cons [[k' v] dict'])
(#Cons [[k' v'] (put k v dict')]))))
(def:''' #export (log! message)
- (list [["lux" "doc"] (#TextA "Logs message to standard output.
+ (list [(tag$ ["lux" "doc"])
+ (text$ "Logs message to standard output.
- Useful for debugging.")])
+ Useful for debugging.")])
(-> Text Unit)
(_lux_proc ["io" "log"] [message]))
-(def:''' (Text/compose x y)
+(def:''' (text/compose x y)
#Nil
(-> Text Text Text)
(_lux_proc ["text" "append"] [x y]))
-(def:''' (Ident/encode ident)
+(def:''' (ident/encode ident)
#Nil
(-> Ident Text)
(let' [[module name] ident]
(_lux_case module
"" name
- _ ($_ Text/compose module ";" name))))
+ _ ($_ text/compose module ";" name))))
(def:''' (get-meta tag def-meta)
#Nil
- (-> Ident Anns ($' Maybe Ann-Value))
+ (-> Ident Code ($' Maybe Code))
(let' [[prefix name] tag]
(_lux_case def-meta
- (#Cons [[prefix' name'] value] def-meta')
- (_lux_case [(Text/= prefix prefix')
- (Text/= name name')]
- [true true]
- (#Some value)
+ [_ (#Record def-meta)]
+ (_lux_case def-meta
+ (#Cons [key value] def-meta')
+ (_lux_case key
+ [_ (#Tag [prefix' name'])]
+ (_lux_case [(text/= prefix prefix')
+ (text/= name name')]
+ [true true]
+ (#Some value)
- _
- (get-meta tag def-meta'))
+ _
+ (get-meta tag (record$ def-meta')))
- #Nil
+ _
+ (get-meta tag (record$ def-meta')))
+
+ #Nil
+ #None)
+
+ _
#None)))
(def:''' (resolve-global-symbol ident state)
@@ -1715,21 +1812,21 @@
#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-anns _ #module-state _})
+ (#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 (#IdentA real-name))
+ (#Some [_ (#Symbol real-name)])
(#Right [state real-name])
_
(#Right [state ident]))
#None
- (#Left ($_ Text/compose "Unknown definition: " (Ident/encode ident))))
+ (#Left ($_ text/compose "Unknown definition: " (ident/encode ident))))
#None
- (#Left ($_ Text/compose "Unknown module: " module " @ " (Ident/encode ident))))))
+ (#Left ($_ text/compose "Unknown module: " module " @ " (ident/encode ident))))))
(def:''' (splice replace? untemplate tag elems)
#Nil
@@ -1806,7 +1903,7 @@
(do Monad<Lux>
[real-name (_lux_case module
""
- (if (Text/= "" subst)
+ (if (text/= "" subst)
(wrap [module name])
(resolve-global-symbol [subst name]))
@@ -1848,10 +1945,11 @@
))
(macro:' #export (host tokens)
- (list [["lux" "doc"] (#TextA "## Macro to treat host-types as Lux-types.
- (host java.lang.Object)
+ (list [(tag$ ["lux" "doc"])
+ (text$ "## Macro to treat host-types as Lux-types.
+ (host java.lang.Object)
- (host java.util.List [java.lang.Long])")])
+ (host java.util.List [java.lang.Long])")])
(_lux_case tokens
(#Cons [_ (#Symbol "" class-name)] #Nil)
(return (list (form$ (list (tag$ ["lux" "Host"]) (text$ class-name) (tag$ ["lux" "Nil"])))))
@@ -1879,11 +1977,12 @@
)))
(macro:' #export (` tokens)
- (list [["lux" "doc"] (#TextA "## 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))))")])
+ (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<Lux>
@@ -1895,10 +1994,11 @@
(fail "Wrong syntax for `")))
(macro:' #export (`' tokens)
- (list [["lux" "doc"] (#TextA "## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms.
- (`' (def: (~ name)
- (function [(~@ args)]
- (~ body))))")])
+ (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<Lux>
@@ -1909,8 +2009,9 @@
(fail "Wrong syntax for `")))
(macro:' #export (' tokens)
- (list [["lux" "doc"] (#TextA "## Quotation as a macro.
- (' \"YOLO\")")])
+ (list [(tag$ ["lux" "doc"])
+ (text$ "## Quotation as a macro.
+ (' \"YOLO\")")])
(_lux_case tokens
(#Cons template #Nil)
(do Monad<Lux>
@@ -1921,23 +2022,24 @@
(fail "Wrong syntax for '")))
(macro:' #export (|> tokens)
- (list [["lux" "doc"] (#TextA "## Piping macro.
- (|> elems (map Int/encode) (interpose \" \") (fold Text/compose \"\"))
-
- ## =>
- (fold Text/compose \"\"
- (interpose \" \"
- (map Int/encode elems)))")])
+ (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 (fold (_lux_: (-> Code Code Code)
(function' [app acc]
(_lux_case app
[_ (#Tuple parts)]
- (tuple$ (List/compose parts (list acc)))
+ (tuple$ (list/compose parts (list acc)))
[_ (#Form parts)]
- (form$ (List/compose parts (list acc)))
+ (form$ (list/compose parts (list acc)))
_
(` ((~ app) (~ acc))))))
@@ -1948,23 +2050,24 @@
(fail "Wrong syntax for |>")))
(macro:' #export (<| tokens)
- (list [["lux" "doc"] (#TextA "## Reverse piping macro.
- (<| (fold Text/compose \"\") (interpose \" \") (map Int/encode) elems)
-
- ## =>
- (fold Text/compose \"\"
- (interpose \" \"
- (map Int/encode elems)))")])
+ (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 (reverse tokens)
(#Cons [init apps])
(return (list (fold (_lux_: (-> Code Code Code)
(function' [app acc]
(_lux_case app
[_ (#Tuple parts)]
- (tuple$ (List/compose parts (list acc)))
+ (tuple$ (list/compose parts (list acc)))
[_ (#Form parts)]
- (form$ (List/compose parts (list acc)))
+ (form$ (list/compose parts (list acc)))
_
(` ((~ app) (~ acc))))))
@@ -1975,7 +2078,8 @@
(fail "Wrong syntax for <|")))
(def:''' #export (. f g)
- (list [["lux" "doc"] (#TextA "Function composition.")])
+ (list [(tag$ ["lux" "doc"])
+ (text$ "Function composition.")])
(All [a b c]
(-> (-> b c) (-> a b) (-> a c)))
(function' [x] (f (g x))))
@@ -2057,7 +2161,7 @@
#Nil
(#Cons [x xs'])
- (List/compose (f x) (join-map f xs'))))
+ (list/compose (f x) (join-map f xs'))))
(def:''' (every? p xs)
#Nil
@@ -2066,14 +2170,15 @@
(fold (function' [_2 _1] (if _1 (p _2) false)) true xs))
(macro:' #export (do-template tokens)
- (list [["lux" "doc"] (#TextA "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary.
- (do-template [<name> <diff>]
- [(def: #export <name>
- (-> Int Int)
- (i.+ <diff>))]
-
- [i.inc 1]
- [i.dec -1])")])
+ (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 [(mapM Monad<Maybe> get-name bindings)
@@ -2098,29 +2203,29 @@
(do-template [<type> <category> <=-name> <lt-name> <lte-name> <gt-name> <gte-name>
<eq-doc> <<-doc> <<=-doc> <>-doc> <>=-doc>]
[(def:''' #export (<=-name> test subject)
- (list [["lux" "doc"] (#TextA <eq-doc>)])
+ (list [(tag$ ["lux" "doc"]) (text$ <eq-doc>)])
(-> <type> <type> Bool)
(_lux_proc [<category> "="] [subject test]))
(def:''' #export (<lt-name> test subject)
- (list [["lux" "doc"] (#TextA <<-doc>)])
+ (list [(tag$ ["lux" "doc"]) (text$ <<-doc>)])
(-> <type> <type> Bool)
(_lux_proc [<category> "<"] [subject test]))
(def:''' #export (<lte-name> test subject)
- (list [["lux" "doc"] (#TextA <<=-doc>)])
+ (list [(tag$ ["lux" "doc"]) (text$ <<=-doc>)])
(-> <type> <type> Bool)
(if (_lux_proc [<category> "<"] [subject test])
true
(_lux_proc [<category> "="] [subject test])))
(def:''' #export (<gt-name> test subject)
- (list [["lux" "doc"] (#TextA <>-doc>)])
+ (list [(tag$ ["lux" "doc"]) (text$ <>-doc>)])
(-> <type> <type> Bool)
(_lux_proc [<category> "<"] [test subject]))
(def:''' #export (<gte-name> test subject)
- (list [["lux" "doc"] (#TextA <>=-doc>)])
+ (list [(tag$ ["lux" "doc"]) (text$ <>=-doc>)])
(-> <type> <type> Bool)
(if (_lux_proc [<category> "<"] [test subject])
true
@@ -2141,7 +2246,7 @@
(do-template [<type> <name> <op> <doc>]
[(def:''' #export (<name> param subject)
- (list [["lux" "doc"] (#TextA <doc>)])
+ (list [(tag$ ["lux" "doc"]) (text$ <doc>)])
(-> <type> <type> <type>)
(_lux_proc <op> [subject param]))]
@@ -2172,7 +2277,7 @@
(do-template [<type> <name> <op> <doc>]
[(def:''' #export (<name> param subject)
- (list [["lux" "doc"] (#TextA <doc>)])
+ (list [(tag$ ["lux" "doc"]) (text$ <doc>)])
(-> Nat <type> <type>)
(_lux_proc <op> [subject param]))]
@@ -2182,7 +2287,7 @@
(do-template [<name> <type> <test> <doc>]
[(def:''' #export (<name> left right)
- (list [["lux" "doc"] (#TextA <doc>)])
+ (list [(tag$ ["lux" "doc"]) (text$ <doc>)])
(-> <type> <type> <type>)
(if (<test> right left)
left
@@ -2201,7 +2306,7 @@
[f.max Frac f.> "Frac minimum."]
)
-(def:''' (Bool/encode x)
+(def:''' (bool/encode x)
#Nil
(-> Bool Text)
(if x "true" "false"))
@@ -2216,7 +2321,7 @@
+7 "7" +8 "8" +9 "9"
_ (_lux_proc ["io" "error"] ["undefined"])))
-(def:''' (Nat/encode value)
+(def:''' (nat/encode value)
#Nil
(-> Nat Text)
(_lux_case value
@@ -2233,14 +2338,14 @@
output])))))]
(loop value ""))))
-(def:''' (Int/abs value)
+(def:''' (int/abs value)
#Nil
(-> Int Int)
(if (i.< 0 value)
(i.* -1 value)
value))
-(def:''' (Int/encode value)
+(def:''' (int/encode value)
#Nil
(-> Int Text)
(if (i.= 0 value)
@@ -2255,10 +2360,10 @@
(recur (i./ 10 input)
(_lux_proc ["text" "append"] [(|> input (i.% 10) (_lux_:! Nat) digit-to-text)
output])))))
- (|> value (i./ 10) Int/abs)
- (|> value (i.% 10) Int/abs (_lux_:! Nat) digit-to-text)))))
+ (|> value (i./ 10) int/abs)
+ (|> value (i.% 10) int/abs (_lux_:! Nat) digit-to-text)))))
-(def:''' (Frac/encode x)
+(def:''' (frac/encode x)
#Nil
(-> Frac Text)
(_lux_proc ["frac" "encode"] [x]))
@@ -2269,11 +2374,12 @@
(i.= 0 (i.% div n)))
(def:''' #export (not x)
- (list [["lux" "doc"] (#TextA "## Boolean negation.
+ (list [(tag$ ["lux" "doc"])
+ (text$ "## Boolean negation.
- (not true) == false
+ (not true) => false
- (not false) == true")])
+ (not false) => true")])
(-> Bool Bool)
(if x false true))
@@ -2284,23 +2390,23 @@
($' Maybe Macro))
(do Monad<Maybe>
[$module (get module modules)
- gdef (let' [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-anns _ #module-state _} (_lux_: Module $module)]
+ gdef (let' [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-annotations _ #module-state _} (_lux_: Module $module)]
(get name bindings))]
(let' [[def-type def-meta def-value] (_lux_: Def gdef)]
(_lux_case (get-meta ["lux" "macro?"] def-meta)
- (#Some (#BoolA true))
+ (#Some [_ (#Bool true)])
(_lux_case (get-meta ["lux" "export?"] def-meta)
- (#Some (#BoolA true))
+ (#Some [_ (#Bool true)])
(#Some (_lux_:! Macro def-value))
_
- (if (Text/= module current-module)
+ (if (text/= module current-module)
(#Some (_lux_:! Macro def-value))
#None))
_
(_lux_case (get-meta ["lux" "alias"] def-meta)
- (#Some (#IdentA [r-module r-name]))
+ (#Some [_ (#Symbol [r-module r-name])])
(find-macro' modules current-module r-module r-name)
_
@@ -2345,11 +2451,11 @@
(#Some _) true
#None false))))
-(def:''' (List/join xs)
+(def:''' (list/join xs)
#Nil
(All [a]
(-> ($' List ($' List a)) ($' List a)))
- (fold List/compose #Nil (reverse xs)))
+ (fold list/compose #Nil (reverse xs)))
(def:''' (interpose sep xs)
#Nil
@@ -2396,7 +2502,7 @@
(do Monad<Lux>
[expansion (macro args)
expansion' (mapM Monad<Lux> macro-expand expansion)]
- (wrap (List/join expansion')))
+ (wrap (list/join expansion')))
#None
(return (list token))))
@@ -2417,22 +2523,22 @@
(do Monad<Lux>
[expansion (macro args)
expansion' (mapM Monad<Lux> macro-expand-all expansion)]
- (wrap (List/join expansion')))
+ (wrap (list/join expansion')))
#None
(do Monad<Lux>
[args' (mapM Monad<Lux> macro-expand-all args)]
- (wrap (list (form$ (#Cons (symbol$ macro-name) (List/join args'))))))))
+ (wrap (list (form$ (#Cons (symbol$ macro-name) (list/join args'))))))))
[_ (#Form members)]
(do Monad<Lux>
[members' (mapM Monad<Lux> macro-expand-all members)]
- (wrap (list (form$ (List/join members')))))
+ (wrap (list (form$ (list/join members')))))
[_ (#Tuple members)]
(do Monad<Lux>
[members' (mapM Monad<Lux> macro-expand-all members)]
- (wrap (list (tuple$ (List/join members')))))
+ (wrap (list (tuple$ (list/join members')))))
[_ (#Record pairs)]
(do Monad<Lux>
@@ -2473,8 +2579,9 @@
type))
(macro:' #export (type tokens)
- (list [["lux" "doc"] (#TextA "## Takes a type expression and returns it's representation as data-structure.
- (type (All [a] (Maybe (List a))))")])
+ (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<Lux>
@@ -2490,8 +2597,9 @@
(fail "Wrong syntax for type")))
(macro:' #export (: tokens)
- (list [["lux" "doc"] (#TextA "## The type-annotation macro.
- (: (List Int) (list 1 2 3))")])
+ (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_: (type (~ type)) (~ value)))))
@@ -2500,8 +2608,9 @@
(fail "Wrong syntax for :")))
(macro:' #export (:! tokens)
- (list [["lux" "doc"] (#TextA "## The type-coercion macro.
- (:! Dinosaur (list 1 2 3))")])
+ (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_:! (type (~ type)) (~ value)))))
@@ -2525,10 +2634,10 @@
[first a x]
[second b y])
-(def:''' (unfold-type-def type-asts)
+(def:''' (unfold-type-def type-codes)
#Nil
(-> ($' List Code) ($' Lux (& Code ($' Maybe ($' List Text)))))
- (_lux_case type-asts
+ (_lux_case type-codes
(#Cons [_ (#Record pairs)] #;Nil)
(do Monad<Lux>
[members (mapM Monad<Lux>
@@ -2593,13 +2702,14 @@
#seed (n.+ +1 seed) #expected expected
#cursor cursor
#scope-type-vars scope-type-vars}
- (symbol$ ["" ($_ Text/compose "__gensym__" prefix (Nat/encode seed))]))))
+ (symbol$ ["" ($_ text/compose "__gensym__" prefix (nat/encode seed))]))))
(macro:' #export (Rec tokens)
- (list [["lux" "doc"] (#TextA "## 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)])")])
+ (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))))])
@@ -2610,12 +2720,13 @@
(fail "Wrong syntax for Rec")))
(macro:' #export (exec tokens)
- (list [["lux" "doc"] (#TextA "## Sequential execution of expressions (great for side-effects).
- (exec
- (log! \"#1\")
- (log! \"#2\")
- (log! \"#3\")
- \"YOLO\")")])
+ (list [(tag$ ["lux" "doc"])
+ (text$ "## Sequential execution of expressions (great for side-effects).
+ (exec
+ (log! \"#1\")
+ (log! \"#2\")
+ (log! \"#3\")
+ \"YOLO\")")])
(_lux_case (reverse tokens)
(#Cons value actions)
(let' [dummy (symbol$ ["" ""])]
@@ -2629,7 +2740,7 @@
(macro:' (def:' tokens)
(let' [[export? tokens'] (_lux_case tokens
- (#Cons [_ (#Tag "" "export")] tokens')
+ (#Cons [_ (#Tag ["" "export"])] tokens')
[true tokens']
_
@@ -2665,9 +2776,10 @@
#None
body')]
(return (list (` (;_lux_def (~ name) (~ body'')
- (~ (if export?
- (with-export-meta (tag$ ["lux" "Nil"]))
- (tag$ ["lux" "Nil"]))))))))
+ [(~ cursor-code)
+ (#;Record (~ (if export?
+ (with-export-meta (tag$ ["lux" "Nil"]))
+ (tag$ ["lux" "Nil"]))))])))))
#None
(fail "Wrong syntax for def'"))))
@@ -2677,57 +2789,57 @@
(let' [[left right] pair]
(list left right)))
-(def:' (ast-to-text ast)
+(def:' (code-to-text code)
(-> Code Text)
- (_lux_case ast
+ (_lux_case code
[_ (#Bool value)]
- (Bool/encode value)
+ (bool/encode value)
[_ (#Nat value)]
- (Nat/encode value)
+ (nat/encode value)
[_ (#Int value)]
- (Int/encode value)
+ (int/encode value)
[_ (#Deg value)]
(_lux_proc ["io" "error"] ["Undefined behavior."])
[_ (#Frac value)]
- (Frac/encode value)
+ (frac/encode value)
[_ (#Text value)]
- ($_ Text/compose "\"" value "\"")
+ ($_ text/compose "\"" value "\"")
[_ (#Symbol [prefix name])]
- (if (Text/= "" prefix)
+ (if (text/= "" prefix)
name
- ($_ Text/compose prefix ";" name))
+ ($_ text/compose prefix ";" name))
[_ (#Tag [prefix name])]
- (if (Text/= "" prefix)
- ($_ Text/compose "#" name)
- ($_ Text/compose "#" prefix ";" name))
+ (if (text/= "" prefix)
+ ($_ text/compose "#" name)
+ ($_ text/compose "#" prefix ";" name))
[_ (#Form xs)]
- ($_ Text/compose "(" (|> xs
- (map ast-to-text)
+ ($_ text/compose "(" (|> xs
+ (map code-to-text)
(interpose " ")
reverse
- (fold Text/compose "")) ")")
+ (fold text/compose "")) ")")
[_ (#Tuple xs)]
- ($_ Text/compose "[" (|> xs
- (map ast-to-text)
+ ($_ text/compose "[" (|> xs
+ (map code-to-text)
(interpose " ")
reverse
- (fold Text/compose "")) "]")
+ (fold text/compose "")) "]")
[_ (#Record kvs)]
- ($_ Text/compose "{" (|> kvs
- (map (function' [kv] (_lux_case kv [k v] ($_ Text/compose (ast-to-text k) " " (ast-to-text v)))))
+ ($_ text/compose "{" (|> kvs
+ (map (function' [kv] (_lux_case kv [k v] ($_ text/compose (code-to-text k) " " (code-to-text v)))))
(interpose " ")
reverse
- (fold Text/compose "")) "}")
+ (fold text/compose "")) "}")
))
(def:' (expander branches)
@@ -2757,21 +2869,22 @@
(do Monad<Lux> [] (wrap (list)))
_
- (fail ($_ Text/compose "\"lux;case\" expects an even number of tokens: " (|> branches
- (map ast-to-text)
+ (fail ($_ text/compose "\"lux;case\" expects an even number of tokens: " (|> branches
+ (map code-to-text)
(interpose " ")
reverse
- (fold Text/compose ""))))))
+ (fold text/compose ""))))))
(macro:' #export (case tokens)
- (list [["lux" "doc"] (#TextA "## 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)")])
+ _
+ #None)")])
(_lux_case tokens
(#Cons value branches)
(do Monad<Lux>
@@ -2782,14 +2895,15 @@
(fail "Wrong syntax for case")))
(macro:' #export (^ tokens)
- (list [["lux" "doc"] (#TextA "## 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)")])
+ _
+ #None)")])
(case tokens
(#Cons [_ (#Form (#Cons pattern #Nil))] (#Cons body branches))
(do Monad<Lux>
@@ -2805,25 +2919,26 @@
(fail "Wrong syntax for ^ macro")))
(macro:' #export (^or tokens)
- (list [["lux" "doc"] (#TextA "## 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))")])
+ (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
@@ -2833,14 +2948,14 @@
_
(let' [pairs (|> patterns
(map (function' [pattern] (list pattern body)))
- (List/join))]
- (return (List/compose pairs branches))))
+ (list/join))]
+ (return (list/compose pairs branches))))
_
(fail "Wrong syntax for ^or")))
-(def:' (symbol? ast)
+(def:' (symbol? code)
(-> Code Bool)
- (case ast
+ (case code
[_ (#Symbol _)]
true
@@ -2848,11 +2963,12 @@
false))
(macro:' #export (let tokens)
- (list [["lux" "doc"] (#TextA "## Creates local bindings.
- ## Can (optionally) use pattern-matching macros when binding.
- (let [x (foo bar)
- y (baz quux)]
- (op x y))")])
+ (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 (length bindings))
@@ -2872,13 +2988,14 @@
(fail "Wrong syntax for let")))
(macro:' #export (function tokens)
- (list [["lux" "doc"] (#TextA "## 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))")])
+ (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))
@@ -2907,77 +3024,56 @@
#None
(fail "Wrong syntax for function")))
-(def:' (process-def-meta-value ast)
- (-> Code (Lux Code))
- (case ast
+(def:' (process-def-meta-value code)
+ (-> Code Code)
+ (case code
[_ (#Bool value)]
- (return (form$ (list (tag$ ["lux" "BoolA"]) (bool$ value))))
+ (meta-code ["lux" "Bool"] (bool$ value))
[_ (#Nat value)]
- (return (form$ (list (tag$ ["lux" "NatA"]) (nat$ value))))
+ (meta-code ["lux" "Nat"] (nat$ value))
[_ (#Int value)]
- (return (form$ (list (tag$ ["lux" "IntA"]) (int$ value))))
+ (meta-code ["lux" "Int"] (int$ value))
[_ (#Deg value)]
- (return (form$ (list (tag$ ["lux" "DegA"]) (deg$ value))))
+ (meta-code ["lux" "Deg"] (deg$ value))
[_ (#Frac value)]
- (return (form$ (list (tag$ ["lux" "FracA"]) (frac$ value))))
+ (meta-code ["lux" "Frac"] (frac$ value))
[_ (#Text value)]
- (return (form$ (list (tag$ ["lux" "TextA"]) (text$ value))))
+ (meta-code ["lux" "Text"] (text$ value))
[_ (#Tag [prefix name])]
- (return (form$ (list (tag$ ["lux" "IdentA"]) (tuple$ (list (text$ prefix) (text$ name))))))
+ (meta-code ["lux" "Tag"] (` [(~ (text$ prefix)) (~ (text$ name))]))
(^or [_ (#Form _)] [_ (#Symbol _)])
- (return ast)
+ code
[_ (#Tuple xs)]
- (do Monad<Lux>
- [=xs (mapM Monad<Lux> process-def-meta-value xs)]
- (wrap (form$ (list (tag$ ["lux" "ListA"]) (untemplate-list =xs)))))
+ (|> xs
+ (map process-def-meta-value)
+ untemplate-list
+ (meta-code ["lux" "Tuple"]))
[_ (#Record kvs)]
- (do Monad<Lux>
- [=xs (mapM Monad<Lux>
- (: (-> [Code Code] (Lux Code))
- (function [[k v]]
- (case k
- [_ (#Text =k)]
- (do Monad<Lux>
- [=v (process-def-meta-value v)]
- (wrap (tuple$ (list (text$ =k) =v))))
-
- _
- (fail (Text/compose "Wrong syntax for DictA key: " (ast-to-text k))))))
- kvs)]
- (wrap (form$ (list (tag$ ["lux" "DictA"]) (untemplate-list =xs)))))
+ (|> 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 ast)
- (-> Code (Lux Code))
- (case ast
- [_ (#Record kvs)]
- (do Monad<Lux>
- [=kvs (mapM Monad<Lux>
- (: (-> [Code Code] (Lux Code))
- (function [[k v]]
- (case k
- [_ (#Tag [pk nk])]
- (do Monad<Lux>
- [=v (process-def-meta-value v)]
- (wrap (tuple$ (list (tuple$ (list (text$ pk) (text$ nk)))
- =v))))
-
- _
- (fail (Text/compose "Wrong syntax for Anns: " (ast-to-text ast))))))
- kvs)]
- (wrap (untemplate-list =kvs)))
-
- _
- (fail (Text/compose "Wrong syntax for Anns: " (ast-to-text ast)))))
+(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)))
(def:' (with-func-args args meta)
(-> (List Code) Code Code)
@@ -2986,17 +3082,16 @@
meta
_
- (` (#;Cons [["lux" "func-args"]
- (#;ListA (list (~@ (map (function [arg]
- (` (#;TextA (~ (text$ (ast-to-text arg))))))
- args))))]
+ (` (#;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 (#;ListA (list (~@ (map (function [arg]
- (` (#;TextA (~ (text$ (ast-to-text arg))))))
- args))))}))
+ (` {#;type-args [(~@ (map (function [arg] (text$ (code-to-text arg)))
+ args))]}))
(def:' Export-Level
Type
@@ -3030,41 +3125,42 @@
(list (' #hidden))))
(macro:' #export (def: tokens)
- (list [["lux" "doc"] (#TextA "## Defines global constants/functions.
- (def: (rejoin-pair pair)
- (-> [Code Code] (List Code))
- (let [[left right] pair]
- (list left right)))
-
- (def: branching-exponent
- Int
- 5)")])
+ (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 Code])
+ parts (: (Maybe [Code (List Code) (Maybe Code) Code (List [Code Code])])
(case tokens'
- (^ (list [_ (#Form (#Cons name args))] meta type body))
- (#Some [name args (#Some type) body meta])
+ (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta-kvs)] type body))
+ (#Some [name args (#Some type) body meta-kvs])
- (^ (list name meta type body))
- (#Some [name #Nil (#Some type) body meta])
+ (^ (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 (record$ meta-kvs)])
+ (#Some [name args #None body meta-kvs])
(^ (list name [_ (#Record meta-kvs)] body))
- (#Some [name #Nil #None body (record$ meta-kvs)])
+ (#Some [name #Nil #None body meta-kvs])
(^ (list [_ (#Form (#Cons name args))] type body))
- (#Some [name args (#Some type) body (' {})])
+ (#Some [name args (#Some type) body #Nil])
(^ (list name type body))
- (#Some [name #Nil (#Some type) body (' {})])
+ (#Some [name #Nil (#Some type) body #Nil])
(^ (list [_ (#Form (#Cons name args))] body))
- (#Some [name args #None body (' {})])
+ (#Some [name args #None body #Nil])
(^ (list name body))
- (#Some [name #Nil #None body (' {})])
+ (#Some [name #Nil #None body #Nil])
_
#None))]
@@ -3081,27 +3177,29 @@
(` (: (~ type) (~ body)))
#None
- body)]
- (do Monad<Lux>
- [=meta (process-def-meta meta)]
- (return (list (` (;_lux_def (~ name) (~ body) (~ (with-func-args args
- (case export?
- #;None
- =meta
-
- (#;Some (#;Left []))
- (with-export-meta =meta)
-
- (#;Some (#;Right []))
- (|> =meta
- with-export-meta
- with-hidden-meta)
- )))))))))
+ 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-ast-add addition meta)
+(def: (meta-code-add addition meta)
(-> [Code Code] Code Code)
(case [addition meta]
[[name value] [cursor (#;Record pairs)]]
@@ -3110,27 +3208,28 @@
_
meta))
-(def: (meta-ast-merge addition base)
+(def: (meta-code-merge addition base)
(-> Code Code Code)
(case addition
[cursor (#;Record pairs)]
- (fold meta-ast-add base pairs)
+ (fold meta-code-add base pairs)
_
base))
(macro:' #export (macro: tokens)
- (list [["lux" "doc"] (#TextA "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])
+ (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\")))")])
+ _
+ (fail \"Wrong syntax for ident-for\")))")])
(let [[exported? tokens] (export-level^ tokens)
name+args+meta+body?? (: (Maybe [Ident (List Code) Code Code])
(case tokens
@@ -3156,8 +3255,8 @@
_ (` ((~ name) (~@ args))))]
(return (list (` (;;def: (~@ (export-level exported?))
(~ def-sig)
- (~ (meta-ast-merge (` {#;macro? true})
- meta))
+ (~ (meta-code-merge (` {#;macro? true})
+ meta))
;;Macro
(~ body))))))
@@ -3211,15 +3310,15 @@
_
(fail "Signatures require typed members!"))))
- (List/join sigs')))
+ (list/join sigs')))
#let [[_module _name] name+
def-name (symbol$ name)
sig-type (record$ (map (: (-> [Text Code] [Code Code])
(function [[m-name m-type]]
[(tag$ ["" m-name]) m-type]))
members))
- sig-meta (meta-ast-merge (` {#;sig? true})
- meta)
+ sig-meta (meta-code-merge (` {#;sig? true})
+ meta)
usage (case args
#;Nil
def-name
@@ -3466,7 +3565,7 @@
(#Right state module)
_
- (#Left ($_ Text/compose "Unknown module: " name))))))
+ (#Left ($_ text/compose "Unknown module: " name))))))
(def: get-current-module
(Lux Module)
@@ -3478,13 +3577,13 @@
(-> Ident (Lux [Nat (List Ident) Bool Type]))
(do Monad<Lux>
[=module (find-module module)
- #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags-table #types types #module-anns _ #module-state _} =module]]
+ #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags-table #types types #module-annotations _ #module-state _} =module]]
(case (get name tags-table)
(#Some output)
(return output)
_
- (fail (Text/compose "Unknown tag: " (Ident/encode [module name]))))))
+ (fail (text/compose "Unknown tag: " (ident/encode [module name]))))))
(def: (resolve-type-tags type)
(-> Type (Lux (Maybe [(List Ident) (List Type)])))
@@ -3501,7 +3600,7 @@
(#Named [module name] unnamed)
(do Monad<Lux>
[=module (find-module module)
- #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-anns _ #module-state _} =module]]
+ #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-annotations _ #module-state _} =module]]
(case (get name types)
(#Some [tags exported? (#Named _ _type)])
(case (resolve-struct-type _type)
@@ -3557,16 +3656,16 @@
(wrap [tag value])
_
- (fail (Text/compose "Unknown structure member: " tag-name)))
+ (fail (text/compose "Unknown structure member: " tag-name)))
_
(fail "Invalid structure member."))))
- (List/join tokens'))]
+ (list/join tokens'))]
(wrap (list (record$ members)))))
-(def: (Text/join parts)
+(def: (text/join parts)
(-> (List Text) Text)
- (|> parts reverse (fold Text/compose "")))
+ (|> parts reverse (fold text/compose "")))
(macro: #export (struct: tokens)
{#;doc "## Definition of structures ala ML.
@@ -3616,7 +3715,7 @@
#;None))
sig-args))
(^ (#;Some params))
- (#;Some (symbol$ ["" ($_ Text/compose sig-name "<" (|> params (interpose ",") Text/join) ">")]))
+ (#;Some (symbol$ ["" ($_ text/compose sig-name "<" (|> params (interpose ",") text/join) ">")]))
_
#;None)
@@ -3635,8 +3734,8 @@
_
(` ((~ name) (~@ args))))]
(return (list (` (;;def: (~@ (export-level exported?)) (~ usage)
- (~ (meta-ast-merge (` {#;struct? true})
- meta))
+ (~ (meta-code-merge (` {#;struct? true})
+ meta))
(~ type)
(struct (~@ defs)))))))
@@ -3686,38 +3785,34 @@
(^ (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-ast1 type-asts))
- (#Some [name #Nil [meta-cursor (#;Record meta-parts)] (#;Cons type-ast1 type-asts)])
+ (^ (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-asts))
- (#Some [name #Nil (` {}) type-asts])
+ (^ (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-ast1 type-asts))
- (#Some [name args [meta-cursor (#;Record meta-parts)] (#;Cons type-ast1 type-asts)])
+ (^ (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-asts))
- (#Some [name args (` {}) type-asts])
+ (^ (list& [_ (#Form (#Cons [_ (#Symbol "" name)] args))] type-codes))
+ (#Some [name args (` {}) type-codes])
_
#None))]
(case parts
- (#Some name args meta type-asts)
+ (#Some name args meta type-codes)
(do Monad<Lux>
- [type+tags?? (unfold-type-def type-asts)
+ [type+tags?? (unfold-type-def type-codes)
module-name current-module-name]
(let [type-name (symbol$ ["" name])
[type tags??] type+tags??
type-meta (: Code
(case tags??
(#Some tags)
- (` {#;tags [(~@ (map (: (-> Text Code)
- (function' [tag]
- (form$ (list (tag$ ["lux" "TextA"])
- (text$ tag)))))
- tags))]
+ (` {#;tags [(~@ (map text$ tags))]
#;type? true})
_
@@ -3740,7 +3835,7 @@
(case type'
(#Some type'')
(return (list (` (;;def: (~@ (export-level exported?)) (~ type-name)
- (~ ($_ meta-ast-merge (with-type-args args)
+ (~ ($_ meta-code-merge (with-type-args args)
(if rec? (' {#;type-rec? true}) (' {}))
type-meta
meta))
@@ -3947,7 +4042,7 @@
#import-alias _alias
#import-refer {#refer-defs _referrals
#refer-open _openings}} importation]
- {#import-name ($_ Text/compose super-name "/" _name)
+ {#import-name ($_ text/compose super-name "/" _name)
#import-alias _alias
#import-refer {#refer-defs _referrals
#refer-open _openings}})))))
@@ -3962,19 +4057,19 @@
[current-module current-module-name]
(case (split-module module)
(^ (list& "." parts))
- (return (|> (list& current-module parts) (interpose "/") reverse (fold Text/compose "")))
+ (return (|> (list& current-module parts) (interpose "/") reverse (fold text/compose "")))
parts
- (let [[ups parts'] (split-with (Text/= "..") parts)
+ (let [[ups parts'] (split-with (text/= "..") parts)
num-ups (length ups)]
(if (i.= num-ups 0)
(return module)
(case (nth num-ups (split-module-contexts current-module))
#None
- (fail (Text/compose "Cannot clean module: " module))
+ (fail (text/compose "Cannot clean module: " module))
(#Some top-module)
- (return (|> (list& top-module parts') (interpose "/") reverse (fold Text/compose ""))))
+ (return (|> (list& top-module parts') (interpose "/") reverse (fold text/compose ""))))
)))
))
@@ -4037,9 +4132,9 @@
_
(do Monad<Lux>
[current-module current-module-name]
- (fail (Text/compose "Wrong syntax for import @ " current-module))))))
+ (fail (text/compose "Wrong syntax for import @ " current-module))))))
imports)]
- (wrap (List/join imports'))))
+ (wrap (list/join imports'))))
(def: (exported-defs module state)
(-> Text (Lux (List Text)))
@@ -4056,17 +4151,17 @@
(function [[name [def-type def-meta def-value]]]
(case [(get-meta ["lux" "export?"] def-meta)
(get-meta ["lux" "hidden?"] def-meta)]
- [(#Some (#BoolA true)) #;None]
+ [(#Some [_ (#Bool true)]) #;None]
(list name)
_
(list))))
- (let [{#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-anns _ #module-state _} =module]
+ (let [{#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-annotations _ #module-state _} =module]
defs))]
- (#Right state (List/join to-alias)))
+ (#Right state (list/join to-alias)))
#None
- (#Left ($_ Text/compose "Unknown module: " module)))
+ (#Left ($_ text/compose "Unknown module: " module)))
))
(def: (filter p xs)
@@ -4084,7 +4179,7 @@
(-> (List Text) Text Bool)
(let [output (fold (function [case prev]
(or prev
- (Text/= case name)))
+ (text/= case name)))
false
cases)]
output))
@@ -4112,7 +4207,7 @@
#captured {#counter _ #mappings closure}}
(try-both (find (: (-> [Text [Type Top]] (Maybe Type))
(function [[bname [type _]]]
- (if (Text/= name bname)
+ (if (text/= name bname)
(#Some type)
#None))))
(: (List [Text [Type Top]]) locals)
@@ -4130,7 +4225,7 @@
#None
#None
- (#Some {#defs defs #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-anns _ #module-state _})
+ (#Some {#defs defs #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-annotations _ #module-state _})
(case (get v-name defs)
#None
#None
@@ -4147,12 +4242,12 @@
#scope-type-vars scope-type-vars} state]
(case (get v-prefix modules)
#None
- (#Left (Text/compose "Unknown definition: " (Ident/encode name)))
+ (#Left (text/compose "Unknown definition: " (ident/encode name)))
- (#Some {#defs defs #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-anns _ #module-state _})
+ (#Some {#defs defs #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-annotations _ #module-state _})
(case (get v-name defs)
#None
- (#Left (Text/compose "Unknown definition: " (Ident/encode name)))
+ (#Left (text/compose "Unknown definition: " (ident/encode name)))
(#Some [def-type def-meta def-value])
(#Right [state [def-type def-value]])))))
@@ -4163,7 +4258,7 @@
[#let [[module name] ident]
current-module current-module-name]
(function [state]
- (if (Text/= "" module)
+ (if (text/= "" module)
(case (find-in-env name state)
(#Some struct-type)
(#Right state struct-type)
@@ -4174,13 +4269,13 @@
(#Right state struct-type)
_
- (#Left ($_ Text/compose "Unknown var: " (Ident/encode ident)))))
+ (#Left ($_ text/compose "Unknown var: " (ident/encode ident)))))
(case (find-def-type ident state)
(#Some struct-type)
(#Right state struct-type)
_
- (#Left ($_ Text/compose "Unknown var: " (Ident/encode ident)))))
+ (#Left ($_ text/compose "Unknown var: " (ident/encode ident)))))
)))
(def: (zip2 xs ys)
@@ -4206,7 +4301,7 @@
name
_
- ($_ Text/compose "(" name " " (|> params (map Type/show) (interpose " ") reverse (fold Text/compose "")) ")"))
+ ($_ text/compose "(" name " " (|> params (map Type/show) (interpose " ") reverse (fold text/compose "")) ")"))
#Void
"Void"
@@ -4215,38 +4310,38 @@
"Unit"
(#Sum _)
- ($_ Text/compose "(| " (|> (flatten-variant type) (map Type/show) (interpose " ") reverse (fold Text/compose "")) ")")
+ ($_ text/compose "(| " (|> (flatten-variant type) (map Type/show) (interpose " ") reverse (fold text/compose "")) ")")
(#Product _)
- ($_ Text/compose "[" (|> (flatten-tuple type) (map Type/show) (interpose " ") reverse (fold Text/compose "")) "]")
+ ($_ text/compose "[" (|> (flatten-tuple type) (map Type/show) (interpose " ") reverse (fold text/compose "")) "]")
(#Function _)
- ($_ Text/compose "(-> " (|> (flatten-lambda type) (map Type/show) (interpose " ") reverse (fold Text/compose "")) ")")
+ ($_ text/compose "(-> " (|> (flatten-lambda type) (map Type/show) (interpose " ") reverse (fold text/compose "")) ")")
(#Bound id)
- (Nat/encode id)
+ (nat/encode id)
(#Var id)
- ($_ Text/compose "⌈v:" (Nat/encode id) "⌋")
+ ($_ text/compose "⌈v:" (nat/encode id) "⌋")
(#Ex id)
- ($_ Text/compose "⟨e:" (Nat/encode id) "⟩")
+ ($_ text/compose "⟨e:" (nat/encode id) "⟩")
(#UnivQ env body)
- ($_ Text/compose "(All " (Type/show body) ")")
+ ($_ text/compose "(All " (Type/show body) ")")
(#ExQ env body)
- ($_ Text/compose "(Ex " (Type/show body) ")")
+ ($_ text/compose "(Ex " (Type/show body) ")")
(#Apply _)
(let [[func args] (flatten-app type)]
- ($_ Text/compose
+ ($_ text/compose
"(" (Type/show func) " "
- (|> args (map Type/show) (interpose " ") reverse (fold Text/compose ""))
+ (|> args (map Type/show) (interpose " ") reverse (fold text/compose ""))
")"))
(#Named [prefix name] _)
- ($_ Text/compose prefix ";" name)
+ ($_ text/compose prefix ";" name)
))
(def: (foldM Monad<m> f init inputs)
@@ -4271,7 +4366,7 @@
struct-evidence (resolve-type-tags init-type)]
(case struct-evidence
#;None
- (fail (Text/compose "Can only \"open\" structs: " (Type/show init-type)))
+ (fail (text/compose "Can only \"open\" structs: " (Type/show init-type)))
(#;Some tags&members)
(do Monad<Lux>
@@ -4279,7 +4374,7 @@
(function recur [source [tags members] target]
(let [pattern (record$ (map (function [[t-module t-name]]
[(tag$ [t-module t-name])
- (symbol$ ["" (Text/compose prefix t-name)])])
+ (symbol$ ["" (text/compose prefix t-name)])])
tags))]
(do Monad<Lux>
[enhanced-target (foldM Monad<Lux>
@@ -4288,7 +4383,7 @@
[m-structure (resolve-type-tags m-type)]
(case m-structure
(#;Some m-tags&members)
- (recur ["" (Text/compose prefix m-name)]
+ (recur ["" (text/compose prefix m-name)]
m-tags&members
enhanced-target)
@@ -4413,11 +4508,11 @@
(: (-> [Ident Type] (Lux (List Code)))
(function [[sname stype]] (open-field prefix sname source+ stype)))
(zip2 tags members))]
- (return (List/join decls')))
+ (return (list/join decls')))
_
- (return (list (` (;_lux_def (~ (symbol$ ["" (Text/compose prefix name)])) (~ source+)
- #Nil)))))))
+ (return (list (` (;_lux_def (~ (symbol$ ["" (text/compose prefix name)])) (~ source+)
+ [(~ cursor-code) (#;Record #Nil)])))))))
(macro: #export (open tokens)
{#;doc "## Opens a structure and generates a definition for each of its members (including nested members).
@@ -4447,34 +4542,34 @@
[decls' (mapM Monad<Lux> (: (-> [Ident Type] (Lux (List Code)))
(function [[sname stype]] (open-field prefix sname source stype)))
(zip2 tags members))]
- (return (List/join decls')))
+ (return (list/join decls')))
_
- (fail (Text/compose "Can only \"open\" structs: " (Type/show struct-type)))))
+ (fail (text/compose "Can only \"open\" structs: " (Type/show struct-type)))))
_
(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.
- (|>. (map Int/encode) (interpose \" \") (fold Text/compose \"\"))
+ (|>. (map int/encode) (interpose \" \") (fold text/compose \"\"))
## =>
(function [<arg>]
- (fold Text/compose \"\"
+ (fold text/compose \"\"
(interpose \" \"
- (map Int/encode <arg>))))"}
+ (map int/encode <arg>))))"}
(do Monad<Lux>
[g!arg (gensym "arg")]
(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.
- (<|. (fold Text/compose \"\") (interpose \" \") (map Int/encode))
+ (<|. (fold text/compose \"\") (interpose \" \") (map int/encode))
## =>
(function [<arg>]
- (fold Text/compose \"\"
+ (fold text/compose \"\"
(interpose \" \"
- (map Int/encode <arg>))))"}
+ (map int/encode <arg>))))"}
(do Monad<Lux>
[g!arg (gensym "arg")]
(return (list (` (function [(~ g!arg)] (<| (~@ tokens) (~ g!arg))))))))
@@ -4483,7 +4578,7 @@
(-> Text Text (Lux Bool))
(do Monad<Lux>
[module (find-module module-name)
- #let [{#module-hash _ #module-aliases _ #defs _ #imports imports #tags _ #types _ #module-anns _ #module-state _} module]]
+ #let [{#module-hash _ #module-aliases _ #defs _ #imports imports #tags _ #types _ #module-annotations _ #module-state _} module]]
(wrap (is-member? imports import-name))))
(def: (read-refer module-name options)
@@ -4501,7 +4596,7 @@
(function [_def]
(if (is-member? all-defs _def)
(return [])
- (fail ($_ Text/compose _def " is not defined in module " module-name " @ " current-module)))))
+ (fail ($_ text/compose _def " is not defined in module " module-name " @ " current-module)))))
referred-defs)))]]
(case options
#;Nil
@@ -4509,11 +4604,11 @@
#refer-open openings})
_
- (fail ($_ Text/compose "Wrong syntax for refer @ " current-module
+ (fail ($_ text/compose "Wrong syntax for refer @ " current-module
"\n" (|> options
- (map ast-to-text)
+ (map code-to-text)
(interpose " ")
- (fold Text/compose "")))))))
+ (fold text/compose "")))))))
(def: (write-refer module-name [r-defs r-opens])
(-> Text Refer (Lux (List Code)))
@@ -4526,7 +4621,7 @@
(function [_def]
(if (is-member? all-defs _def)
(return [])
- (fail ($_ Text/compose _def " is not defined in module " module-name " @ " current-module)))))
+ (fail ($_ text/compose _def " is not defined in module " module-name " @ " current-module)))))
referred-defs)))]
defs' (case r-defs
#All
@@ -4550,15 +4645,17 @@
(function [def]
(` (;_lux_def (~ (symbol$ ["" def]))
(~ (symbol$ [module-name def]))
- (#Cons [["lux" "alias"] (#IdentA [(~ (text$ module-name)) (~ (text$ def))])]
- #Nil)))))
+ [(~ cursor-code)
+ (#;Record (#Cons [[(~ cursor-code) (#;Tag ["lux" "alias"])]
+ [(~ cursor-code) (#;Symbol [(~ (text$ module-name)) (~ (text$ def))])]]
+ #Nil))]))))
defs')
openings (join-map (: (-> Openings (List Code))
(function [[prefix structs]]
(map (function [[_ name]] (` (open (~ (symbol$ [module-name name])) (~ (text$ prefix)))))
structs)))
r-opens)]]
- (wrap (List/compose defs openings))
+ (wrap (list/compose defs openings))
))
(macro: #hidden (refer tokens)
@@ -4571,7 +4668,7 @@
_
(fail "Wrong syntax for refer")))
-(def: (refer-to-ast module-name [r-defs r-opens])
+(def: (refer-to-code module-name [r-defs r-opens])
(-> Text Refer Code)
(let [=defs (: (List Code)
(case r-defs
@@ -4604,23 +4701,23 @@
(;module: {#;doc \"Some documentation...\"}
lux
(lux (control (monad #as M #refer #all))
- (data (text #open (\"Text/\" Monoid<Text>))
- (coll (list #open (\"List/\" Monad<List>)))
+ (data (text #open (\"text/\" Monoid<Text>))
+ (coll (list #open (\"list/\" Monad<List>)))
maybe
- (ident #open (\"Ident/\" Codec<Text,Ident>)))
+ (ident #open (\"ident/\" Codec<Text,Ident>)))
meta
- (macro ast))
+ (macro code))
(.. (type #open (\"\" Eq<Type>))))
(;module: {#;doc \"Some documentation...\"}
lux
(lux (control [\"M\" monad #*])
- (data [text \"Text/\" Monoid<Text>]
- (coll [list \"List/\" Monad<List>])
+ (data [text \"text/\" Monoid<Text>]
+ (coll [list \"list/\" Monad<List>])
maybe
- [ident \"Ident/\" Codec<Text,Ident>])
+ [ident \"ident/\" Codec<Text,Ident>])
meta
- (macro ast))
+ (macro code))
(.. [type \"\" Eq<Type>]))"}
(do Monad<Lux>
[#let [[_meta _imports] (: [(List [Code Code]) (List Code)]
@@ -4637,11 +4734,12 @@
imports)
=refers (map (: (-> Importation Code)
(function [[m-name m-alias =refer]]
- (refer-to-ast m-name =refer)))
- imports)]
- =meta (process-def-meta (record$ (list& [(` #;imports) (` [(~@ =imports)])]
- _meta)))
- #let [=module (` (;_lux_module (~ =meta)))]]
+ (refer-to-code m-name =refer)))
+ imports)
+ =meta (process-def-meta (list& [(` #;imports) (` [(~@ =imports)])]
+ _meta))
+ =module (` (;_lux_module [(~ cursor-code)
+ (#;Record (~ =meta))]))]]
(wrap (#;Cons =module =refers))))
(macro: #export (:: tokens)
@@ -4728,7 +4826,7 @@
(#;Cons (list new-binding old-record) accesses')]))
[record (: (List (List Code)) #;Nil)]
pairs)
- accesses (List/join (reverse accesses'))]]
+ accesses (list/join (reverse accesses'))]]
(wrap (list (` (let [(~@ accesses)]
(~ update-expr)))))))
@@ -4824,7 +4922,7 @@
(-> (List Type) Type Type)
(case type
(#;Host name params)
- (#;Host name (List/map (beta-reduce env) params))
+ (#;Host name (list/map (beta-reduce env) params))
(^template [<tag>]
(<tag> left right)
@@ -4870,7 +4968,7 @@
wrap))
#;None)))
(#Some output)
- (return (List/compose output branches))
+ (return (list/compose output branches))
#None
(fail "Wrong syntax for ^template"))
@@ -4887,9 +4985,9 @@
[int-to-frac Int Frac ["int" "to-frac"]]
)
-(def: (find-baseline-column ast)
+(def: (find-baseline-column code)
(-> Code Nat)
- (case ast
+ (case code
(^template [<tag>]
[[_ _ column] (<tag> _)]
column)
@@ -4910,7 +5008,7 @@
[[_ _ column] (#Record pairs)]
(fold n.min column
- (List/compose (map (. find-baseline-column first) pairs)
+ (list/compose (map (. find-baseline-column first) pairs)
(map (. find-baseline-column second) pairs)))
))
@@ -4918,16 +5016,16 @@
(#Doc-Comment Text)
(#Doc-Example Code))
-(def: (identify-doc-fragment ast)
+(def: (identify-doc-fragment code)
(-> Code Doc-Fragment)
- (case ast
+ (case code
[_ (#;Text comment)]
(#Doc-Comment comment)
_
- (#Doc-Example ast)))
+ (#Doc-Example code)))
-(def: (Text/encode original)
+(def: (text/encode original)
(-> Text Text)
(let [escaped (|> original
(replace-all "\t" "\\t")
@@ -4939,7 +5037,7 @@
(replace-all "\"" "\\\"")
(replace-all "\\" "\\\\")
)]
- ($_ Text/compose "\"" escaped "\"")))
+ ($_ text/compose "\"" escaped "\"")))
(do-template [<name> <op> <one> <type> <doc>]
[(def: #export (<name> value)
@@ -4953,9 +5051,9 @@
[n.dec n.- +1 Nat "[Nat] Decrement function."]
)
-(def: Tag/encode
+(def: tag/encode
(-> Ident Text)
- (. (Text/compose "#") Ident/encode))
+ (. (text/compose "#") ident/encode))
(do-template [<name> <op> <from> <to>]
[(def: #export (<name> input)
@@ -4977,22 +5075,22 @@
(def: (cursor-padding baseline [_ old-line old-column] [_ new-line new-column])
(-> Nat Cursor Cursor Text)
(if (n.= old-line new-line)
- (Text/join (repeat (nat-to-int (n.- old-column new-column)) " "))
- (let [extra-lines (Text/join (repeat (nat-to-int (n.- old-line new-line)) "\n"))
- space-padding (Text/join (repeat (nat-to-int (n.- baseline new-column)) " "))]
- (Text/compose extra-lines space-padding))))
+ (text/join (repeat (nat-to-int (n.- old-column new-column)) " "))
+ (let [extra-lines (text/join (repeat (nat-to-int (n.- old-line new-line)) "\n"))
+ space-padding (text/join (repeat (nat-to-int (n.- baseline new-column)) " "))]
+ (text/compose extra-lines space-padding))))
-(def: (Text/size x)
+(def: (text/size x)
(-> Text Nat)
(_lux_proc ["text" "size"] [x]))
-(def: (Text/trim x)
+(def: (text/trim x)
(-> Text Text)
(_lux_proc ["text" "trim"] [x]))
-(def: (update-cursor [file line column] ast-text)
+(def: (update-cursor [file line column] code-text)
(-> Cursor Text Cursor)
- [file line (n.+ column (Text/size ast-text))])
+ [file line (n.+ column (text/size code-text))])
(def: (delim-update-cursor [file line column])
(-> Cursor Cursor)
@@ -5000,7 +5098,7 @@
(def: rejoin-all-pairs
(-> (List [Code Code]) (List Code))
- (. List/join (map rejoin-pair)))
+ (. list/join (map rejoin-pair)))
(def: (doc-example->Text prev-cursor baseline example)
(-> Cursor Nat Code [Cursor Text])
@@ -5009,25 +5107,25 @@
[new-cursor (<tag> value)]
(let [as-text (<show> value)]
[(update-cursor new-cursor as-text)
- (Text/compose (cursor-padding baseline prev-cursor new-cursor)
+ (text/compose (cursor-padding baseline prev-cursor new-cursor)
as-text)]))
- ([#Bool Bool/encode]
- [#Nat Nat/encode]
- [#Int Int/encode]
- [#Frac Frac/encode]
- [#Text Text/encode]
- [#Symbol Ident/encode]
- [#Tag Tag/encode])
+ ([#Bool bool/encode]
+ [#Nat nat/encode]
+ [#Int int/encode]
+ [#Frac frac/encode]
+ [#Text text/encode]
+ [#Symbol ident/encode]
+ [#Tag tag/encode])
(^template [<tag> <open> <close> <prep>]
[group-cursor (<tag> parts)]
(let [[group-cursor' parts-text] (fold (function [part [last-cursor text-accum]]
(let [[part-cursor part-text] (doc-example->Text last-cursor baseline part)]
- [part-cursor (Text/compose text-accum part-text)]))
+ [part-cursor (text/compose text-accum part-text)]))
[(delim-update-cursor group-cursor) ""]
(<prep> parts))]
[(delim-update-cursor group-cursor')
- ($_ Text/compose (cursor-padding baseline prev-cursor group-cursor)
+ ($_ text/compose (cursor-padding baseline prev-cursor group-cursor)
<open>
parts-text
<close>)]))
@@ -5049,14 +5147,14 @@
(#Doc-Comment comment)
(|> comment
(split-text "\n")
- (map (function [line] ($_ Text/compose "## " line "\n")))
- Text/join)
+ (map (function [line] ($_ text/compose "## " line "\n")))
+ text/join)
(#Doc-Example example)
(let [baseline (find-baseline-column example)
[cursor _] example
[_ text] (doc-example->Text (with-baseline baseline cursor) baseline example)]
- (Text/compose text "\n\n"))))
+ (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.
@@ -5069,11 +5167,12 @@
(if (< 10 count)
(recur (i.inc count) (f x))
x)))"}
- (return (list (` (#;TextA (~ (|> tokens
+ (return (list (` [(~ cursor-code)
+ (#;Text (~ (|> tokens
(map (. doc-fragment->Text identify-doc-fragment))
- Text/join
- Text/trim
- text$)))))))
+ text/join
+ text/trim
+ text$)))]))))
(def: (interleave xs ys)
(All [a] (-> (List a) (List a) (List a)))
@@ -5089,11 +5188,11 @@
(#Cons y ys')
(list& x y (interleave xs' ys')))))
-(def: (type-to-ast type)
+(def: (type-to-code type)
(-> Type Code)
(case type
(#Host name params)
- (` (#Host (~ (text$ name)) (~ (untemplate-list (map type-to-ast params)))))
+ (` (#Host (~ (text$ name)) (~ (untemplate-list (map type-to-code params)))))
#Void
(` #Void)
@@ -5103,11 +5202,11 @@
(^template [<tag>]
(<tag> left right)
- (` (<tag> (~ (type-to-ast left)) (~ (type-to-ast right)))))
+ (` (<tag> (~ (type-to-code left)) (~ (type-to-code right)))))
([#Sum] [#Product])
(#Function in out)
- (` (#Function (~ (type-to-ast in)) (~ (type-to-ast out))))
+ (` (#Function (~ (type-to-code in)) (~ (type-to-code out))))
(#Bound idx)
(` (#Bound (~ (nat$ idx))))
@@ -5119,18 +5218,18 @@
(` (#Ex (~ (nat$ id))))
(#UnivQ env type)
- (let [env' (untemplate-list (map type-to-ast env))]
- (` (#UnivQ (~ env') (~ (type-to-ast type)))))
+ (let [env' (untemplate-list (map type-to-code env))]
+ (` (#UnivQ (~ env') (~ (type-to-code type)))))
(#ExQ env type)
- (let [env' (untemplate-list (map type-to-ast env))]
- (` (#ExQ (~ env') (~ (type-to-ast type)))))
+ (let [env' (untemplate-list (map type-to-code env))]
+ (` (#ExQ (~ env') (~ (type-to-code type)))))
(#Apply arg fun)
- (` (#Apply (~ (type-to-ast arg)) (~ (type-to-ast fun))))
+ (` (#Apply (~ (type-to-code arg)) (~ (type-to-code fun))))
(#Named [module name] type)
- (` (#Named [(~ (text$ module)) (~ (text$ name))] (~ (type-to-ast type))))
+ (` (#Named [(~ (text$ module)) (~ (text$ name))] (~ (type-to-code type))))
))
(macro: #export (loop tokens)
@@ -5154,8 +5253,8 @@
#None (fail "Wrong syntax for loop")))
init-types (mapM Monad<Lux> find-type inits')
expected get-expected-type]
- (return (list (` ((;_lux_: (-> (~@ (map type-to-ast init-types))
- (~ (type-to-ast expected)))
+ (return (list (` ((;_lux_: (-> (~@ (map type-to-code init-types))
+ (~ (type-to-code expected)))
(function (~ (symbol$ ["" "recur"])) [(~@ vars)]
(~ body)))
(~@ inits))))))
@@ -5218,8 +5317,8 @@
(#Some (list target))
[_ (#Symbol [prefix name])]
- (if (and (Text/= "" prefix)
- (Text/= label name))
+ (if (and (text/= "" prefix)
+ (text/= label name))
(#Some tokens)
(#Some (list target)))
@@ -5227,7 +5326,7 @@
[_ (<tag> elems)]
(do Monad<Maybe>
[placements (mapM Monad<Maybe> (place-tokens label tokens) elems)]
- (wrap (list (<ctor> (List/join placements))))))
+ (wrap (list (<ctor> (list/join placements))))))
([#Tuple tuple$]
[#Form form$])
@@ -5334,13 +5433,13 @@
["Text" Text text$])
_
- (fail (Text/compose "Cannot anti-quote type: " (Ident/encode name))))))
+ (fail (text/compose "Cannot anti-quote type: " (ident/encode name))))))
(def: (anti-quote token)
(-> Code (Lux Code))
(case token
[_ (#Symbol [def-prefix def-name])]
- (if (Text/= "" def-prefix)
+ (if (text/= "" def-prefix)
(:: Monad<Lux> return token)
(anti-quote-def [def-prefix def-name]))
@@ -5437,7 +5536,7 @@
"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')
_
@@ -5446,7 +5545,7 @@
"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')
_
@@ -5458,7 +5557,7 @@
expected get-expected-type
g!temp (gensym "temp")]
(let [output (list g!temp
- (` (;_lux_case (;_lux_: (#;Apply (~ (type-to-ast expected)) Maybe)
+ (` (;_lux_case (;_lux_: (#;Apply (~ (type-to-code expected)) Maybe)
(case (~ g!temp)
(~@ (multi-level-case$ g!temp [mlc body]))
@@ -5527,7 +5626,7 @@
"In the example below, +0 corresponds to the 'a' variable."
(def: #export (from-list list)
(All [a] (-> (List a) (Vector a)))
- (List/fold add
+ (list/fold add
(: (Vector ($ +0))
empty)
list)))}
@@ -5540,7 +5639,7 @@
(wrap (list (` (#Ex (~ (nat$ var-id))))))
#;None
- (fail (Text/compose "Indexed-type does not exist: " (Nat/encode idx)))))
+ (fail (text/compose "Indexed-type does not exist: " (nat/encode idx)))))
_
(fail "Wrong syntax for $")))
@@ -5559,7 +5658,7 @@
(macro: #export (^@ tokens)
{#;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))
+ (list/fold (function [elem acc] (n.+ (:: Hash<a> hash elem) acc))
+0
(to-list set))))}
(case tokens
@@ -5595,7 +5694,7 @@
(^ (list expr))
(do Monad<Lux>
[type get-expected-type]
- (wrap (list (` (;_lux_:! (~ (type-to-ast type)) (~ expr))))))
+ (wrap (list (` (;_lux_:! (~ (type-to-code type)) (~ expr))))))
_
(fail "Wrong syntax for :!!")))
@@ -5624,7 +5723,7 @@
(^ (list [_ (#;Symbol var-name)]))
(do Monad<Lux>
[var-type (find-type var-name)]
- (wrap (list (type-to-ast var-type))))
+ (wrap (list (type-to-code var-type))))
_
(fail "Wrong syntax for type-of")))
@@ -5739,7 +5838,7 @@
(list (` (~ (replace-syntax rep-env input-template))))])
(~ g!_)
- (#;Left (~ (text$ (Text/compose "Wrong syntax for " name))))
+ (#;Left (~ (text$ (text/compose "Wrong syntax for " name))))
)))))
))
diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux
index ac4db6606..7824446bd 100644
--- a/stdlib/source/lux/concurrency/actor.lux
+++ b/stdlib/source/lux/concurrency/actor.lux
@@ -154,7 +154,7 @@
(do Monad<Lux>
[name (macro;normalize name)
[_ annotations _] (macro;find-def name)]
- (case (macro;get-ident-ann (ident-for <tag>) annotations)
+ (case (macro;get-tag-ann (ident-for <tag>) annotations)
(#;Some actor-name)
(wrap actor-name)
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index 1cbf9e665..1f787b8e4 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -5,7 +5,7 @@
(lux (control [monad #+ do Monad]
[eq #+ Eq]
codec
- ["p" parser "p/" Monad<Parser>])
+ ["p" parser "parser/" Monad<Parser>])
(data [bool]
[text "text/" Eq<Text> Monoid<Text>]
(text ["l" lexer])
@@ -14,9 +14,9 @@
["R" result]
[sum]
[product]
- (coll [list "L/" Fold<List> Monad<List>]
- [vector #+ Vector vector "Vector/" Monad<Vector>]
- ["d" dict]))
+ (coll [list "list/" Fold<List> Monad<List>]
+ [vector #+ Vector vector "vector/" Monad<Vector>]
+ [dict #+ Dict]))
[macro #+ Monad<Lux> with-gensyms]
(macro ["s" syntax #+ syntax:]
[code]
@@ -39,13 +39,13 @@
(#Number Number)
(#String String)
(#Array (Vector JSON))
- (#Object (d;Dict String JSON)))
+ (#Object (Dict String JSON)))
(do-template [<name> <type>]
[(type: #export <name> <type>)]
[Array (Vector JSON)]
- [Object (d;Dict String JSON)]
+ [Object (Dict String JSON)]
)
(type: #export (Reader a)
@@ -75,7 +75,7 @@
(wrap (list (` (: JSON #Null))))
[_ (#;Tuple members)]
- (wrap (list (` (: JSON (#Array (vector (~@ (L/map wrapper members))))))))
+ (wrap (list (` (: JSON (#Array (vector (~@ (list/map wrapper members))))))))
[_ (#;Record pairs)]
(do Monad<Lux>
@@ -88,7 +88,7 @@
_
(macro;fail "Wrong syntax for JSON object.")))
pairs)]
- (wrap (list (` (: JSON (#Object (d;from-list text;Hash<Text> (list (~@ pairs')))))))))
+ (wrap (list (` (: JSON (#Object (dict;from-list text;Hash<Text> (list (~@ pairs')))))))))
_
(wrap (list token))
@@ -99,7 +99,7 @@
(-> JSON (R;Result (List String)))
(case json
(#Object obj)
- (#R;Success (d;keys obj))
+ (#R;Success (dict;keys obj))
_
(#R;Error ($_ text/compose "Cannot get the fields of a non-object."))))
@@ -109,7 +109,7 @@
(-> String JSON (R;Result JSON))
(case json
(#Object obj)
- (case (d;get key obj)
+ (case (dict;get key obj)
(#;Some value)
(#R;Success value)
@@ -124,14 +124,14 @@
(-> String JSON JSON (R;Result JSON))
(case json
(#Object obj)
- (#R;Success (#Object (d;put key value obj)))
+ (#R;Success (#Object (dict;put key value obj)))
_
(#R;Error ($_ text/compose "Cannot set field \"" key "\" of a non-object."))))
(do-template [<name> <tag> <type> <desc>]
[(def: #export (<name> key json)
- {#;doc (#;TextA ($_ text/compose "A JSON object field getter for " <desc> "."))}
+ {#;doc (code;text ($_ text/compose "A JSON object field getter for " <desc> "."))}
(-> Text JSON (R;Result <type>))
(case (get key json)
(#R;Success (<tag> value))
@@ -165,25 +165,25 @@
[(#Array xs) (#Array ys)]
(and (n.= (vector;size xs) (vector;size ys))
- (L/fold (function [idx prev]
- (and prev
- (maybe;default false
- (do maybe;Monad<Maybe>
- [x' (vector;nth idx xs)
- y' (vector;nth idx ys)]
- (wrap (= x' y'))))))
- true
- (list;indices (vector;size xs))))
+ (list/fold (function [idx prev]
+ (and prev
+ (maybe;default false
+ (do maybe;Monad<Maybe>
+ [x' (vector;nth idx xs)
+ y' (vector;nth idx ys)]
+ (wrap (= x' y'))))))
+ true
+ (list;indices (vector;size xs))))
[(#Object xs) (#Object ys)]
- (and (n.= (d;size xs) (d;size ys))
- (L/fold (function [[xk xv] prev]
- (and prev
- (case (d;get xk ys)
- #;None false
- (#;Some yv) (= xv yv))))
- true
- (d;entries xs)))
+ (and (n.= (dict;size xs) (dict;size ys))
+ (list/fold (function [[xk xv] prev]
+ (and prev
+ (case (dict;get xk ys)
+ #;None false
+ (#;Some yv) (= xv yv))))
+ true
+ (dict;entries xs)))
_
false)))
@@ -226,7 +226,7 @@
(do-template [<name> <type> <tag> <desc>]
[(def: #export <name>
- {#;doc (#;TextA ($_ text/compose "Reads a JSON value as " <desc> "."))}
+ {#;doc (code;text ($_ text/compose "Reads a JSON value as " <desc> "."))}
(Reader <type>)
(do p;Monad<Parser>
[head any]
@@ -245,7 +245,7 @@
(do-template [<test> <check> <type> <eq> <encoder> <tag> <desc> <pre>]
[(def: #export (<test> test)
- {#;doc (#;TextA ($_ text/compose "Asks whether a JSON value is a " <desc> "."))}
+ {#;doc (code;text ($_ text/compose "Asks whether a JSON value is a " <desc> "."))}
(-> <type> (Reader Bool))
(do p;Monad<Parser>
[head any]
@@ -257,7 +257,7 @@
(fail ($_ text/compose "JSON value is not " <desc> ".")))))
(def: #export (<check> test)
- {#;doc (#;TextA ($_ text/compose "Ensures a JSON value is a " <desc> "."))}
+ {#;doc (code;text ($_ text/compose "Ensures a JSON value is a " <desc> "."))}
(-> <type> (Reader Unit))
(do p;Monad<Parser>
[head any]
@@ -305,19 +305,19 @@
(def: #export (object parser)
{#;doc "Parses a JSON object, assuming that every element can be parsed the same way."}
- (All [a] (-> (Reader a) (Reader (d;Dict Text a))))
+ (All [a] (-> (Reader a) (Reader (Dict Text a))))
(do p;Monad<Parser>
[head any]
(case head
(#Object object)
(case (do R;Monad<Result>
[]
- (|> (d;entries object)
+ (|> (dict;entries object)
(monad;map @ (function [[key val]]
(do @
[val (run val parser)]
(wrap [key val]))))
- (:: @ map (d;from-list text;Hash<Text>))))
+ (:: @ map (dict;from-list text;Hash<Text>))))
(#R;Success table)
(wrap table)
@@ -334,12 +334,12 @@
[head any]
(case head
(#Object object)
- (case (d;get field-name object)
+ (case (dict;get field-name object)
(#;Some value)
(case (run value parser)
(#R;Success output)
(function [tail]
- (#R;Success [(#;Cons (#Object (d;remove field-name object))
+ (#R;Success [(#;Cons (#Object (dict;remove field-name object))
tail)
output]))
@@ -367,15 +367,15 @@
(def: (show-array show-json elems)
(-> (-> JSON Text) (-> Array Text))
($_ text/compose "["
- (|> elems (Vector/map show-json) vector;to-list (text;join-with ","))
+ (|> elems (vector/map show-json) vector;to-list (text;join-with ","))
"]"))
(def: (show-object show-json object)
(-> (-> JSON Text) (-> Object Text))
($_ text/compose "{"
(|> object
- d;entries
- (L/map (function [[key value]] ($_ text/compose (show-string key) ":" (show-json value))))
+ dict;entries
+ (list/map (function [[key value]] ($_ text/compose (show-string key) ":" (show-json value))))
(text;join-with ","))
"}"))
@@ -428,15 +428,15 @@
[signed? (l;this? "-")
digits (l;many l;decimal)
decimals (p;default "0"
- (do @
- [_ (l;this ".")]
- (l;many l;decimal)))
+ (do @
+ [_ (l;this ".")]
+ (l;many l;decimal)))
exp (p;default ""
- (do @
- [mark (l;one-of "eE")
- signed?' (l;this? "-")
- offset (l;many l;decimal)]
- (wrap ($_ text/compose mark (if signed?' "-" "") offset))))]
+ (do @
+ [mark (l;one-of "eE")
+ signed?' (l;this? "-")
+ offset (l;many l;decimal)]
+ (wrap ($_ text/compose mark (if signed?' "-" "") offset))))]
(case (frac/decode ($_ text/compose (if signed? "-" "") digits "." decimals exp))
(#R;Error message)
(p;fail message)
@@ -447,13 +447,13 @@
(def: escaped~
(l;Lexer Text)
($_ p;either
- (p;after (l;this "\\t") (p/wrap "\t"))
- (p;after (l;this "\\b") (p/wrap "\b"))
- (p;after (l;this "\\n") (p/wrap "\n"))
- (p;after (l;this "\\r") (p/wrap "\r"))
- (p;after (l;this "\\f") (p/wrap "\f"))
- (p;after (l;this "\\\"") (p/wrap "\""))
- (p;after (l;this "\\\\") (p/wrap "\\"))))
+ (p;after (l;this "\\t") (parser/wrap "\t"))
+ (p;after (l;this "\\b") (parser/wrap "\b"))
+ (p;after (l;this "\\n") (parser/wrap "\n"))
+ (p;after (l;this "\\r") (parser/wrap "\r"))
+ (p;after (l;this "\\f") (parser/wrap "\f"))
+ (p;after (l;this "\\\"") (parser/wrap "\""))
+ (p;after (l;this "\\\\") (parser/wrap "\\"))))
(def: string~
(l;Lexer String)
@@ -491,7 +491,7 @@
(wrap (<prep> elems))))]
[array~ Array "[" "]" (json~ []) vector;from-list]
- [object~ Object "{" "}" (kv~ json~) (d;from-list text;Hash<Text>)]
+ [object~ Object "{" "}" (kv~ json~) (dict;from-list text;Hash<Text>)]
)
(def: (json~' _)
diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux
index 32ec67ad2..1f76e833a 100644
--- a/stdlib/source/lux/data/text/lexer.lux
+++ b/stdlib/source/lux/data/text/lexer.lux
@@ -6,7 +6,8 @@
[product]
[maybe]
["R" result]
- (coll [list "L/" Functor<List>]))))
+ (coll [list]))
+ (macro [code])))
(type: Offset Nat)
@@ -127,7 +128,7 @@
(do-template [<name> <bottom> <top> <desc>]
[(def: #export <name>
- {#;doc (#;TextA ($_ text/compose "Only lex " <desc> " characters."))}
+ {#;doc (code;text ($_ text/compose "Only lex " <desc> " characters."))}
(Lexer Text)
(range (char <bottom>) (char <top>)))]
diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux
index d2fe35244..9f691c964 100644
--- a/stdlib/source/lux/macro.lux
+++ b/stdlib/source/lux/macro.lux
@@ -4,13 +4,13 @@
(control ["F" functor]
["A" applicative]
["M" monad #+ do Monad])
- (data (coll [list "L/" Monoid<List> Monad<List>])
- [number]
- [text "T/" Monoid<Text> Eq<Text>]
+ (data [number]
[product]
- [ident "Ident/" Codec<Text,Ident>]
+ [ident "ident/" Codec<Text,Ident> Eq<Ident>]
[maybe]
- ["R" result])))
+ ["R" result]
+ [text "text/" Monoid<Text> Eq<Text>]
+ (coll [list "list/" Monoid<List> Monad<List>]))))
## (type: (Lux a)
## (-> Compiler (R;Result [Compiler a])))
@@ -66,7 +66,7 @@
#;None
(#;Cons [k' v] plist')
- (if (T/= k k')
+ (if (text/= k k')
(#;Some v)
(get k plist'))))
@@ -117,7 +117,7 @@
(#R;Success [state module])
_
- (#R;Error ($_ T/compose "Unknown module: " name)))))
+ (#R;Error ($_ text/compose "Unknown module: " name)))))
(def: #export current-module-name
(Lux Text)
@@ -143,56 +143,62 @@
(def: #export (get-ann tag anns)
{#;doc "Looks-up a particular annotation's value within the set of annotations."}
- (-> Ident Anns (Maybe Ann-Value))
- (let [[p n] tag]
- (case anns
- (#;Cons [[p' n'] dmv] anns')
- (if (and (T/= p p')
- (T/= n n'))
- (#;Some dmv)
- (get-ann tag anns'))
-
- #;Nil
- #;None)))
+ (-> Ident Code (Maybe Code))
+ (case anns
+ [_ (#;Record anns)]
+ (loop [anns anns]
+ (case anns
+ (#;Cons [key value] anns')
+ (case key
+ [_ (#;Tag tag')]
+ (if (ident/= tag tag')
+ (#;Some value)
+ (recur anns'))
+
+ _
+ (recur anns'))
+
+ #;Nil
+ #;None))
+
+ _
+ #;None))
(do-template [<name> <tag> <type>]
[(def: #export (<name> tag anns)
- (-> Ident Anns (Maybe <type>))
+ (-> Ident Code (Maybe <type>))
(case (get-ann tag anns)
- (#;Some (<tag> value))
+ (#;Some [_ (<tag> value)])
(#;Some value)
_
#;None))]
- [get-bool-ann #;BoolA Bool]
- [get-int-ann #;IntA Int]
- [get-frac-ann #;FracA Frac]
- [get-text-ann #;TextA Text]
- [get-ident-ann #;IdentA Ident]
- [get-list-ann #;ListA (List Ann-Value)]
- [get-dict-ann #;DictA (List [Text Ann-Value])]
+ [get-bool-ann #;Bool Bool]
+ [get-int-ann #;Int Int]
+ [get-frac-ann #;Frac Frac]
+ [get-text-ann #;Text Text]
+ [get-symbol-ann #;Symbol Ident]
+ [get-tag-ann #;Tag Ident]
+ [get-form-ann #;Form (List Code)]
+ [get-tuple-ann #;Tuple (List Code)]
+ [get-record-ann #;Record (List [Code Code])]
)
(def: #export (get-doc anns)
{#;doc "Looks-up a definition's documentation."}
- (-> Anns (Maybe Text))
+ (-> Code (Maybe Text))
(get-text-ann ["lux" "doc"] anns))
(def: #export (flag-set? flag-name anns)
{#;doc "Finds out whether an annotation-as-a-flag is set (has value 'true')."}
- (-> Ident Anns Bool)
- (case (get-ann flag-name anns)
- (#;Some (#;BoolA true))
- true
-
- _
- false))
+ (-> Ident Code Bool)
+ (maybe;default false (get-bool-ann flag-name anns)))
(do-template [<name> <tag> <desc>]
[(def: #export <name>
- {#;doc (#;TextA ($_ T/compose "Checks whether a definition is " <desc> "."))}
- (-> Anns Bool)
+ {#;doc (code;text ($_ text/compose "Checks whether a definition is " <desc> "."))}
+ (-> Code Bool)
(flag-set? (ident-for <tag>)))]
[export? #;export? "exported"]
@@ -205,28 +211,28 @@
)
(do-template [<name> <tag> <type>]
- [(def: (<name> dmv)
- (-> Ann-Value (Maybe <type>))
- (case dmv
- (<tag> actual-value)
+ [(def: (<name> input)
+ (-> Code (Maybe <type>))
+ (case input
+ [_ (<tag> actual-value)]
(#;Some actual-value)
_
#;None))]
- [try-mlist #;ListA (List Ann-Value)]
- [try-mtext #;TextA Text]
+ [parse-tuple #;Tuple (List Code)]
+ [parse-text #;Text Text]
)
(do-template [<name> <tag> <desc>]
[(def: #export (<name> anns)
- {#;doc (#;TextA ($_ T/compose "Looks up the arguments of a " <desc> "."))}
- (-> Anns (List Text))
+ {#;doc (code;text ($_ text/compose "Looks up the arguments of a " <desc> "."))}
+ (-> Code (List Text))
(maybe;default (list)
(do maybe;Monad<Maybe>
[_args (get-ann (ident-for <tag>) anns)
- args (try-mlist _args)]
- (M;map @ try-mtext args))))]
+ args (parse-tuple _args)]
+ (M;map @ parse-text args))))]
[func-args #;func-args "function"]
[type-args #;type-args "parameterized type"]
@@ -239,10 +245,10 @@
[$module (get module modules)
[def-type def-anns def-value] (: (Maybe Def) (|> (: Module $module) (get@ #;defs) (get name)))]
(if (and (macro? def-anns)
- (or (export? def-anns) (T/= module this-module)))
+ (or (export? def-anns) (text/= module this-module)))
(#;Some (:! Macro def-value))
- (case (get-ann ["lux" "alias"] def-anns)
- (#;Some (#;IdentA [r-module r-name]))
+ (case (get-symbol-ann ["lux" "alias"] def-anns)
+ (#;Some [r-module r-name])
(find-macro' modules this-module r-module r-name)
_
@@ -306,7 +312,7 @@
(do Monad<Lux>
[expansion (macro args)
expansion' (M;map Monad<Lux> expand expansion)]
- (wrap (L/join expansion')))
+ (wrap (list/join expansion')))
#;None
(:: Monad<Lux> wrap (list syntax))))
@@ -327,23 +333,23 @@
(do Monad<Lux>
[expansion (macro args)
expansion' (M;map Monad<Lux> expand-all expansion)]
- (wrap (L/join expansion')))
+ (wrap (list/join expansion')))
#;None
(do Monad<Lux>
[parts' (M;map Monad<Lux> expand-all (list& (code;symbol name) args))]
- (wrap (list (code;form (L/join parts')))))))
+ (wrap (list (code;form (list/join parts')))))))
[_ (#;Form (#;Cons [harg targs]))]
(do Monad<Lux>
[harg+ (expand-all harg)
targs+ (M;map Monad<Lux> expand-all targs)]
- (wrap (list (code;form (L/compose harg+ (L/join (: (List (List Code)) targs+)))))))
+ (wrap (list (code;form (list/compose harg+ (list/join (: (List (List Code)) targs+)))))))
[_ (#;Tuple members)]
(do Monad<Lux>
[members' (M;map Monad<Lux> expand-all members)]
- (wrap (list (code;tuple (L/join members')))))
+ (wrap (list (code;tuple (list/join members')))))
_
(:: Monad<Lux> wrap (list syntax))))
@@ -355,7 +361,7 @@
(-> Text (Lux Code))
(function [state]
(#R;Success [(update@ #;seed n.inc state)
- (code;symbol ["" ($_ T/compose "__gensym__" prefix (:: number;Codec<Text,Nat> encode (get@ #;seed state)))])])))
+ (code;symbol ["" ($_ text/compose "__gensym__" prefix (:: number;Codec<Text,Nat> encode (get@ #;seed state)))])])))
(def: (get-local-symbol ast)
(-> Code (Lux Text))
@@ -364,7 +370,7 @@
(:: Monad<Lux> wrap name)
_
- (fail (T/compose "Code is not a local symbol: " (code;to-text ast)))))
+ (fail (text/compose "Code is not a local symbol: " (code;to-text ast)))))
(macro: #export (with-gensyms tokens)
{#;doc (doc "Creates new symbols and offers them to the body expression."
@@ -380,9 +386,9 @@
(^ (list [_ (#;Tuple symbols)] body))
(do Monad<Lux>
[symbol-names (M;map @ get-local-symbol symbols)
- #let [symbol-defs (L/join (L/map (: (-> Text (List Code))
- (function [name] (list (code;symbol ["" name]) (` (gensym (~ (code;text name)))))))
- symbol-names))]]
+ #let [symbol-defs (list/join (list/map (: (-> Text (List Code))
+ (function [name] (list (code;symbol ["" name]) (` (gensym (~ (code;text name)))))))
+ symbol-names))]]
(wrap (list (` (do Monad<Lux>
[(~@ symbol-defs)]
(~ body))))))
@@ -424,7 +430,7 @@
(-> Text (Lux Type))
(function [state]
(let [test (: (-> [Text [Type Top]] Bool)
- (|>. product;left (T/= name)))]
+ (|>. product;left (text/= name)))]
(case (do maybe;Monad<Maybe>
[scope (list;find (function [env]
(or (list;any? test (: (List [Text [Type Top]])
@@ -442,7 +448,7 @@
(#R;Success [state var-type])
#;None
- (#R;Error ($_ T/compose "Unknown variable: " name))))))
+ (#R;Error ($_ text/compose "Unknown variable: " name))))))
(def: #export (find-def name)
{#;doc "Looks-up a definition's whole data in the available modules (including the current one)."}
@@ -457,7 +463,7 @@
(#R;Success [state _anns])
_
- (#R;Error ($_ T/compose "Unknown definition: " (Ident/encode name))))))
+ (#R;Error ($_ text/compose "Unknown definition: " (ident/encode name))))))
(def: #export (find-def-type name)
{#;doc "Looks-up a definition's type in the available modules (including the current one)."}
@@ -488,7 +494,7 @@
(-> Text (Lux (List [Text Def])))
(function [state]
(case (get module-name (get@ #;modules state))
- #;None (#R;Error ($_ T/compose "Unknown module: " module-name))
+ #;None (#R;Error ($_ text/compose "Unknown module: " module-name))
(#;Some module) (#R;Success [state (get@ #;defs module)])
)))
@@ -558,12 +564,12 @@
(case (get name (get@ #;tags =module))
(#;Some [idx tag-list exported? type])
(if (or exported?
- (T/= this-module-name module))
+ (text/= this-module-name module))
(wrap [idx tag-list type])
- (fail ($_ T/compose "Cannot access tag: " (Ident/encode tag) " from module " this-module-name)))
+ (fail ($_ text/compose "Cannot access tag: " (ident/encode tag) " from module " this-module-name)))
_
- (fail ($_ T/compose "Unknown tag: " (Ident/encode tag))))))
+ (fail ($_ text/compose "Unknown tag: " (ident/encode tag))))))
(def: #export (tag-lists module)
{#;doc "All the tag-lists defined in a module, with their associated types."}
@@ -574,9 +580,9 @@
(wrap (|> (get@ #;types =module)
(list;filter (function [[type-name [tag-list exported? type]]]
(or exported?
- (T/= this-module-name module))))
- (L/map (function [[type-name [tag-list exported? type]]]
- [tag-list type]))))))
+ (text/= this-module-name module))))
+ (list/map (function [[type-name [tag-list exported? type]]]
+ [tag-list type]))))))
(def: #export locals
{#;doc "All the local variables currently in scope, separated in different scopes."}
@@ -588,10 +594,10 @@
(#;Some scopes)
(#R;Success [state
- (L/map (|>. (get@ [#;locals #;mappings])
- (L/map (function [[name [type _]]]
- [name type])))
- scopes)]))))
+ (list/map (|>. (get@ [#;locals #;mappings])
+ (list/map (function [[name [type _]]]
+ [name type])))
+ scopes)]))))
(def: #export (un-alias def-name)
{#;doc "Given an aliased definition's name, returns the original definition being referenced."}
@@ -599,8 +605,8 @@
(do Monad<Lux>
[def-name (normalize def-name)
[_ def-anns _] (find-def def-name)]
- (case (get-ann (ident-for #;alias) def-anns)
- (#;Some (#;IdentA real-def-name))
+ (case (get-symbol-ann (ident-for #;alias) def-anns)
+ (#;Some real-def-name)
(wrap real-def-name)
_
@@ -631,19 +637,19 @@
token))
(do Monad<Lux>
[output (<func> token)
- #let [_ (L/map (. log! code;to-text)
- output)]]
+ #let [_ (list/map (. log! code;to-text)
+ output)]]
(wrap (list)))
(^ (list token))
(do Monad<Lux>
[output (<func> token)
- #let [_ (L/map (. log! code;to-text)
- output)]]
+ #let [_ (list/map (. log! code;to-text)
+ output)]]
(wrap output))
_
- (fail ($_ T/compose "Wrong syntax for " <desc> "."))))]
+ (fail ($_ text/compose "Wrong syntax for " <desc> "."))))]
[log-expand expand "log-expand"]
[log-expand-all expand-all "log-expand-all"]
diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux
index 51333ddc3..4e431de82 100644
--- a/stdlib/source/lux/macro/syntax.lux
+++ b/stdlib/source/lux/macro/syntax.lux
@@ -1,18 +1,18 @@
(;module:
lux
- (lux [macro #+ Monad<Lux> with-gensyms]
- (control ["M" monad #+ do Monad]
+ (lux [macro #+ with-gensyms]
+ (control [monad #+ do Monad]
[eq #+ Eq]
["p" parser])
(data [bool]
[number]
- [text "Text/" Monoid<Text>]
+ [text "text/" Monoid<Text>]
[ident]
- (coll [list #* "" Functor<List> Fold<List> "List/" Monoid<List>])
+ (coll [list "list/" Functor<List>])
[product]
[maybe]
["R" result]))
- (.. [code "Code/" Eq<Code>]))
+ (.. [code "code/" Eq<Code>]))
## [Utils]
(def: (join-pairs pairs)
@@ -29,8 +29,8 @@
## [Utils]
(def: (remaining-inputs asts)
(-> (List Code) Text)
- ($_ Text/compose "\nRemaining input: "
- (|> asts (map code;to-text) (interpose " ") (text;join-with ""))))
+ ($_ text/compose "\nRemaining input: "
+ (|> asts (list/map code;to-text) (list;interpose " ") (text;join-with ""))))
## [Syntaxs]
(def: #export any
@@ -43,7 +43,7 @@
(do-template [<get-name> <type> <tag> <eq> <desc>]
[(def: #export <get-name>
- {#;doc (#;TextA ($_ Text/compose "Parses the next " <desc> " input Code."))}
+ {#;doc (code;text ($_ text/compose "Parses the next " <desc> " input Code."))}
(Syntax <type>)
(function [tokens]
(case tokens
@@ -51,7 +51,7 @@
(#R;Success [tokens' x])
_
- (#R;Error ($_ Text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))]
+ (#R;Error ($_ text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))]
[ bool Bool #;Bool bool;Eq<Bool> "bool"]
[ nat Nat #;Nat number;Eq<Nat> "nat"]
@@ -69,7 +69,7 @@
(function [tokens]
(case tokens
(#;Cons [token tokens'])
- (let [is-it? (Code/= ast token)
+ (let [is-it? (code/= ast token)
remaining (if is-it?
tokens'
tokens)]
@@ -84,9 +84,9 @@
(function [tokens]
(case tokens
(#;Cons [token tokens'])
- (if (Code/= ast token)
+ (if (code/= ast token)
(#R;Success [tokens' []])
- (#R;Error ($_ Text/compose "Expected a " (code;to-text ast) " but instead got " (code;to-text token)
+ (#R;Error ($_ text/compose "Expected a " (code;to-text ast) " but instead got " (code;to-text token)
(remaining-inputs tokens))))
_
@@ -106,7 +106,7 @@
(do-template [<name> <tag> <desc>]
[(def: #export <name>
- {#;doc (#;TextA ($_ Text/compose "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))}
+ {#;doc (code;text ($_ text/compose "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))}
(Syntax Text)
(function [tokens]
(case tokens
@@ -114,7 +114,7 @@
(#R;Success [tokens' x])
_
- (#R;Error ($_ Text/compose "Cannot parse local " <desc> (remaining-inputs tokens))))))]
+ (#R;Error ($_ text/compose "Cannot parse local " <desc> (remaining-inputs tokens))))))]
[local-symbol #;Symbol "symbol"]
[ local-tag #;Tag "tag"]
@@ -122,7 +122,7 @@
(do-template [<name> <tag> <desc>]
[(def: #export (<name> p)
- {#;doc (#;TextA ($_ Text/compose "Parse inside the contents of a " <desc> " as if they were the input Codes."))}
+ {#;doc (code;text ($_ text/compose "Parse inside the contents of a " <desc> " as if they were the input Codes."))}
(All [a]
(-> (Syntax a) (Syntax a)))
(function [tokens]
@@ -130,17 +130,17 @@
(#;Cons [[_ (<tag> members)] tokens'])
(case (p members)
(#R;Success [#;Nil x]) (#R;Success [tokens' x])
- _ (#R;Error ($_ Text/compose "Syntax was expected to fully consume " <desc> (remaining-inputs tokens))))
+ _ (#R;Error ($_ text/compose "Syntax was expected to fully consume " <desc> (remaining-inputs tokens))))
_
- (#R;Error ($_ Text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))]
+ (#R;Error ($_ text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))]
[ form #;Form "form"]
[tuple #;Tuple "tuple"]
)
(def: #export (record p)
- {#;doc (#;TextA ($_ Text/compose "Parse inside the contents of a record as if they were the input Codes."))}
+ {#;doc (code;text ($_ text/compose "Parse inside the contents of a record as if they were the input Codes."))}
(All [a]
(-> (Syntax a) (Syntax a)))
(function [tokens]
@@ -148,10 +148,10 @@
(#;Cons [[_ (#;Record pairs)] tokens'])
(case (p (join-pairs pairs))
(#R;Success [#;Nil x]) (#R;Success [tokens' x])
- _ (#R;Error ($_ Text/compose "Syntax was expected to fully consume record" (remaining-inputs tokens))))
+ _ (#R;Error ($_ text/compose "Syntax was expected to fully consume record" (remaining-inputs tokens))))
_
- (#R;Error ($_ Text/compose "Cannot parse record" (remaining-inputs tokens))))))
+ (#R;Error ($_ text/compose "Cannot parse record" (remaining-inputs tokens))))))
(def: #export end!
{#;doc "Ensures there are no more inputs."}
@@ -159,7 +159,7 @@
(function [tokens]
(case tokens
#;Nil (#R;Success [tokens []])
- _ (#R;Error ($_ Text/compose "Expected list of tokens to be empty!" (remaining-inputs tokens))))))
+ _ (#R;Error ($_ text/compose "Expected list of tokens to be empty!" (remaining-inputs tokens))))))
(def: #export end?
{#;doc "Checks whether there are no more inputs."}
@@ -195,8 +195,8 @@
(#R;Success [real-inputs value])
_
- (#R;Error (Text/compose "Unconsumed inputs: "
- (|> (map code;to-text unconsumed-inputs)
+ (#R;Error (text/compose "Unconsumed inputs: "
+ (|> (list/map code;to-text unconsumed-inputs)
(text;join-with ", "))))))))
## [Syntax]
@@ -216,11 +216,11 @@
[interfaces (tuple (some (super-class-decl^ imports class-vars)))]
[constructor-args (constructor-args^ imports class-vars)]
[methods (some (overriden-method-def^ imports))])
- (let [def-code ($_ Text/compose "anon-class:"
+ (let [def-code ($_ text/compose "anon-class:"
(spaced (list (super-class-decl$ (maybe;default object-super-class super))
- (with-brackets (spaced (map super-class-decl$ interfaces)))
- (with-brackets (spaced (map constructor-arg$ constructor-args)))
- (with-brackets (spaced (map (method-def$ id) methods))))))]
+ (with-brackets (spaced (list/map super-class-decl$ interfaces)))
+ (with-brackets (spaced (list/map constructor-arg$ constructor-args)))
+ (with-brackets (spaced (list/map (method-def$ id) methods))))))]
(wrap (list (` (;_lux_proc ["jvm" (~ (code;text def-code))] [])))))))}
(let [[exported? tokens] (case tokens
(^ (list& [_ (#;Tag ["" "hidden"])] tokens'))
@@ -247,23 +247,23 @@
(case ?parts
(#;Some [name args meta body])
(with-gensyms [g!tokens g!body g!msg]
- (do Monad<Lux>
- [vars+parsers (M;map Monad<Lux>
- (: (-> Code (Lux [Code Code]))
- (function [arg]
- (case arg
- (^ [_ (#;Tuple (list var parser))])
- (wrap [var parser])
-
- [_ (#;Symbol var-name)]
- (wrap [(code;symbol var-name) (` any)])
-
- _
- (macro;fail "Syntax pattern expects tuples or symbols."))))
- args)
+ (do macro;Monad<Lux>
+ [vars+parsers (monad;map @
+ (: (-> Code (Lux [Code Code]))
+ (function [arg]
+ (case arg
+ (^ [_ (#;Tuple (list var parser))])
+ (wrap [var parser])
+
+ [_ (#;Symbol var-name)]
+ (wrap [(code;symbol var-name) (` any)])
+
+ _
+ (macro;fail "Syntax pattern expects tuples or symbols."))))
+ args)
#let [g!state (code;symbol ["" "*compiler*"])
g!end (code;symbol ["" ""])
- error-msg (code;text (Text/compose "Wrong syntax for " name))
+ error-msg (code;text (text/compose "Wrong syntax for " name))
export-ast (: (List Code) (case exported?
(#;Some #R;Error)
(list (' #hidden))
@@ -281,7 +281,7 @@
(do ;;_Monad<Parser>_
[(~@ (join-pairs vars+parsers))
(~ g!end) end!]
- ((~' wrap) (do Monad<Lux>
+ ((~' wrap) (do macro;Monad<Lux>
[]
(~ body))))))
(#R;Success [(~ g!tokens) (~ g!body)])
diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux
index 33ca61b8b..460dabbf6 100644
--- a/stdlib/source/lux/macro/syntax/common/reader.lux
+++ b/stdlib/source/lux/macro/syntax/common/reader.lux
@@ -2,8 +2,8 @@
lux
(lux (control monad
["p" parser])
- (data (coll [list "L/" Functor<List>])
- [ident "Ident/" Eq<Ident>]
+ (data (coll [list])
+ [ident "ident/" Eq<Ident>]
[product]
[maybe])
[macro]
@@ -74,32 +74,34 @@
tail (s;local (list tail) (flat-list^ []))]
(wrap (#;Cons head tail))))))
-(def: list-meta^
- (Syntax (List Code))
- (s;form (do p;Monad<Parser>
- [_ (s;this (' #lux;ListA))]
- (flat-list^ []))))
+(do-template [<name> <type> <tag> <then>]
+ [(def: <name>
+ (Syntax <type>)
+ (<| s;tuple
+ (p;after s;any)
+ s;form
+ (do p;Monad<Parser>
+ [_ (s;this (' <tag>))]
+ <then>)))]
-(def: text-meta^
- (Syntax Text)
- (s;form (do p;Monad<Parser>
- [_ (s;this (' #lux;TextA))]
- s;text)))
+ [tuple-meta^ (List Code) #lux;Tuple (flat-list^ [])]
+ [text-meta^ Text #lux;Text s;text]
+ )
(def: (find-definition-args meta-data)
(-> (List [Ident Code]) (List Text))
- (maybe;default (list)
- (case (list;find (|>. product;left (Ident/= ["lux" "func-args"])) meta-data)
- (^multi (#;Some [_ value])
- [(p;run (list value) list-meta^)
- (#;Right [_ args])]
- [(p;run args (p;some text-meta^))
- (#;Right [_ args])])
- (#;Some args)
-
- _
- #;None)
- ))
+ (<| (maybe;default (list))
+ (case (list;find (|>. product;left (ident/= ["lux" "func-args"])) meta-data)
+ (^multi (#;Some [_ value])
+ [(p;run (list value) tuple-meta^)
+ (#;Right [_ args])]
+ [(p;run args (p;some text-meta^))
+ (#;Right [_ args])])
+ (#;Some args)
+
+ _
+ #;None)
+ ))
(def: #export (definition compiler)
{#;doc "A reader that first macro-expands and then analyses the input Code, to ensure it's a definition."}
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux
index 0a1bb1d30..f62c35551 100644
--- a/stdlib/source/lux/test.lux
+++ b/stdlib/source/lux/test.lux
@@ -166,6 +166,8 @@
(#E;Error error)
(test error false)))
+(def: #hidden _code/text_ code;text)
+
(syntax: #export (context: description [body test^])
{#;doc (doc "Macro for definint tests."
(context: "Simple macros and constructs"
@@ -246,7 +248,7 @@
body)]
(with-gensyms [g!test]
(wrap (list (` (def: #export (~ g!test)
- {#;;test (#;TextA (~ description))}
+ {#;;test (;;_code/text_ (~ description))}
(IO Test)
(io (~ body)))))))))
diff --git a/stdlib/source/lux/type/object.lux b/stdlib/source/lux/type/object.lux
index a7231d432..3ab6bee4e 100644
--- a/stdlib/source/lux/type/object.lux
+++ b/stdlib/source/lux/type/object.lux
@@ -145,8 +145,8 @@
(do Monad<Lux>
[name (macro;normalize name)
[_ annotations _] (macro;find-def name)]
- (case [(macro;get-ident-ann (ident-for <name-tag>) annotations)
- (macro;get-ident-ann (ident-for <parent-tag>) annotations)]
+ (case [(macro;get-tag-ann (ident-for <name-tag>) annotations)
+ (macro;get-tag-ann (ident-for <parent-tag>) annotations)]
[(#;Some real-name) (#;Some parent)]
(if (Ident/= no-parent parent)
(wrap [real-name (list)])
diff --git a/stdlib/source/lux/type/opaque.lux b/stdlib/source/lux/type/opaque.lux
index b162ae79b..b58e8d32e 100644
--- a/stdlib/source/lux/type/opaque.lux
+++ b/stdlib/source/lux/type/opaque.lux
@@ -2,11 +2,11 @@
lux
(lux (control [applicative]
[monad #+ do Monad]
- ["p" parser "p/" Monad<Parser>])
+ ["p" parser])
(data [text "text/" Eq<Text> Monoid<Text>]
["R" result]
- (coll [list "L/" Functor<List> Monoid<List>]))
- [macro #+ Monad<Lux>]
+ (coll [list "list/" Functor<List> Monoid<List>]))
+ [macro]
(macro [code]
["s" syntax #+ syntax:]
(syntax ["cs" common]
@@ -51,7 +51,7 @@
(def: down-cast Text "@opaque")
(def: up-cast Text "@repr")
-(def: macro-anns Anns (list [["lux" "macro?"] (#;BoolA true)]))
+(def: macro-anns Code (' {#;macro? true}))
(def: representation-name
(-> Text Text)
@@ -60,9 +60,9 @@
(def: (install-casts' this-module-name name type-vars)
(-> Text Text (List Text) (Lux Unit))
- (do Monad<Lux>
+ (do macro;Monad<Lux>
[this-module (macro;find-module this-module-name)
- #let [type-varsC (L/map code;local-symbol type-vars)
+ #let [type-varsC (list/map code;local-symbol type-vars)
opaque-declaration (` ((~ (code;local-symbol name)) (~@ type-varsC)))
representation-declaration (` ((~ (code;local-symbol (representation-name name))) (~@ type-varsC)))
this-module (|> this-module
@@ -96,7 +96,7 @@
(def: (un-install-casts' this-module-name)
(-> Text (Lux Unit))
- (do Monad<Lux>
+ (do macro;Monad<Lux>
[this-module (macro;find-module this-module-name)
#let [this-module (|> this-module
(update@ #;defs (remove down-cast))
@@ -124,7 +124,7 @@
") because definitions like that already exist.")))))
(syntax: #hidden (un-install-casts)
- (do Monad<Lux>
+ (do macro;Monad<Lux>
[this-module-name macro;current-module-name
?down-cast (macro;find-macro [this-module-name down-cast])
?up-cast (macro;find-macro [this-module-name up-cast])]
@@ -151,7 +151,7 @@
representation-type
[primitives (p;some s;any)])
(let [hidden-name (code;local-symbol (representation-name name))
- type-varsC (L/map code;local-symbol type-vars)
+ type-varsC (list/map code;local-symbol type-vars)
opaque-declaration (` ((~ (code;local-symbol name)) (~@ type-varsC)))
representation-declaration (` ((~ hidden-name) (~@ type-varsC)))]
(wrap (list& (` (type: (~@ (csw;export export)) (~ opaque-declaration)
@@ -160,5 +160,5 @@
(` (type: (~@ (csw;export export)) (~ representation-declaration)
(~ representation-type)))
(` (install-casts (~ (code;local-symbol name)) [(~@ type-varsC)]))
- (L/compose primitives
- (list (` (un-install-casts))))))))
+ (list/compose primitives
+ (list (` (un-install-casts))))))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 15:36:05 +0000