aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2019-05-22 23:22:16 -0400
committerEduardo Julian2019-05-22 23:22:16 -0400
commit559c24087cdcc5e66a13368a8cc509e6cd2ba047 (patch)
tree2cbb7d2ed3ac3e5f24e9431a87c72af0c0379d45 /stdlib
parent92dede233083d2a534b0530e582afa3b1ff1025f (diff)
Removed the (magical) "tags" annotations tag.
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux.lux720
-rw-r--r--stdlib/source/lux/macro.lux1
-rw-r--r--stdlib/source/lux/tool/compiler/phase/extension/statement.lux139
3 files changed, 400 insertions, 460 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 392fede3a..91ee40db9 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -50,25 +50,23 @@
## (type: (List a)
## #Nil
## (#Cons a (List a)))
-("lux def" List
- ("lux check type"
- (10 ["lux" "List"]
- (7 (0)
- (1 ## "lux.Nil"
- Any
- ## "lux.Cons"
- (2 (4 1)
- (9 (4 1) (4 0)))))))
+("lux def type tagged" List
+ (10 ["lux" "List"]
+ (7 (0)
+ (1 ## "lux.Nil"
+ Any
+ ## "lux.Cons"
+ (2 (4 1)
+ (9 (4 1) (4 0))))))
[dummy-cursor
(10 (1 [[dummy-cursor (7 ["lux" "export?"])]
[dummy-cursor (0 #1)]]
- (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))))))])
+ (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)))))]
+ ["Nil" "Cons"])
("lux def" Bit
("lux check type"
@@ -166,24 +164,22 @@
## (type: (Maybe a)
## #None
## (#Some a))
-("lux def" Maybe
- ("lux check type"
- (10 ["lux" "Maybe"]
- (7 #Nil
- (1 ## "lux.None"
- Any
- ## "lux.Some"
- (4 1)))))
+("lux def type tagged" Maybe
+ (10 ["lux" "Maybe"]
+ (7 #Nil
+ (1 ## "lux.None"
+ Any
+ ## "lux.Some"
+ (4 1))))
[dummy-cursor
(10 (#Cons [[dummy-cursor (7 ["lux" "export?"])]
[dummy-cursor (0 #1)]]
- (#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)))))])
+ (#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))))]
+ ["None" "Some"])
## (type: #rec Type
## (#Primitive Text (List Type))
@@ -198,101 +194,81 @@
## (#Apply Type Type)
## (#Named Name Type)
## )
-("lux def" Type
- ("lux check type"
- (10 ["lux" "Type"]
- ({Type
- ({Type-List
- ({Type-Pair
- (9 Nothing
- (7 #Nil
- (1 ## "lux.Primitive"
- (2 Text Type-List)
- (1 ## "lux.Sum"
+("lux def type tagged" Type
+ (10 ["lux" "Type"]
+ ({Type
+ ({Type-List
+ ({Type-Pair
+ (9 Nothing
+ (7 #Nil
+ (1 ## "lux.Primitive"
+ (2 Text Type-List)
+ (1 ## "lux.Sum"
+ Type-Pair
+ (1 ## "lux.Product"
Type-Pair
- (1 ## "lux.Product"
+ (1 ## "lux.Function"
Type-Pair
- (1 ## "lux.Function"
- Type-Pair
- (1 ## "lux.Parameter"
+ (1 ## "lux.Parameter"
+ Nat
+ (1 ## "lux.Var"
Nat
- (1 ## "lux.Var"
+ (1 ## "lux.Ex"
Nat
- (1 ## "lux.Ex"
- Nat
- (1 ## "lux.UnivQ"
+ (1 ## "lux.UnivQ"
+ (2 Type-List Type)
+ (1 ## "lux.ExQ"
(2 Type-List Type)
- (1 ## "lux.ExQ"
- (2 Type-List Type)
- (1 ## "lux.Apply"
- Type-Pair
- ## "lux.Named"
- (2 Name Type)))))))))))))}
- ("lux check type" (2 Type Type)))}
- ("lux check type" (9 Type List)))}
- ("lux check type" (9 (4 1) (4 0))))))
+ (1 ## "lux.Apply"
+ Type-Pair
+ ## "lux.Named"
+ (2 Name Type)))))))))))))}
+ ("lux check type" (2 Type Type)))}
+ ("lux check type" (9 Type List)))}
+ ("lux check type" (9 (4 1) (4 0)))))
[dummy-cursor
(10 (#Cons [[dummy-cursor (7 ["lux" "export?"])]
[dummy-cursor (0 #1)]]
- (#Cons [[dummy-cursor (7 ["lux" "tags"])]
- [dummy-cursor (9 (#Cons [dummy-cursor (5 "Primitive")]
- (#Cons [dummy-cursor (5 "Sum")]
- (#Cons [dummy-cursor (5 "Product")]
- (#Cons [dummy-cursor (5 "Function")]
- (#Cons [dummy-cursor (5 "Parameter")]
- (#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 #1)]]
- #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 #1)]]
+ #Nil))))]
+ ["Primitive" "Sum" "Product" "Function" "Parameter" "Var" "Ex" "UnivQ" "ExQ" "Apply" "Named"])
## (type: Cursor
## {#module Text
## #line Nat
## #column Nat})
-("lux def" Cursor
+("lux def type tagged" Cursor
(#Named ["lux" "Cursor"]
(#Product Text (#Product Nat Nat)))
[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" "export?"])]
- [dummy-cursor (0 #1)]]
- #Nil))))])
+ (10 (#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" "export?"])]
+ [dummy-cursor (0 #1)]]
+ #Nil)))]
+ ["module" "line" "column"])
## (type: (Ann m v)
## {#meta m
## #datum v})
-("lux def" Ann
+("lux def type tagged" Ann
(#Named ["lux" "Ann"]
(#UnivQ #Nil
(#UnivQ #Nil
(#Product (#Parameter 3)
(#Parameter 1)))))
[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 be annotated with meta-data of arbitrary types.")]]
- (#Cons [[dummy-cursor (7 ["lux" "type-args"])]
- [dummy-cursor (9 (#Cons [dummy-cursor (5 "m")] (#Cons [dummy-cursor (5 "v")] #Nil)))]]
- (#Cons [[dummy-cursor (7 ["lux" "export?"])]
- [dummy-cursor (0 #1)]]
- #Nil)))))])
+ (10 (#Cons [[dummy-cursor (7 ["lux" "doc"])]
+ [dummy-cursor (5 "The type of things that can be annotated with meta-data of arbitrary types.")]]
+ (#Cons [[dummy-cursor (7 ["lux" "type-args"])]
+ [dummy-cursor (9 (#Cons [dummy-cursor (5 "m")] (#Cons [dummy-cursor (5 "v")] #Nil)))]]
+ (#Cons [[dummy-cursor (7 ["lux" "export?"])]
+ [dummy-cursor (0 #1)]]
+ #Nil))))]
+ ["meta" "datum"])
## (type: (Code' w)
## (#Bit Bit)
@@ -306,59 +282,46 @@
## (#Form (List (w (Code' w))))
## (#Tuple (List (w (Code' w))))
## (#Record (List [(w (Code' w)) (w (Code' w))])))
-("lux def" Code'
- ("lux check type"
- (#Named ["lux" "Code'"]
- ({Code
- ({Code-List
- (#UnivQ #Nil
- (#Sum ## "lux.Bit"
- Bit
- (#Sum ## "lux.Nat"
- Nat
- (#Sum ## "lux.Int"
- Int
- (#Sum ## "lux.Rev"
- Rev
- (#Sum ## "lux.Frac"
- Frac
- (#Sum ## "lux.Text"
- Text
- (#Sum ## "lux.Identifier"
+("lux def type tagged" Code'
+ (#Named ["lux" "Code'"]
+ ({Code
+ ({Code-List
+ (#UnivQ #Nil
+ (#Sum ## "lux.Bit"
+ Bit
+ (#Sum ## "lux.Nat"
+ Nat
+ (#Sum ## "lux.Int"
+ Int
+ (#Sum ## "lux.Rev"
+ Rev
+ (#Sum ## "lux.Frac"
+ Frac
+ (#Sum ## "lux.Text"
+ Text
+ (#Sum ## "lux.Identifier"
+ Name
+ (#Sum ## "lux.Tag"
Name
- (#Sum ## "lux.Tag"
- Name
- (#Sum ## "lux.Form"
+ (#Sum ## "lux.Form"
+ Code-List
+ (#Sum ## "lux.Tuple"
Code-List
- (#Sum ## "lux.Tuple"
- Code-List
- ## "lux.Record"
- (#Apply (#Product Code Code) List)
- ))))))))))
- )}
- ("lux check type" (#Apply Code List)))}
- ("lux check type" (#Apply (#Apply (#Parameter 1)
- (#Parameter 0))
- (#Parameter 1))))))
+ ## "lux.Record"
+ (#Apply (#Product Code Code) List)
+ ))))))))))
+ )}
+ ("lux check type" (#Apply Code List)))}
+ ("lux check type" (#Apply (#Apply (#Parameter 1)
+ (#Parameter 0))
+ (#Parameter 1)))))
[dummy-cursor
- (10 (#Cons [[dummy-cursor (7 ["lux" "tags"])]
- [dummy-cursor (9 (#Cons [dummy-cursor (5 "Bit")]
- (#Cons [dummy-cursor (5 "Nat")]
- (#Cons [dummy-cursor (5 "Int")]
- (#Cons [dummy-cursor (5 "Rev")]
- (#Cons [dummy-cursor (5 "Frac")]
- (#Cons [dummy-cursor (5 "Text")]
- (#Cons [dummy-cursor (5 "Identifier")]
- (#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" "export?"])]
- [dummy-cursor (0 #1)]]
- #Nil))))])
+ (10 (#Cons [[dummy-cursor (7 ["lux" "type-args"])]
+ [dummy-cursor (9 (#Cons [dummy-cursor (5 "w")] #Nil))]]
+ (#Cons [[dummy-cursor (7 ["lux" "export?"])]
+ [dummy-cursor (0 #1)]]
+ #Nil)))]
+ ["Bit" "Nat" "Int" "Rev" "Frac" "Text" "Identifier" "Tag" "Form" "Tuple" "Record"])
## (type: Code
## (Ann Cursor (Code' (Ann Cursor))))
@@ -467,56 +430,50 @@
## (type: (Bindings k v)
## {#counter Nat
## #mappings (List [k v])})
-("lux def" Bindings
- ("lux check type"
- (#Named ["lux" "Bindings"]
- (#UnivQ #Nil
- (#UnivQ #Nil
- (#Product ## "lux.counter"
- Nat
- ## "lux.mappings"
- (#Apply (#Product (#Parameter 3)
- (#Parameter 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))))
+("lux def type tagged" Bindings
+ (#Named ["lux" "Bindings"]
+ (#UnivQ #Nil
+ (#UnivQ #Nil
+ (#Product ## "lux.counter"
+ Nat
+ ## "lux.mappings"
+ (#Apply (#Product (#Parameter 3)
+ (#Parameter 1))
+ List)))))
+ (record$ (#Cons [(tag$ ["lux" "type-args"])
+ (tuple$ (#Cons (text$ "k") (#Cons (text$ "v") #Nil)))]
+ default-def-meta-exported))
+ ["counter" "mappings"])
## (type: #export Ref
## (#Local Nat)
## (#Captured Nat))
-("lux def" Ref
- ("lux check type"
- (#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)))
+("lux def type tagged" Ref
+ (#Named ["lux" "Ref"]
+ (#Sum ## Local
+ Nat
+ ## Captured
+ Nat))
+ (record$ default-def-meta-exported)
+ ["Local" "Captured"])
## (type: Scope
## {#name (List Text)
## #inner Nat
## #locals (Bindings Text [Type Nat])
## #captured (Bindings Text [Type Ref])})
-("lux def" Scope
- ("lux check type"
- (#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 type tagged" 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$ default-def-meta-exported)
+ ["name" "inner" "locals" "captured"])
("lux def" Code-List
("lux check type"
@@ -526,22 +483,20 @@
## (type: (Either l r)
## (#Left l)
## (#Right r))
-("lux def" Either
- ("lux check type"
- (#Named ["lux" "Either"]
- (#UnivQ #Nil
- (#UnivQ #Nil
- (#Sum ## "lux.Left"
- (#Parameter 3)
- ## "lux.Right"
- (#Parameter 1))))))
- (record$ (#Cons [(tag$ ["lux" "tags"])
- (tuple$ (#Cons (text$ "Left") (#Cons (text$ "Right") #Nil)))]
- (#Cons [(tag$ ["lux" "type-args"])
- (tuple$ (#Cons (text$ "l") (#Cons (text$ "r") #Nil)))]
- (#Cons [(tag$ ["lux" "doc"])
- (text$ "A choice between two values of different types.")]
- default-def-meta-exported)))))
+("lux def type tagged" Either
+ (#Named ["lux" "Either"]
+ (#UnivQ #Nil
+ (#UnivQ #Nil
+ (#Sum ## "lux.Left"
+ (#Parameter 3)
+ ## "lux.Right"
+ (#Parameter 1)))))
+ (record$ (#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)))
+ ["Left" "Right"])
## (type: Source
## [Cursor Nat Text])
@@ -555,20 +510,18 @@
## #Active
## #Compiled
## #Cached)
-("lux def" Module-State
- ("lux check type"
- (#Named ["lux" "Module-State"]
+("lux def type tagged" Module-State
+ (#Named ["lux" "Module-State"]
+ (#Sum
+ ## #Active
+ Any
(#Sum
- ## #Active
+ ## #Compiled
Any
- (#Sum
- ## #Compiled
- Any
- ## #Cached
- Any))))
- (record$ (#Cons [(tag$ ["lux" "tags"])
- (tuple$ (#Cons (text$ "Active") (#Cons (text$ "Compiled") (#Cons (text$ "Cached") #Nil))))]
- default-def-meta-exported)))
+ ## #Cached
+ Any)))
+ (record$ default-def-meta-exported)
+ ["Active" "Compiled" "Cached"])
## (type: Module
## {#module-hash Nat
@@ -579,114 +532,89 @@
## #types (List [Text [(List Name) Bit Type]])
## #module-annotations (Maybe Code)
## #module-state Module-State})
-("lux def" Module
- ("lux check type"
- (#Named ["lux" "Module"]
- (#Product ## "lux.module-hash"
- Nat
- (#Product ## "lux.module-aliases"
- (#Apply (#Product Text Text) List)
- (#Product ## "lux.definitions"
- (#Apply (#Product Text Definition) List)
- (#Product ## "lux.imports"
- (#Apply Text List)
- (#Product ## "lux.tags"
+("lux def type tagged" Module
+ (#Named ["lux" "Module"]
+ (#Product ## "lux.module-hash"
+ Nat
+ (#Product ## "lux.module-aliases"
+ (#Apply (#Product Text Text) List)
+ (#Product ## "lux.definitions"
+ (#Apply (#Product Text Definition) List)
+ (#Product ## "lux.imports"
+ (#Apply Text List)
+ (#Product ## "lux.tags"
+ (#Apply (#Product Text
+ (#Product Nat
+ (#Product (#Apply Name List)
+ (#Product Bit
+ Type))))
+ List)
+ (#Product ## "lux.types"
(#Apply (#Product Text
- (#Product Nat
- (#Product (#Apply Name List)
- (#Product Bit
- Type))))
+ (#Product (#Apply Name List)
+ (#Product Bit
+ Type)))
List)
- (#Product ## "lux.types"
- (#Apply (#Product Text
- (#Product (#Apply Name List)
- (#Product Bit
- Type)))
- List)
- (#Product ## "lux.module-annotations"
- (#Apply Code Maybe)
- Module-State))
- )))))))
- (record$ (#Cons [(tag$ ["lux" "tags"])
- (tuple$ (#Cons (text$ "module-hash")
- (#Cons (text$ "module-aliases")
- (#Cons (text$ "definitions")
- (#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))))
+ (#Product ## "lux.module-annotations"
+ (#Apply Code Maybe)
+ Module-State))
+ ))))))
+ (record$ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "All the information contained within a Lux module.")]
+ default-def-meta-exported))
+ ["module-hash" "module-aliases" "definitions" "imports" "tags" "types" "module-annotations" "module-state"])
## (type: Type-Context
## {#ex-counter Nat
## #var-counter Nat
## #var-bindings (List [Nat (Maybe Type)])})
-("lux def" Type-Context
- ("lux check type"
- (#Named ["lux" "Type-Context"]
- (#Product ## ex-counter
+("lux def type tagged" Type-Context
+ (#Named ["lux" "Type-Context"]
+ (#Product ## ex-counter
+ Nat
+ (#Product ## var-counter
Nat
- (#Product ## var-counter
- Nat
- ## var-bindings
- (#Apply (#Product Nat (#Apply Type Maybe))
- List)))))
- (record$ (#Cons [(tag$ ["lux" "tags"])
- (tuple$ (#Cons (text$ "ex-counter")
- (#Cons (text$ "var-counter")
- (#Cons (text$ "var-bindings")
- #Nil))))]
- default-def-meta-exported)))
+ ## var-bindings
+ (#Apply (#Product Nat (#Apply Type Maybe))
+ List))))
+ (record$ default-def-meta-exported)
+ ["ex-counter" "var-counter" "var-bindings"])
## (type: Mode
## #Build
## #Eval
## #Interpreter)
-("lux def" Mode
- ("lux check type"
- (#Named ["lux" "Mode"]
- (#Sum ## Build
+("lux def type tagged" Mode
+ (#Named ["lux" "Mode"]
+ (#Sum ## Build
+ Any
+ (#Sum ## Eval
Any
- (#Sum ## Eval
- Any
- ## Interpreter
- Any))))
- (record$ (#Cons [(tag$ ["lux" "tags"])
- (tuple$ (#Cons (text$ "Build")
- (#Cons (text$ "Eval")
- (#Cons (text$ "Interpreter")
- #Nil))))]
- (#Cons [(tag$ ["lux" "doc"])
- (text$ "A sign that shows the conditions under which the compiler is running.")]
- default-def-meta-exported))))
+ ## Interpreter
+ Any)))
+ (record$ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "A sign that shows the conditions under which the compiler is running.")]
+ default-def-meta-exported))
+ ["Build" "Eval" "Interpreter"])
## (type: Info
## {#target Text
## #version Text
## #mode Mode})
-("lux def" Info
- ("lux check type"
- (#Named ["lux" "Info"]
+("lux def type tagged" Info
+ (#Named ["lux" "Info"]
+ (#Product
+ ## target
+ Text
(#Product
- ## target
+ ## version
Text
- (#Product
- ## version
- Text
- ## mode
- Mode))))
- (record$ (#Cons [(tag$ ["lux" "tags"])
- (tuple$ (#Cons (text$ "target")
- (#Cons (text$ "version")
- (#Cons (text$ "mode")
- #Nil))))]
- (#Cons [(tag$ ["lux" "doc"])
- (text$ "Information about the current version and type of compiler that is running.")]
- default-def-meta-exported))))
+ ## mode
+ Mode)))
+ (record$ (#Cons [(tag$ ["lux" "doc"])
+ (text$ "Information about the current version and type of compiler that is running.")]
+ default-def-meta-exported))
+ ["target" "version" "mode"])
## (type: Lux
## {#info Info
@@ -701,54 +629,40 @@
## #scope-type-vars (List Nat)
## #extensions Any
## #host Any})
-("lux def" Lux
- ("lux check type"
- (#Named ["lux" "Lux"]
- (#Product ## "lux.info"
- Info
- (#Product ## "lux.source"
- Source
- (#Product ## "lux.cursor"
- Cursor
- (#Product ## "lux.current-module"
- (#Apply Text Maybe)
- (#Product ## "lux.modules"
- (#Apply (#Product Text Module) List)
- (#Product ## "lux.scopes"
- (#Apply Scope List)
- (#Product ## "lux.type-context"
- Type-Context
- (#Product ## "lux.expected"
- (#Apply Type Maybe)
- (#Product ## "lux.seed"
- Nat
- (#Product ## scope-type-vars
- (#Apply Nat List)
- (#Product ## extensions
- Any
- ## "lux.host"
- Any)))))))))))))
- (record$ (#Cons [(tag$ ["lux" "tags"])
- (tuple$ (#Cons (text$ "info")
- (#Cons (text$ "source")
- (#Cons (text$ "cursor")
- (#Cons (text$ "current-module")
- (#Cons (text$ "modules")
- (#Cons (text$ "scopes")
- (#Cons (text$ "type-context")
- (#Cons (text$ "expected")
- (#Cons (text$ "seed")
- (#Cons (text$ "scope-type-vars")
- (#Cons (text$ "extensions")
- (#Cons (text$ "host")
- #Nil)))))))))))))]
- (#Cons [(tag$ ["lux" "doc"])
- (text$ ("lux text concat"
- ("lux text concat" "Represents the state of the Lux compiler during a run." __paragraph)
- ("lux text concat"
- ("lux text concat" "It is provided to macros during their invocation, so they can access compiler data." __paragraph)
- "Caveat emptor: Avoid fiddling with it, unless you know what you're doing.")))]
- default-def-meta-exported))))
+("lux def type tagged" Lux
+ (#Named ["lux" "Lux"]
+ (#Product ## "lux.info"
+ Info
+ (#Product ## "lux.source"
+ Source
+ (#Product ## "lux.cursor"
+ Cursor
+ (#Product ## "lux.current-module"
+ (#Apply Text Maybe)
+ (#Product ## "lux.modules"
+ (#Apply (#Product Text Module) List)
+ (#Product ## "lux.scopes"
+ (#Apply Scope List)
+ (#Product ## "lux.type-context"
+ Type-Context
+ (#Product ## "lux.expected"
+ (#Apply Type Maybe)
+ (#Product ## "lux.seed"
+ Nat
+ (#Product ## scope-type-vars
+ (#Apply Nat List)
+ (#Product ## extensions
+ Any
+ ## "lux.host"
+ Any))))))))))))
+ (record$ (#Cons [(tag$ ["lux" "doc"])
+ (text$ ("lux text concat"
+ ("lux text concat" "Represents the state of the Lux compiler during a run." __paragraph)
+ ("lux text concat"
+ ("lux text concat" "It is provided to macros during their invocation, so they can access compiler data." __paragraph)
+ "Caveat emptor: Avoid fiddling with it, unless you know what you're doing.")))]
+ default-def-meta-exported))
+ ["info" "source" "cursor" "current-module" "modules" "scopes" "type-context" "expected" "seed" "scope-type-vars" "extensions" "host"])
## (type: (Meta a)
## (-> Lux (Either Text [Lux a])))
@@ -1598,16 +1512,15 @@
## wrap)
## (: (All [a b] (-> (-> a (m b)) (m a) (m b)))
## bind))
-(def:''' Monad
- (list [(tag$ ["lux" "tags"])
- (tuple$ (list (text$ "wrap") (text$ "bind")))])
- Type
- (#Named ["lux" "Monad"]
- (All [m]
- (& (All [a] (-> a ($' m a)))
- (All [a b] (-> (-> a ($' m b))
- ($' m a)
- ($' m b)))))))
+("lux def type tagged" Monad
+ (#Named ["lux" "Monad"]
+ (All [m]
+ (& (All [a] (-> a ($' m a)))
+ (All [a b] (-> (-> a ($' m b))
+ ($' m a)
+ ($' m b))))))
+ (record$ (list))
+ ["wrap" "bind"])
(def:''' maybe-monad
#Nil
@@ -3015,7 +2928,7 @@
(let' [[left right] pair]
(list left right)))
-(def:' (code-to-text code)
+(def:' (%code code)
(-> Code Text)
({[_ (#Bit value)]
(bit@encode value)
@@ -3047,21 +2960,21 @@
[_ (#Form xs)]
($_ text@compose "(" (|> xs
- (list@map code-to-text)
+ (list@map %code)
(interpose " ")
list@reverse
(list@fold text@compose "")) ")")
[_ (#Tuple xs)]
($_ text@compose "[" (|> xs
- (list@map code-to-text)
+ (list@map %code)
(interpose " ")
list@reverse
(list@fold text@compose "")) "]")
[_ (#Record kvs)]
($_ text@compose "{" (|> kvs
- (list@map (function' [kv] ({[k v] ($_ text@compose (code-to-text k) " " (code-to-text v))}
+ (list@map (function' [kv] ({[k v] ($_ text@compose (%code k) " " (%code v))}
kv)))
(interpose " ")
list@reverse
@@ -3095,7 +3008,7 @@
_
(fail ($_ text@compose "'lux.case' expects an even number of tokens: " (|> branches
- (list@map code-to-text)
+ (list@map %code)
(interpose " ")
list@reverse
(list@fold text@compose ""))))}
@@ -3304,13 +3217,13 @@
_
(` (#.Cons [[(~ cursor-code) (#.Tag ["lux" "func-args"])]
[(~ cursor-code) (#.Tuple (.list (~+ (list@map (function (_ arg)
- (` [(~ cursor-code) (#.Text (~ (text$ (code-to-text arg))))]))
+ (` [(~ cursor-code) (#.Text (~ (text$ (%code arg))))]))
args))))]]
(~ meta)))))
(def:' (with-type-args args)
(-> (List Code) Code)
- (` {#.type-args [(~+ (list@map (function (_ arg) (text$ (code-to-text arg)))
+ (` {#.type-args [(~+ (list@map (function (_ arg) (text$ (%code arg)))
args))]}))
(def:' (export^ tokens)
@@ -3387,10 +3300,10 @@
(return (list (` ("lux def" (~ name)
(~ body)
[(~ cursor-code)
- (#Record (~ (with-func-args args
- (if export?
- (with-export-meta =meta)
- =meta))))])))))
+ (#.Record (~ (with-func-args args
+ (if export?
+ (with-export-meta =meta)
+ =meta))))])))))
#None
(fail "Wrong syntax for def:"))))
@@ -3951,25 +3864,25 @@
_
[#0 tokens'])
- parts (: (Maybe [Text (List Code) Code (List Code)])
+ parts (: (Maybe [Text (List Code) (List [Code Code]) (List Code)])
(case tokens'
(^ (list [_ (#Identifier "" 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)])])
+ (#Some [name #Nil meta-parts (list [type-cursor (#Record type-parts)])])
(^ (list& [_ (#Identifier "" name)] [meta-cursor (#Record meta-parts)] type-code1 type-codes))
- (#Some [name #Nil [meta-cursor (#Record meta-parts)] (#Cons type-code1 type-codes)])
+ (#Some [name #Nil meta-parts (#Cons type-code1 type-codes)])
(^ (list& [_ (#Identifier "" name)] type-codes))
- (#Some [name #Nil (` {}) type-codes])
+ (#Some [name #Nil (list) type-codes])
(^ (list [_ (#Form (#Cons [_ (#Identifier "" 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)])])
+ (#Some [name args meta-parts (list [type-cursor (#Record type-parts)])])
(^ (list& [_ (#Form (#Cons [_ (#Identifier "" name)] args))] [meta-cursor (#Record meta-parts)] type-code1 type-codes))
- (#Some [name args [meta-cursor (#Record meta-parts)] (#Cons type-code1 type-codes)])
+ (#Some [name args meta-parts (#Cons type-code1 type-codes)])
(^ (list& [_ (#Form (#Cons [_ (#Identifier "" name)] args))] type-codes))
- (#Some [name args (` {}) type-codes])
+ (#Some [name args (list) type-codes])
_
#None))]
@@ -3980,13 +3893,6 @@
module-name current-module-name]
(let [type-name (local-identifier$ name)
[type tags??] type+tags??
- type-meta (: Code
- (case tags??
- (#Some tags)
- (` {#.tags [(~+ (list@map text$ tags))]})
-
- _
- (` {})))
type' (: (Maybe Code)
(if rec?
(if (empty? args)
@@ -4001,19 +3907,33 @@
(#Some type)
_
- (#Some (` (All (~ type-name) [(~+ args)] (~ type)))))))]
+ (#Some (` (.All (~ type-name) [(~+ args)] (~ type)))))))
+ total-meta (let [meta (process-def-meta meta)
+ meta (if exported?
+ (with-export-meta meta)
+ meta)
+ meta (if rec?
+ (` (#.Cons (~ (flag-meta "type-rec?")) (~ meta)))
+ meta)]
+ (` [(~ cursor-code)
+ (#.Record (~ meta))]))]
(case type'
(#Some type'')
- (return (list (` (..def: (~+ (export exported?)) (~ type-name)
- (~ ($_ meta-code-merge (with-type-args args)
- (if rec? (' {#.type-rec? #1}) (' {}))
- type-meta
- meta))
- Type
- ("lux check type"
- (#.Named [(~ (text$ module-name))
- (~ (text$ name))]
- (type (~ type''))))))))
+ (let [typeC (` (#.Named [(~ (text$ module-name))
+ (~ (text$ name))]
+ (.type (~ type''))))]
+ (return (list (case tags??
+ (#Some tags)
+ (` ("lux def type tagged" (~ type-name)
+ (~ typeC)
+ (~ total-meta)
+ [(~+ (list@map text$ tags))]))
+
+ _
+ (` ("lux def" (~ type-name)
+ ("lux check type"
+ (~ typeC))
+ (~ total-meta)))))))
#None
(fail "Wrong syntax for type:"))))
@@ -4787,7 +4707,7 @@
_
(fail ($_ text@compose "Wrong syntax for refer @ " current-module
..new-line (|> options
- (list@map code-to-text)
+ (list@map %code)
(interpose " ")
(list@fold text@compose "")))))))
diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux
index 4277745f9..833af5656 100644
--- a/stdlib/source/lux/macro.lux
+++ b/stdlib/source/lux/macro.lux
@@ -242,7 +242,6 @@
[function-arguments #.func-args "Looks up the arguments of a function."]
[type-arguments #.type-args "Looks up the arguments of a parameterized type."]
- [declared-tags #.tags "Looks up the tags of a tagged (variant or record) type."]
)
(def: (macro-type? type)
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux
index 99a8d1fe6..623019971 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux
@@ -31,7 +31,7 @@
["#/" // #_
["#." analysis]
["#." synthesis (#+ Synthesis)]
- ["#." statement (#+ Import Operation Handler Bundle)]
+ ["#." statement (#+ Import Requirements Phase Operation Handler Bundle)]
[default
["#." evaluation]]]]])
@@ -57,16 +57,14 @@
#let [analyse (get@ [#////statement.analysis #////statement.phase] state)
synthesize (get@ [#////statement.synthesis #////statement.phase] state)
generate (get@ [#////statement.generation #////statement.phase] state)]
- [_ code//type codeA] (////statement.lift-analysis
- (////analysis.with-scope
- (typeA.with-fresh-env
- (typeA.with-type type
- (do @
- [codeA (analyse codeC)]
- (wrap [type codeA]))))))
+ [_ codeA] (////statement.lift-analysis
+ (////analysis.with-scope
+ (typeA.with-fresh-env
+ (typeA.with-type type
+ (analyse codeC)))))
codeS (////statement.lift-synthesis
(synthesize codeA))]
- (evaluate!' generate code//type codeS)))
+ (evaluate!' generate type codeS)))
## TODO: Inline "definition'" into "definition" ASAP
(def: (definition' generate name code//type codeS)
@@ -83,9 +81,9 @@
_ (///generation.save! false name statement)]
(wrap [code//type codeT target-name value]))))
-(def: (definition name codeC)
+(def: (definition name expected codeC)
(All [anchor expression statement]
- (-> Name Code
+ (-> Name (Maybe Type) Code
(Operation anchor expression statement [Type expression Text Any])))
(do ///.monad
[state (//.lift ///.get-state)
@@ -95,31 +93,23 @@
[_ code//type codeA] (////statement.lift-analysis
(////analysis.with-scope
(typeA.with-fresh-env
- (do @
- [[code//type codeA] (typeA.with-inference (analyse codeC))
- code//type (typeA.with-env
- (check.clean code//type))]
- (wrap [code//type codeA])))))
+ (case expected
+ #.None
+ (do @
+ [[code//type codeA] (typeA.with-inference (analyse codeC))
+ code//type (typeA.with-env
+ (check.clean code//type))]
+ (wrap [code//type codeA]))
+
+ (#.Some expected)
+ (do @
+ [codeA (typeA.with-type expected
+ (analyse codeC))]
+ (wrap [expected codeA]))))))
codeS (////statement.lift-synthesis
(synthesize codeA))]
(definition' generate name code//type codeS)))
-(def: (define short-name type annotations value)
- (All [anchor expression statement]
- (-> Text Type Code Any
- (Operation anchor expression statement Any)))
- (////statement.lift-analysis
- (do ///.monad
- [_ (module.define short-name [type annotations value])]
- (if (type@= .Type type)
- (case (macro.declared-tags annotations)
- #.Nil
- (wrap [])
-
- tags
- (module.declare-tags tags (macro.export? annotations) (:coerce Type value)))
- (wrap [])))))
-
(def: (refresh expander)
(All [anchor expression statement]
(-> Expander (Operation anchor expression statement Any)))
@@ -145,10 +135,11 @@
[current-module (////statement.lift-analysis
(//.lift macro.current-module-name))
#let [full-name [current-module short-name]]
- [_ annotationsT annotationsV] (evaluate! Code annotationsC)
- #let [annotationsV (:coerce Code annotationsV)]
- [value//type valueT valueN valueV] (..definition full-name valueC)
- _ (..define short-name value//type annotationsV valueV)
+ [_ annotationsT annotations] (evaluate! Code annotationsC)
+ #let [annotations (:coerce Code annotations)]
+ [type valueT valueN value] (..definition full-name #.None valueC)
+ _ (////statement.lift-analysis
+ (module.define short-name [type annotations value]))
#let [_ (log! (format "Definition " (%name full-name)))]
_ (////statement.lift-generation
(///generation.learn full-name valueN))
@@ -158,6 +149,44 @@
_
(///.throw //.invalid-syntax [extension-name %code inputsC+]))))
+(def: (custom [syntax handler])
+ (All [anchor expression statement s]
+ (-> [(Parser s)
+ (-> Text
+ (Phase anchor expression statement)
+ s
+ (Operation anchor expression statement Requirements))]
+ (Handler anchor expression statement)))
+ (function (_ extension-name phase inputs)
+ (case (s.run syntax inputs)
+ (#error.Success inputs)
+ (handler extension-name phase inputs)
+
+ (#error.Failure error)
+ (///.throw //.invalid-syntax [extension-name %code inputs]))))
+
+(def: (def::type-tagged expander)
+ (-> Expander Handler)
+ (..custom
+ [($_ p.and s.local-identifier s.any s.any (s.tuple (p.some s.text)))
+ (function (_ extension-name phase [short-name valueC annotationsC tags])
+ (do ///.monad
+ [current-module (////statement.lift-analysis
+ (//.lift macro.current-module-name))
+ #let [full-name [current-module short-name]]
+ [_ annotationsT annotations] (evaluate! Code annotationsC)
+ #let [annotations (:coerce Code annotations)]
+ [type valueT valueN value] (..definition full-name (#.Some .Type) valueC)
+ _ (////statement.lift-analysis
+ (do ///.monad
+ [_ (module.define short-name [type annotations value])]
+ (module.declare-tags tags (macro.export? annotations) (:coerce Type value))))
+ #let [_ (log! (format "Definition " (%name full-name)))]
+ _ (////statement.lift-generation
+ (///generation.learn full-name valueN))
+ _ (..refresh expander)]
+ (wrap ////statement.no-requirements)))]))
+
(def: imports
(Parser (List Import))
(|> (s.tuple (p.and s.text s.text))
@@ -166,17 +195,11 @@
(def: def::module
Handler
- (function (_ extension-name phase inputsC+)
- (case inputsC+
- (^ (list annotationsC importsC))
+ (..custom
+ [($_ p.and s.any ..imports)
+ (function (_ extension-name phase [annotationsC imports])
(do ///.monad
- [imports (case (s.run ..imports (list importsC))
- (#error.Success imports)
- (wrap imports)
-
- (#error.Failure error)
- (///.throw //.invalid-syntax [extension-name %code (list annotationsC importsC)]))
- [_ annotationsT annotationsV] (evaluate! Code annotationsC)
+ [[_ annotationsT annotationsV] (evaluate! Code annotationsC)
#let [annotationsV (:coerce Code annotationsV)]
_ (////statement.lift-analysis
(do @
@@ -189,10 +212,7 @@
imports)]
(module.set-annotations annotationsV)))]
(wrap {#////statement.imports imports
- #////statement.referrals (list)}))
-
- _
- (///.throw //.invalid-syntax [extension-name %code inputsC+]))))
+ #////statement.referrals (list)})))]))
## TODO: Reify aliasing as a feature of the compiler, instead of
## manifesting it implicitly through definition annotations.
@@ -302,18 +322,19 @@
_
(///.throw //.invalid-syntax [extension-name %code inputsC+]))))
-(def: (bundle::def program)
+(def: (bundle::def expander program)
(All [anchor expression statement]
- (-> (-> expression statement) (Bundle anchor expression statement)))
+ (-> Expander (-> expression statement) (Bundle anchor expression statement)))
(<| (//bundle.prefix "def")
(|> //bundle.empty
- (dictionary.put "module" def::module)
- (dictionary.put "alias" def::alias)
- (dictionary.put "analysis" def::analysis)
- (dictionary.put "synthesis" def::synthesis)
+ (dictionary.put "module" def::module)
+ (dictionary.put "alias" def::alias)
+ (dictionary.put "type tagged" (def::type-tagged expander))
+ (dictionary.put "analysis" def::analysis)
+ (dictionary.put "synthesis" def::synthesis)
(dictionary.put "generation" def::generation)
- (dictionary.put "statement" def::statement)
- (dictionary.put "program" (def::program program))
+ (dictionary.put "statement" def::statement)
+ (dictionary.put "program" (def::program program))
)))
(def: #export (bundle expander program)
@@ -322,4 +343,4 @@
(<| (//bundle.prefix "lux")
(|> //bundle.empty
(dictionary.put "def" (lux::def expander))
- (dictionary.merge (..bundle::def program)))))
+ (dictionary.merge (..bundle::def expander program)))))