aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux.lux
diff options
context:
space:
mode:
authorEduardo Julian2022-09-02 22:30:48 -0400
committerEduardo Julian2022-09-02 22:30:48 -0400
commit950836e72a1b775ccab19a722566c431f56208f6 (patch)
treed48e07019fc67f8e234d06847ca14d612027817f /stdlib/source/library/lux.lux
parent3b571c140a3bee7ec715df9f9cf37645883b9397 (diff)
Made labels (tags & slots) into normal definitions.
Diffstat (limited to 'stdlib/source/library/lux.lux')
-rw-r--r--stdlib/source/library/lux.lux1438
1 files changed, 919 insertions, 519 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux
index f35ba4250..d5c43cc7f 100644
--- a/stdlib/source/library/lux.lux
+++ b/stdlib/source/library/lux.lux
@@ -36,32 +36,11 @@
{4 #0 1}}})
#1)
-... (type .public (List a)
-... (Variant
-... {#End}
-... {#Item a (List a)}))
-("lux def type tagged" List
- {9 #1
- [..prelude "List"]
- {7 #0
- {0 #0}
- {1 #0
- ... End
- Any
- ... Item
- {2 #0
- {4 #0 1}
- {9 #0
- {4 #0 1}
- {4 #0 0}}}}}}
- {"#End" "#Item"}
- #1)
-
("lux def" Bit
("lux type check type"
{9 #1
[..prelude "Bit"]
- {0 #0 "#Bit" {#End}}})
+ {0 #0 "#Bit" {0 #0}}})
#1)
("lux def" I64
@@ -70,42 +49,42 @@
[..prelude "I64"]
{7 #0
{0 #0}
- {0 #0 "#I64" {#Item {4 #0 1} {#End}}}}})
+ {0 #0 "#I64" {0 #1 {4 #0 1} {0 #0}}}}})
#1)
("lux def" Nat
("lux type check type"
{9 #1
[..prelude "Nat"]
- {0 #0 "#I64" {#Item {0 #0 "#Nat" {#End}} {#End}}}})
+ {0 #0 "#I64" {0 #1 {0 #0 "#Nat" {0 #0}} {0 #0}}}})
#1)
("lux def" Int
("lux type check type"
{9 #1
[..prelude "Int"]
- {0 #0 "#I64" {#Item {0 #0 "#Int" {#End}} {#End}}}})
+ {0 #0 "#I64" {0 #1 {0 #0 "#Int" {0 #0}} {0 #0}}}})
#1)
("lux def" Rev
("lux type check type"
{9 #1
[..prelude "Rev"]
- {0 #0 "#I64" {#Item {0 #0 "#Rev" {#End}} {#End}}}})
+ {0 #0 "#I64" {0 #1 {0 #0 "#Rev" {0 #0}} {0 #0}}}})
#1)
("lux def" Frac
("lux type check type"
{9 #1
[..prelude "Frac"]
- {0 #0 "#Frac" {#End}}})
+ {0 #0 "#Frac" {0 #0}}})
#1)
("lux def" Text
("lux type check type"
{9 #1
[..prelude "Text"]
- {0 #0 "#Text" {#End}}})
+ {0 #0 "#Text" {0 #0}}})
#1)
("lux def" Symbol
@@ -115,21 +94,82 @@
{2 #0 Text Text}})
#1)
+... (type .public (List a)
+... (Variant
+... {#End}
+... {#Item a (List a)}))
+("lux def" List
+ ("lux type check type"
+ {9 #1
+ [..prelude "List"]
+ {7 #0
+ {0 #0}
+ {1 #0
+ ... End
+ Any
+ ... Item
+ {2 #0
+ {4 #0 1}
+ {9 #0
+ {4 #0 1}
+ {4 #0 0}}}}}})
+ #1)
+
+... (type .public Tag
+... (Primitive "#Tag"))
+("lux def" Tag
+ ("lux type check type"
+ {9 #1 [..prelude "Tag"]
+ {0 #0 "#Tag" {0 #0}}})
+ #1)
+
+... (type .public Slot
+... (Primitive "#Slot"))
+("lux def" Slot
+ ("lux type check type"
+ {9 #1 [..prelude "Slot"]
+ {0 #0 "#Slot" {0 #0}}})
+ #1)
+
+("lux def" Label'
+ ("lux type check type"
+ {1 #0 [Any {2 #0 [Nat {2 #0 [Bit {9 #0 Symbol List}]}]}]})
+ #0)
+
+("lux def" list_tags
+ ("lux type check"
+ {9 #0 Symbol List}
+ {0 #1 [[..prelude "#End"]
+ {0 #1 [[..prelude "#Item"]
+ {0 #0}]}]})
+ #0)
+("lux def" #End ("lux type as" Tag [("lux type check" Label' {0 #1 [0 #0 ..list_tags]}) List]) #1)
+("lux def" #Item ("lux type as" Tag [("lux type check" Label' {0 #1 [0 #1 ..list_tags]}) List]) #1)
+
... (type .public (Maybe a)
... {#None}
... {#Some a})
-("lux def type tagged" Maybe
- {9 #1
- [..prelude "Maybe"]
- {7 #0
- {#End}
- {1 #0
- ... None
- Any
- ... Some
- {4 #0 1}}}}
- {"#None" "#Some"}
+("lux def" Maybe
+ ("lux type check type"
+ {9 #1
+ [..prelude "Maybe"]
+ {7 #0
+ {#End}
+ {1 #0
+ ... None
+ Any
+ ... Some
+ {4 #0 1}}}})
#1)
+("lux def" maybe_tags
+ ("lux type check"
+ {9 #0 Symbol List}
+ {0 #1 [[..prelude "#None"]
+ {0 #1 [[..prelude "#Some"]
+ {0 #0}]}]})
+ #0)
+("lux def" #None ("lux type as" Tag [("lux type check" Label' {0 #1 [0 #0 ..maybe_tags]}) Maybe]) #1)
+("lux def" #Some ("lux type as" Tag [("lux type check" Label' {0 #1 [0 #1 ..maybe_tags]}) Maybe]) #1)
... (type .public Type
... (Rec Type
@@ -145,77 +185,149 @@
... {#ExQ (List Type) Type}
... {#Apply Type Type}
... {#Named Symbol Type})))
-("lux def type tagged" Type
- {9 #1 [..prelude "Type"]
- ({Type
- ({Type_List
- ({Type_Pair
- {9 #0
- {0 #0 ["" {#End}]}
- {7 #0
- {#End}
- {1 #0
- ... Primitive
- {2 #0 Text Type_List}
- {1 #0
- ... Sum
- Type_Pair
- {1 #0
- ... Product
- Type_Pair
- {1 #0
- ... Function
- Type_Pair
- {1 #0
- ... Parameter
- Nat
- {1 #0
- ... Var
- Nat
- {1 #0
- ... Ex
- Nat
- {1 #0
- ... UnivQ
- {2 #0 Type_List Type}
- {1 #0
- ... ExQ
- {2 #0 Type_List Type}
- {1 #0
- ... Apply
- Type_Pair
- ... Named
- {2 #0 Symbol Type}}}}}}}}}}}}}}
- ("lux type check type" {2 #0 Type Type}))}
- ("lux type check type" {9 #0 Type List}))}
- ("lux type check type" {9 #0 {0 #0 ["" {#End}]} {4 #0 0}}))}
- {"#Primitive" "#Sum" "#Product" "#Function" "#Parameter" "#Var" "#Ex" "#UnivQ" "#ExQ" "#Apply" "#Named"}
+("lux def" Type
+ ("lux type check type"
+ {9 #1 [..prelude "Type"]
+ ({Type
+ ({Type_List
+ ({Type_Pair
+ {9 #0
+ {0 #0 ["" {#End}]}
+ {7 #0
+ {#End}
+ {1 #0
+ ... Primitive
+ {2 #0 Text Type_List}
+ {1 #0
+ ... Sum
+ Type_Pair
+ {1 #0
+ ... Product
+ Type_Pair
+ {1 #0
+ ... Function
+ Type_Pair
+ {1 #0
+ ... Parameter
+ Nat
+ {1 #0
+ ... Var
+ Nat
+ {1 #0
+ ... Ex
+ Nat
+ {1 #0
+ ... UnivQ
+ {2 #0 Type_List Type}
+ {1 #0
+ ... ExQ
+ {2 #0 Type_List Type}
+ {1 #0
+ ... Apply
+ Type_Pair
+ ... Named
+ {2 #0 Symbol Type}}}}}}}}}}}}}}
+ ("lux type check type" {2 #0 Type Type}))}
+ ("lux type check type" {9 #0 Type List}))}
+ ("lux type check type" {9 #0 {0 #0 ["" {#End}]} {4 #0 0}}))})
+ #1)
+
+("lux def" type_tags
+ ("lux type check"
+ {9 #0 Symbol List}
+ {0 #1 [[..prelude "#Primitive"]
+ {0 #1 [[..prelude "#Sum"]
+ {0 #1 [[..prelude "#Product"]
+ {0 #1 [[..prelude "#Function"]
+ {0 #1 [[..prelude "#Parameter"]
+ {0 #1 [[..prelude "#Var"]
+ {0 #1 [[..prelude "#Ex"]
+ {0 #1 [[..prelude "#UnivQ"]
+ {0 #1 [[..prelude "#ExQ"]
+ {0 #1 [[..prelude "#Apply"]
+ {0 #1 [[..prelude "#Named"]
+ {0 #0}]}]}]}]}]}]}]}]}]}]}]})
+ #0)
+("lux def" #Primitive ("lux type as" Tag [("lux type check" Label' {#Some [0 #0 ..type_tags]}) Type]) #1)
+("lux def" #Sum ("lux type as" Tag [("lux type check" Label' {#Some [1 #0 ..type_tags]}) Type]) #1)
+("lux def" #Product ("lux type as" Tag [("lux type check" Label' {#Some [2 #0 ..type_tags]}) Type]) #1)
+("lux def" #Function ("lux type as" Tag [("lux type check" Label' {#Some [3 #0 ..type_tags]}) Type]) #1)
+("lux def" #Parameter ("lux type as" Tag [("lux type check" Label' {#Some [4 #0 ..type_tags]}) Type]) #1)
+("lux def" #Var ("lux type as" Tag [("lux type check" Label' {#Some [5 #0 ..type_tags]}) Type]) #1)
+("lux def" #Ex ("lux type as" Tag [("lux type check" Label' {#Some [6 #0 ..type_tags]}) Type]) #1)
+("lux def" #UnivQ ("lux type as" Tag [("lux type check" Label' {#Some [7 #0 ..type_tags]}) Type]) #1)
+("lux def" #ExQ ("lux type as" Tag [("lux type check" Label' {#Some [8 #0 ..type_tags]}) Type]) #1)
+("lux def" #Apply ("lux type as" Tag [("lux type check" Label' {#Some [9 #0 ..type_tags]}) Type]) #1)
+("lux def" #Named ("lux type as" Tag [("lux type check" Label' {#Some [9 #1 ..type_tags]}) Type]) #1)
+
+... (type .public Label
+... [(Maybe [Nat Bit (List Symbol)]) Type])
+("lux def" Label
+ ("lux type check"
+ Type
+ {#Named [..prelude "Label"]
+ {#Product {#Apply {#Product Nat {#Product Bit {#Apply Symbol List}}} Maybe}
+ Type}})
#1)
+("lux def" tag
+ ("lux type check"
+ {#Function Label Tag}
+ ([_ it] ("lux type as" Tag it)))
+ #0)
+
+("lux def" slot
+ ("lux type check"
+ {#Function Label Slot}
+ ([_ it] ("lux type as" Slot it)))
+ #0)
+
... (type .public Location
... (Record
... [#module Text
... #line Nat
... #column Nat]))
-("lux def type tagged" Location
- {#Named [..prelude "Location"]
- {#Product Text {#Product Nat Nat}}}
- ["#module" "#line" "#column"]
+("lux def" Location
+ ("lux type check"
+ Type
+ {#Named [..prelude "Location"]
+ {#Product Text {#Product Nat Nat}}})
#1)
+("lux def" location_slots
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#module"]
+ {#Item [..prelude "#line"]
+ {#Item [..prelude "#column"]
+ {#End}}}})
+ #0)
+("lux def" #module (slot [{#Some [0 #0 ..location_slots]} Location]) #1)
+("lux def" #line (slot [{#Some [1 #0 ..location_slots]} Location]) #1)
+("lux def" #column (slot [{#Some [1 #1 ..location_slots]} Location]) #1)
... (type .public (Ann m v)
... (Record
... [#meta m
... #datum v]))
-("lux def type tagged" Ann
- {#Named [..prelude "Ann"]
- {#UnivQ {#End}
- {#UnivQ {#End}
- {#Product
- {#Parameter 3}
- {#Parameter 1}}}}}
- ["#meta" "#datum"]
+("lux def" Ann
+ ("lux type check"
+ Type
+ {#Named [..prelude "Ann"]
+ {#UnivQ {#End}
+ {#UnivQ {#End}
+ {#Product
+ {#Parameter 3}
+ {#Parameter 1}}}}})
#1)
+("lux def" ann_slots
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#meta"]
+ {#Item [..prelude "#datum"]
+ {#End}}})
+ #0)
+("lux def" #meta (slot [{#Some [0 #0 ..ann_slots]} Ann]) #1)
+("lux def" #datum (slot [{#Some [0 #1 ..ann_slots]} Ann]) #1)
... (type .public (Code' w)
... (Variant
@@ -229,57 +341,88 @@
... {#Form (List (w (Code' w)))}
... {#Variant (List (w (Code' w)))}
... {#Tuple (List (w (Code' w)))}))
-("lux def type tagged" Code'
- {#Named [..prelude "Code'"]
- ({Code
- ({Code_List
- {#UnivQ {#End}
- {#Sum
- ... Bit
- Bit
+("lux def" Code'
+ ("lux type check"
+ Type
+ {#Named [..prelude "Code'"]
+ ({Code
+ ({Code_List
+ {#UnivQ {#End}
{#Sum
- ... Nat
- Nat
+ ... Bit
+ Bit
{#Sum
- ... Int
- Int
+ ... Nat
+ Nat
{#Sum
- ... Rev
- Rev
+ ... Int
+ Int
{#Sum
- ... Frac
- Frac
+ ... Rev
+ Rev
{#Sum
- ... Text
- Text
+ ... Frac
+ Frac
{#Sum
- ... Symbol
- Symbol
+ ... Text
+ Text
{#Sum
- ... Form
- Code_List
+ ... Symbol
+ Symbol
{#Sum
- ... Variant
+ ... Form
Code_List
- ... Tuple
- Code_List
- }}}}}}}}}
- }}
- ("lux type check type" {#Apply Code List}))}
- ("lux type check type" {#Apply {#Apply {#Parameter 1}
- {#Parameter 0}}
- {#Parameter 1}}))}
- {"#Bit" "#Nat" "#Int" "#Rev" "#Frac" "#Text" "#Symbol" "#Form" "#Variant" "#Tuple"}
+ {#Sum
+ ... Variant
+ Code_List
+ ... Tuple
+ Code_List
+ }}}}}}}}}
+ }}
+ ("lux type check"
+ Type
+ {#Apply Code List}))}
+ ("lux type check"
+ Type
+ {#Apply {#Apply {#Parameter 1}
+ {#Parameter 0}}
+ {#Parameter 1}}))})
#1)
+("lux def" code'_tags
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#Bit"]
+ {#Item [..prelude "#Nat"]
+ {#Item [..prelude "#Int"]
+ {#Item [..prelude "#Rev"]
+ {#Item [..prelude "#Frac"]
+ {#Item [..prelude "#Text"]
+ {#Item [..prelude "#Symbol"]
+ {#Item [..prelude "#Form"]
+ {#Item [..prelude "#Variant"]
+ {#Item [..prelude "#Tuple"]
+ {#End}}}}}}}}}}})
+ #0)
+("lux def" #Bit (tag [{#Some [0 #0 ..code'_tags]} Code']) #1)
+("lux def" #Nat (tag [{#Some [1 #0 ..code'_tags]} Code']) #1)
+("lux def" #Int (tag [{#Some [2 #0 ..code'_tags]} Code']) #1)
+("lux def" #Rev (tag [{#Some [3 #0 ..code'_tags]} Code']) #1)
+("lux def" #Frac (tag [{#Some [4 #0 ..code'_tags]} Code']) #1)
+("lux def" #Text (tag [{#Some [5 #0 ..code'_tags]} Code']) #1)
+("lux def" #Symbol (tag [{#Some [6 #0 ..code'_tags]} Code']) #1)
+("lux def" #Form (tag [{#Some [7 #0 ..code'_tags]} Code']) #1)
+("lux def" #Variant (tag [{#Some [8 #0 ..code'_tags]} Code']) #1)
+("lux def" #Tuple (tag [{#Some [8 #1 ..code'_tags]} Code']) #1)
... (type .public Code
... (Ann Location (Code' (Ann Location))))
("lux def" Code
- ("lux type check type"
+ ("lux type check"
+ Type
{#Named [..prelude "Code"]
({w
{#Apply {#Apply w Code'} w}}
- ("lux type check type" {#Apply Location Ann}))})
+ ("lux type check" Type {#Apply Location Ann}))})
#1)
("lux def" private
@@ -307,64 +450,76 @@
#0)
("lux def" bit$
- ("lux type check" {#Function Bit Code}
+ ("lux type check"
+ {#Function Bit Code}
([_ value] (_ann {#Bit value})))
#0)
("lux def" nat$
- ("lux type check" {#Function Nat Code}
+ ("lux type check"
+ {#Function Nat Code}
([_ value] (_ann {#Nat value})))
#0)
("lux def" int$
- ("lux type check" {#Function Int Code}
+ ("lux type check"
+ {#Function Int Code}
([_ value] (_ann {#Int value})))
#0)
("lux def" rev$
- ("lux type check" {#Function Rev Code}
+ ("lux type check"
+ {#Function Rev Code}
([_ value] (_ann {#Rev value})))
#0)
("lux def" frac$
- ("lux type check" {#Function Frac Code}
+ ("lux type check"
+ {#Function Frac Code}
([_ value] (_ann {#Frac value})))
#0)
("lux def" text$
- ("lux type check" {#Function Text Code}
+ ("lux type check"
+ {#Function Text Code}
([_ text] (_ann {#Text text})))
#0)
("lux def" symbol$
- ("lux type check" {#Function Symbol Code}
+ ("lux type check"
+ {#Function Symbol Code}
([_ name] (_ann {#Symbol name})))
#0)
("lux def" local$
- ("lux type check" {#Function Text Code}
+ ("lux type check"
+ {#Function Text Code}
([_ name] (_ann {#Symbol ["" name]})))
#0)
("lux def" form$
- ("lux type check" {#Function {#Apply Code List} Code}
+ ("lux type check"
+ {#Function {#Apply Code List} Code}
([_ tokens] (_ann {#Form tokens})))
#0)
("lux def" variant$
- ("lux type check" {#Function {#Apply Code List} Code}
+ ("lux type check"
+ {#Function {#Apply Code List} Code}
([_ tokens] (_ann {#Variant tokens})))
#0)
("lux def" tuple$
- ("lux type check" {#Function {#Apply Code List} Code}
+ ("lux type check"
+ {#Function {#Apply Code List} Code}
([_ tokens] (_ann {#Tuple tokens})))
#0)
... (type .public Definition
... [Bit Type Any])
("lux def" Definition
- ("lux type check type"
+ ("lux type check"
+ Type
{#Named [..prelude "Definition"]
{#Product Bit {#Product Type Any}}})
.public)
@@ -372,94 +527,128 @@
... (type .public Alias
... Symbol)
("lux def" Alias
- ("lux type check type"
+ ("lux type check"
+ Type
{#Named [..prelude "Alias"]
Symbol})
.public)
-... (type .public Label
-... [Bit Type (List Text) Nat])
-("lux def" Label
- ("lux type check type"
- {#Named [..prelude "Label"]
- {#Product Bit {#Product Type {#Product {#Apply Text List} Nat}}}})
- .public)
-
... (type .public Global
... (Variant
... {#Definition Definition}
-... {#Type [Bit Type (Either [Text (List Text)] [Text (List Text)])]}
-... {#Tag Label}
-... {#Slot Label}
... {#Alias Alias}))
-("lux def type tagged" Global
- {#Named [..prelude "Global"]
- {#Sum Definition
- {#Sum ({labels
- {#Product Bit {#Product Type {#Sum labels labels}}}}
- {#Product Text {#Apply Text List}})
- {#Sum Label
- {#Sum Label
- Alias}}}}}
- {"#Definition" "#Type" "#Tag" "#Slot" "#Alias"}
+("lux def" Global
+ ("lux type check"
+ Type
+ {#Named [..prelude "Global"]
+ {#Sum Definition
+ Alias}})
.public)
+("lux def" global_tags
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#Definition"]
+ {#Item [..prelude "#Alias"]
+ {#End}}})
+ #0)
+("lux def" #Definition (tag [{#Some [0 #0 ..global_tags]} Global]) .public)
+("lux def" #Alias (tag [{#Some [0 #1 ..global_tags]} Global]) .public)
+
... (type .public (Bindings k v)
... (Record
... [#counter Nat
... #mappings (List [k v])]))
-("lux def type tagged" Bindings
- {#Named [..prelude "Bindings"]
- {#UnivQ {#End}
- {#UnivQ {#End}
- {#Product
- ... counter
- Nat
- ... mappings
- {#Apply {#Product {#Parameter 3}
- {#Parameter 1}}
- List}}}}}
- ["#counter" "#mappings"]
+("lux def" Bindings
+ ("lux type check"
+ Type
+ {#Named [..prelude "Bindings"]
+ {#UnivQ {#End}
+ {#UnivQ {#End}
+ {#Product
+ ... counter
+ Nat
+ ... mappings
+ {#Apply {#Product {#Parameter 3}
+ {#Parameter 1}}
+ List}}}}})
.public)
+("lux def" bindings_slots
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#counter"]
+ {#Item [..prelude "#mappings"]
+ {#End}}})
+ #0)
+("lux def" #counter (slot [{#Some [0 #0 ..bindings_slots]} Bindings]) .public)
+("lux def" #mappings (slot [{#Some [0 #1 ..bindings_slots]} Bindings]) .public)
+
... (type .public Ref
... {#Local Nat}
... {#Captured Nat})
-("lux def type tagged" Ref
- {#Named [..prelude "Ref"]
- {#Sum
- ... Local
- Nat
- ... Captured
- Nat}}
- {"#Local" "#Captured"}
+("lux def" Ref
+ ("lux type check"
+ Type
+ {#Named [..prelude "Ref"]
+ {#Sum
+ ... Local
+ Nat
+ ... Captured
+ Nat}})
.public)
-... TODO: Get rid of both #name & #inner
+("lux def" ref_tags
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#Local"]
+ {#Item [..prelude "#Captured"]
+ {#End}}})
+ #0)
+("lux def" #Local (tag [{#Some [0 #0 ..ref_tags]} Ref]) .public)
+("lux def" #Captured (tag [{#Some [0 #1 ..ref_tags]} Ref]) .public)
+
+... TODO: Get rid of both #scope_name & #inner_scopes
... (type .public Scope
... (Record
-... [#name (List Text)
-... #inner Nat
-... #locals (Bindings Text [Type Nat])
+... [#scope_name (List Text)
+... #inner_scopes Nat
+... #locals (Bindings Text [Type Nat])
... #captured (Bindings Text [Type Ref])]))
-("lux def type tagged" Scope
- {#Named [..prelude "Scope"]
- {#Product
- ... name
- {#Apply Text List}
+("lux def" Scope
+ ("lux type check"
+ Type
+ {#Named [..prelude "Scope"]
{#Product
- ... inner
- Nat
+ ... name
+ {#Apply Text List}
{#Product
- ... locals
- {#Apply {#Product Type Nat} {#Apply Text Bindings}}
- ... captured
- {#Apply {#Product Type Ref} {#Apply Text Bindings}}}}}}
- ["#name" "#inner" "#locals" "#captured"]
+ ... inner
+ Nat
+ {#Product
+ ... locals
+ {#Apply {#Product Type Nat} {#Apply Text Bindings}}
+ ... captured
+ {#Apply {#Product Type Ref} {#Apply Text Bindings}}}}}})
.public)
+("lux def" scope_slots
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#scope_name"]
+ {#Item [..prelude "#inner_scopes"]
+ {#Item [..prelude "#locals"]
+ {#Item [..prelude "#captured"]
+ {#End}}}}})
+ #0)
+("lux def" #scope_name (slot [{#Some [0 #0 ..scope_slots]} Scope]) .public)
+("lux def" #inner_scopes (slot [{#Some [1 #0 ..scope_slots]} Scope]) .public)
+("lux def" #locals (slot [{#Some [2 #0 ..scope_slots]} Scope]) .public)
+("lux def" #captured (slot [{#Some [2 #1 ..scope_slots]} Scope]) .public)
+
("lux def" Code_List
- ("lux type check type"
+ ("lux type check"
+ Type
{#Apply Code List})
#0)
@@ -467,22 +656,34 @@
... (Variant
... {#Left l}
... {#Right r}))
-("lux def type tagged" Either
- {#Named [..prelude "Either"]
- {#UnivQ {#End}
- {#UnivQ {#End}
- {#Sum
- ... Left
- {#Parameter 3}
- ... Right
- {#Parameter 1}}}}}
- {"#Left" "#Right"}
+("lux def" Either
+ ("lux type check"
+ Type
+ {#Named [..prelude "Either"]
+ {#UnivQ {#End}
+ {#UnivQ {#End}
+ {#Sum
+ ... Left
+ {#Parameter 3}
+ ... Right
+ {#Parameter 1}}}}})
.public)
+("lux def" either_tags
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#Left"]
+ {#Item [..prelude "#Right"]
+ {#End}}})
+ #0)
+("lux def" #Left (tag [{#Some [0 #0 ..either_tags]} Either]) .public)
+("lux def" #Right (tag [{#Some [0 #1 ..either_tags]} Either]) .public)
+
... (type .public Source
... [Location Nat Text])
("lux def" Source
- ("lux type check type"
+ ("lux type check"
+ Type
{#Named [..prelude "Source"]
{#Product Location {#Product Nat Text}}})
.public)
@@ -492,19 +693,32 @@
... #Active
... #Compiled
... #Cached))
-("lux def type tagged" Module_State
- {#Named [..prelude "Module_State"]
- {#Sum
- ... #Active
- Any
+("lux def" Module_State
+ ("lux type check"
+ Type
+ {#Named [..prelude "Module_State"]
{#Sum
- ... #Compiled
+ ... #Active
Any
- ... #Cached
- Any}}}
- {"#Active" "#Compiled" "#Cached"}
+ {#Sum
+ ... #Compiled
+ Any
+ ... #Cached
+ Any}}})
.public)
+("lux def" module_state_tags
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#Active"]
+ {#Item [..prelude "#Compiled"]
+ {#Item [..prelude "#Cached"]
+ {#End}}}})
+ #0)
+("lux def" #Active (tag [{#Some [0 #0 ..module_state_tags]} Module_State]) .public)
+("lux def" #Compiled (tag [{#Some [1 #0 ..module_state_tags]} Module_State]) .public)
+("lux def" #Cached (tag [{#Some [1 #1 ..module_state_tags]} Module_State]) .public)
+
... (type .public Module
... (Record
... [#module_hash Nat
@@ -512,80 +726,141 @@
... #definitions (List [Text Global])
... #imports (List Text)
... #module_state Module_State]))
-("lux def type tagged" Module
- {#Named [..prelude "Module"]
- {#Product
- ... module_hash
- Nat
+("lux def" Module
+ ("lux type check"
+ Type
+ {#Named [..prelude "Module"]
{#Product
- ... module_aliases
- {#Apply {#Product Text Text} List}
+ ... module_hash
+ Nat
{#Product
- ... definitions
- {#Apply {#Product Text Global} List}
+ ... module_aliases
+ {#Apply {#Product Text Text} List}
{#Product
- ... imports
- {#Apply Text List}
- ... module_state
- Module_State
- }}}}}
- ["#module_hash" "#module_aliases" "#definitions" "#imports" "#module_state"]
+ ... definitions
+ {#Apply {#Product Text Global} List}
+ {#Product
+ ... imports
+ {#Apply Text List}
+ ... module_state
+ Module_State
+ }}}}})
.public)
+("lux def" module_slots
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#module_hash"]
+ {#Item [..prelude "#module_aliases"]
+ {#Item [..prelude "#definitions"]
+ {#Item [..prelude "#imports"]
+ {#Item [..prelude "#module_state"]
+ {#End}}}}}})
+ #0)
+("lux def" #module_hash (slot [{#Some [0 #0 ..module_slots]} Module]) .public)
+("lux def" #module_aliases (slot [{#Some [1 #0 ..module_slots]} Module]) .public)
+("lux def" #definitions (slot [{#Some [2 #0 ..module_slots]} Module]) .public)
+("lux def" #imports (slot [{#Some [3 #0 ..module_slots]} Module]) .public)
+("lux def" #module_state (slot [{#Some [3 #1 ..module_slots]} Module]) .public)
+
... (type .public Type_Context
... (Record
... [#ex_counter Nat
... #var_counter Nat
... #var_bindings (List [Nat (Maybe Type)])]))
-("lux def type tagged" Type_Context
- {#Named [..prelude "Type_Context"]
- {#Product ... ex_counter
- Nat
- {#Product ... var_counter
+("lux def" Type_Context
+ ("lux type check"
+ Type
+ {#Named [..prelude "Type_Context"]
+ {#Product ... ex_counter
Nat
- ... var_bindings
- {#Apply {#Product Nat {#Apply Type Maybe}}
- List}}}}
- ["#ex_counter" "#var_counter" "#var_bindings"]
+ {#Product ... var_counter
+ Nat
+ ... var_bindings
+ {#Apply {#Product Nat {#Apply Type Maybe}}
+ List}}}})
.public)
+("lux def" type_context_slots
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#ex_counter"]
+ {#Item [..prelude "#var_counter"]
+ {#Item [..prelude "#var_bindings"]
+ {#End}}}})
+ #0)
+("lux def" #ex_counter (slot [{#Some [0 #0 ..type_context_slots]} Type_Context]) .public)
+("lux def" #var_counter (slot [{#Some [1 #0 ..type_context_slots]} Type_Context]) .public)
+("lux def" #var_bindings (slot [{#Some [1 #1 ..type_context_slots]} Type_Context]) .public)
+
... (type .public Mode
-... #Build
-... #Eval
-... #Interpreter)
-("lux def type tagged" Mode
- {#Named [..prelude "Mode"]
- {#Sum ... Build
- Any
- {#Sum ... Eval
+... (Variant
+... {#Build}
+... {#Eval}
+... {#Interpreter}))
+("lux def" Mode
+ ("lux type check"
+ Type
+ {#Named [..prelude "Mode"]
+ {#Sum
+ ... Build
Any
- ... Interpreter
- Any}}}
- {"#Build" "#Eval" "#Interpreter"}
+ {#Sum
+ ... Eval
+ Any
+ ... Interpreter
+ Any}}})
.public)
+("lux def" mode_tags
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#Build"]
+ {#Item [..prelude "#Eval"]
+ {#Item [..prelude "#Interpreter"]
+ {#End}}}})
+ #0)
+("lux def" #Build (tag [{#Some [0 #0 ..mode_tags]} Mode]) .public)
+("lux def" #Eval (tag [{#Some [1 #0 ..mode_tags]} Mode]) .public)
+("lux def" #Interpreter (tag [{#Some [1 #1 ..mode_tags]} Mode]) .public)
+
... (type .public Info
... (Record
... [#target Text
... #version Text
... #mode Mode
... #configuration (List [Text Text])]))
-("lux def type tagged" Info
- {#Named [..prelude "Info"]
- {#Product
- ... target
- Text
+("lux def" Info
+ ("lux type check"
+ Type
+ {#Named [..prelude "Info"]
{#Product
- ... version
+ ... target
Text
{#Product
- ... mode
- Mode
- ... configuration
- {#Apply {#Product Text Text} List}}}}}
- ["#target" "#version" "#mode" "#configuration"]
+ ... version
+ Text
+ {#Product
+ ... mode
+ Mode
+ ... configuration
+ {#Apply {#Product Text Text} List}}}}})
.public)
+("lux def" info_slots
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#target"]
+ {#Item [..prelude "#version"]
+ {#Item [..prelude "#mode"]
+ {#Item [..prelude "#configuration"]
+ {#End}}}}})
+ #0)
+("lux def" #target (slot [{#Some [0 #0 ..info_slots]} Info]) .public)
+("lux def" #version (slot [{#Some [1 #0 ..info_slots]} Info]) .public)
+("lux def" #mode (slot [{#Some [2 #0 ..info_slots]} Info]) .public)
+("lux def" #configuration (slot [{#Some [2 #1 ..info_slots]} Info]) .public)
+
... (type .public Lux
... (Rec Lux
... (Record
@@ -602,60 +877,94 @@
... #extensions Any
... #eval (-> Type Code (-> Lux (Either Text [Lux Any])))
... #host Any])))
-("lux def type tagged" Lux
- {#Named [..prelude "Lux"]
- ({Lux
- {#Apply {0 #0 ["" {#End}]}
- {#UnivQ {#End}
- {#Product
- ... info
- Info
+("lux def" Lux
+ ("lux type check"
+ Type
+ {#Named [..prelude "Lux"]
+ ({Lux
+ {#Apply {0 #0 ["" {#End}]}
+ {#UnivQ {#End}
{#Product
- ... source
- Source
+ ... info
+ Info
{#Product
- ... location
- Location
+ ... source
+ Source
{#Product
- ... current_module
- {#Apply Text Maybe}
+ ... location
+ Location
{#Product
- ... modules
- {#Apply {#Product Text Module} List}
+ ... current_module
+ {#Apply Text Maybe}
{#Product
- ... scopes
- {#Apply Scope List}
+ ... modules
+ {#Apply {#Product Text Module} List}
{#Product
- ... type_context
- Type_Context
+ ... scopes
+ {#Apply Scope List}
{#Product
- ... expected
- {#Apply Type Maybe}
+ ... type_context
+ Type_Context
{#Product
- ... seed
- Nat
+ ... expected
+ {#Apply Type Maybe}
{#Product
- ... scope_type_vars
- {#Apply Nat List}
+ ... seed
+ Nat
{#Product
- ... extensions
- Any
+ ... scope_type_vars
+ {#Apply Nat List}
{#Product
- ... eval
- {#Function Type
- {#Function Code
- {#Function Lux
- {#Sum Text {#Product Lux Any}}}}}
- ... host
- Any}}}}}}}}}}}}}}}
- {#Apply {0 #0 ["" {#End}]} {#Parameter 0}})}
- ["#info" "#source" "#location" "#current_module" "#modules" "#scopes" "#type_context" "#expected" "#seed" "#scope_type_vars" "#extensions" "#eval" "#host"]
+ ... extensions
+ Any
+ {#Product
+ ... eval
+ {#Function Type
+ {#Function Code
+ {#Function Lux
+ {#Sum Text {#Product Lux Any}}}}}
+ ... host
+ Any}}}}}}}}}}}}}}}
+ {#Apply {0 #0 ["" {#End}]} {#Parameter 0}})})
.public)
+("lux def" lux_slots
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#info"]
+ {#Item [..prelude "#source"]
+ {#Item [..prelude "#location"]
+ {#Item [..prelude "#current_module"]
+ {#Item [..prelude "#modules"]
+ {#Item [..prelude "#scopes"]
+ {#Item [..prelude "#type_context"]
+ {#Item [..prelude "#expected"]
+ {#Item [..prelude "#seed"]
+ {#Item [..prelude "#scope_type_vars"]
+ {#Item [..prelude "#extensions"]
+ {#Item [..prelude "#eval"]
+ {#Item [..prelude "#host"]
+ {#End}}}}}}}}}}}}}})
+ #0)
+("lux def" #info (slot [{#Some [0 #0 ..lux_slots]} Lux]) .public)
+("lux def" #source (slot [{#Some [1 #0 ..lux_slots]} Lux]) .public)
+("lux def" #location (slot [{#Some [2 #0 ..lux_slots]} Lux]) .public)
+("lux def" #current_module (slot [{#Some [3 #0 ..lux_slots]} Lux]) .public)
+("lux def" #modules (slot [{#Some [4 #0 ..lux_slots]} Lux]) .public)
+("lux def" #scopes (slot [{#Some [5 #0 ..lux_slots]} Lux]) .public)
+("lux def" #type_context (slot [{#Some [6 #0 ..lux_slots]} Lux]) .public)
+("lux def" #expected (slot [{#Some [7 #0 ..lux_slots]} Lux]) .public)
+("lux def" #seed (slot [{#Some [8 #0 ..lux_slots]} Lux]) .public)
+("lux def" #scope_type_vars (slot [{#Some [9 #0 ..lux_slots]} Lux]) .public)
+("lux def" #extensions (slot [{#Some [10 #0 ..lux_slots]} Lux]) .public)
+("lux def" #eval (slot [{#Some [11 #0 ..lux_slots]} Lux]) .public)
+("lux def" #host (slot [{#Some [11 #1 ..lux_slots]} Lux]) .public)
+
... (type .public (Meta a)
... (-> Lux (Either Text [Lux a])))
("lux def" Meta
- ("lux type check type"
+ ("lux type check"
+ Type
{#Named [..prelude "Meta"]
{#UnivQ {#End}
{#Function Lux
@@ -666,7 +975,8 @@
... (type .public Macro'
... (-> (List Code) (Meta (List Code))))
("lux def" Macro'
- ("lux type check type"
+ ("lux type check"
+ Type
{#Named [..prelude "Macro'"]
{#Function Code_List {#Apply Code_List Meta}}})
.public)
@@ -674,7 +984,8 @@
... (type .public Macro
... (Primitive "#Macro"))
("lux def" Macro
- ("lux type check type"
+ ("lux type check"
+ Type
{#Named [..prelude "Macro"]
{#Primitive "#Macro" {#End}}})
.public)
@@ -783,19 +1094,22 @@
#0)
("lux def" as_def
- ("lux type check" {#Function Code {#Function Code {#Function Code Code}}}
+ ("lux type check"
+ {#Function Code {#Function Code {#Function Code Code}}}
(function'' [name value export_policy]
(form$ {#Item (text$ "lux def") {#Item name {#Item value {#Item export_policy {#End}}}}})))
#0)
("lux def" as_checked
- ("lux type check" {#Function Code {#Function Code Code}}
+ ("lux type check"
+ {#Function Code {#Function Code Code}}
(function'' [type value]
(form$ {#Item (text$ "lux type check") {#Item type {#Item value {#End}}}})))
#0)
("lux def" as_function
- ("lux type check" {#Function Code {#Function {#Apply Code List} {#Function Code Code}}}
+ ("lux type check"
+ {#Function Code {#Function {#Apply Code List} {#Function Code Code}}}
(function'' as_function [self inputs output]
({{#End}
output
@@ -808,7 +1122,8 @@
#0)
("lux def" as_macro
- ("lux type check" {#Function Code Code}
+ ("lux type check"
+ {#Function Code Code}
(function'' [expression]
(form$ {#Item (text$ "lux type as")
{#Item (symbol$ [..prelude "Macro"])
@@ -894,8 +1209,9 @@
(def' .private (list#reversed list)
{#UnivQ {#End}
{#Function ($ List {#Parameter 1}) ($ List {#Parameter 1})}}
- (list#mix ("lux type check" {#UnivQ {#End}
- {#Function {#Parameter 1} {#Function ($ List {#Parameter 1}) ($ List {#Parameter 1})}}}
+ (list#mix ("lux type check"
+ {#UnivQ {#End}
+ {#Function {#Parameter 1} {#Function ($ List {#Parameter 1}) ($ List {#Parameter 1})}}}
(function'' [head tail] {#Item head tail}))
{#End}
list))
@@ -1108,7 +1424,7 @@
..#scope_type_vars _ ..#eval _]
(list#mix (function'' [scope verdict]
({[#1] #1
- _ ({[..#name _ ..#inner _ ..#captured _
+ _ ({[..#scope_name _ ..#inner_scopes _ ..#captured _
..#locals [..#counter _
..#mappings locals]]
(list#mix (function'' [local verdict]
@@ -1197,7 +1513,8 @@
Macro
(macro (_ tokens)
({{#Item output inputs}
- (meta#in {#Item (list#mix ("lux type check" {#Function Code {#Function Code Code}}
+ (meta#in {#Item (list#mix ("lux type check"
+ {#Function Code {#Function Code Code}}
(function'' [i o] (variant$ {#Item (symbol$ [..prelude "#Function"]) {#Item i {#Item o {#End}}}})))
output
inputs)
@@ -1305,8 +1622,9 @@
(macro (_ tokens)
({{#Item [_ {#Tuple bindings}] {#Item body {#End}}}
({{#Some bindings}
- (meta#in (list (list#mix ("lux type check" (-> (Tuple Code Code) Code
- Code)
+ (meta#in (list (list#mix ("lux type check"
+ (-> (Tuple Code Code) Code
+ Code)
(function' [binding body]
({[label value]
(form$ (list (variant$ (list label body)) value))}
@@ -1408,17 +1726,27 @@
... #in)
... (is (All (_ a b) (-> (-> a (m b)) (m a) (m b)))
... #then)))
-("lux def type tagged" Monad
- {#Named [..prelude "Monad"]
- (All (_ !)
- (Tuple (All (_ a)
- (-> a ($ ! a)))
- (All (_ a b)
- (-> (-> a ($ ! b))
- ($ ! a)
- ($ ! b)))))}
- ["#in" "#then"]
+("lux def" Monad
+ ("lux type check"
+ Type
+ {#Named [..prelude "Monad"]
+ (All (_ !)
+ (Tuple (All (_ a)
+ (-> a ($ ! a)))
+ (All (_ a b)
+ (-> (-> a ($ ! b))
+ (-> ($ ! a) ($ ! b))))))})
+ #0)
+
+("lux def" monad_slots
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#in"]
+ {#Item [..prelude "#then"]
+ {#End}}})
#0)
+("lux def" #in (slot [{#Some [0 #0 ..monad_slots]} Monad]) .private)
+("lux def" #then (slot [{#Some [0 #1 ..monad_slots]} Monad]) .private)
(def' .private maybe#monad
($ Monad Maybe)
@@ -1427,8 +1755,11 @@
#then
(function' [f ma]
- ({{#None} {#None}
- {#Some a} (f a)}
+ ({{#None}
+ {#None}
+
+ {#Some a}
+ (f a)}
ma))])
(def' .private meta#monad
@@ -1455,7 +1786,8 @@
({{#Some bindings}
(let' [g!in (local$ "in")
g!then (local$ " then ")
- body' (list#mix ("lux type check" (-> (Tuple Code Code) Code Code)
+ body' (list#mix ("lux type check"
+ (-> (Tuple Code Code) Code Code)
(function' [binding body']
(let' [[var value] binding]
({[_ {#Symbol [module short]}]
@@ -1571,10 +1903,8 @@
..#scope_type_vars scope_type_vars ..#eval _eval] state]
({{#Some [..#module_hash _ ..#module_aliases _ ..#definitions definitions ..#imports _ ..#module_state _]}
({{#Some constant}
- ({{#Definition _} {#Right [state full_name]}
- {#Tag _} {#Right [state full_name]}
- {#Slot _} {#Right [state full_name]}
- {#Type _} {#Right [state full_name]}
+ ({{#Definition _}
+ {#Right [state full_name]}
{#Alias real_name}
{#Right [state real_name]}}
@@ -1648,8 +1978,8 @@
(list#one ("lux type check"
(-> Scope ($ Maybe Type))
(function' [env]
- (let' [[..#name _
- ..#inner _
+ (let' [[..#scope_name _
+ ..#inner_scopes _
..#locals [..#counter _ ..#mappings locals]
..#captured _] env]
(list#one ("lux type check"
@@ -1707,18 +2037,7 @@
{#Definition [exported? def_type def_value]}
(if (available? expected_module current_module exported?)
{#Right [state [def_type def_value]]}
- {#Left (text#composite "Unavailable definition: " (symbol#encoded name))})
-
- {#Type [exported? type labels]}
- (if (available? expected_module current_module exported?)
- {#Right [state [..Type type]]}
- {#Left (text#composite "Unavailable definition: " (symbol#encoded name))})
-
- {#Tag _}
- {#Left (text#composite "Unknown definition: " (symbol#encoded name))}
-
- {#Slot _}
- {#Left (text#composite "Unknown definition: " (symbol#encoded name))}}
+ {#Left (text#composite "Unavailable definition: " (symbol#encoded name))})}
definition)}
(property#value expected_short definitions))}
(property#value expected_module modules))))
@@ -1742,7 +2061,7 @@
(definition_value global lux)}
module))))
-(def' .private (bit#and left right)
+(def' .private (and' left right)
(-> Bit Bit Bit)
(if left
right
@@ -1752,7 +2071,7 @@
(-> Symbol Symbol Bit)
(let' [[moduleL shortL] left
[moduleR shortR] right]
- (all bit#and
+ (all and'
(text#= moduleL moduleR)
(text#= shortL shortR))))
@@ -1779,29 +2098,29 @@
(def' .private (type#= left right)
(-> Type Type Bit)
({[{#Primitive nameL parametersL} {#Primitive nameR parametersR}]
- (all bit#and
+ (all and'
(text#= nameL nameR)
("lux i64 =" (list#size parametersL) (list#size parametersR))
(every? (function' [l,r] (let' [[itL itR] l,r] (type#= itL itR)))
(zipped_2 parametersL parametersR)))
[{#Sum leftL rightL} {#Sum leftR rightR}]
- (all bit#and
+ (all and'
(type#= leftL leftR)
(type#= rightL rightR))
[{#Product leftL rightL} {#Product leftR rightR}]
- (all bit#and
+ (all and'
(type#= leftL leftR)
(type#= rightL rightR))
[{#Function leftL rightL} {#Function leftR rightR}]
- (all bit#and
+ (all and'
(type#= leftL leftR)
(type#= rightL rightR))
[{#Apply leftL rightL} {#Apply leftR rightR}]
- (all bit#and
+ (all and'
(type#= leftL leftR)
(type#= rightL rightR))
@@ -1815,21 +2134,21 @@
("lux i64 =" idL idR)
[{#UnivQ envL bodyL} {#UnivQ envR bodyR}]
- (all bit#and
+ (all and'
("lux i64 =" (list#size envL) (list#size envR))
(every? (function' [l,r] (let' [[itL itR] l,r] (type#= itL itR)))
(zipped_2 envL envR))
(type#= bodyL bodyR))
[{#ExQ envL bodyL} {#ExQ envR bodyR}]
- (all bit#and
+ (all and'
("lux i64 =" (list#size envL) (list#size envR))
(every? (function' [l,r] (let' [[itL itR] l,r] (type#= itL itR)))
(zipped_2 envL envR))
(type#= bodyL bodyR))
[{#Named nameL anonL} {#Named nameR anonR}]
- (all bit#and
+ (all and'
(symbol#= nameL nameR)
(type#= anonL anonR))
@@ -2109,7 +2428,8 @@
Macro
(macro (_ tokens)
({{#Item [init apps]}
- (meta#in (list (list#mix ("lux type check" (-> Code Code Code)
+ (meta#in (list (list#mix ("lux type check"
+ (-> Code Code Code)
(function' [app acc]
({[_ {#Variant parts}]
(variant$ (list#composite parts (list acc)))
@@ -2134,7 +2454,8 @@
Macro
(macro (_ tokens)
({{#Item [init apps]}
- (meta#in (list (list#mix ("lux type check" (-> Code Code Code)
+ (meta#in (list (list#mix ("lux type check"
+ (-> Code Code Code)
(function' [app acc]
({[_ {#Variant parts}]
(variant$ (list#composite parts (list acc)))
@@ -2254,7 +2575,8 @@
(macro (_ tokens)
({{#Item [[_ {#Tuple bindings}] {#Item [[_ {#Tuple templates}] data]}]}
({[{#Some bindings'} {#Some data'}]
- (let' [apply ("lux type check" (-> Replacement_Environment ($ List Code))
+ (let' [apply ("lux type check"
+ (-> Replacement_Environment ($ List Code))
(function' [env] (list#each (realized_template env) templates)))
num_bindings (list#size bindings')]
(if (every? (function' [size] ("lux i64 =" num_bindings size))
@@ -2321,7 +2643,8 @@
(def' .private (nat#encoded value)
(-> Nat Text)
({[0] "0"
- _ (let' [loop ("lux type check" (-> Nat Text Text)
+ _ (let' [loop ("lux type check"
+ (-> Nat Text Text)
(function' again [input output]
(if ("lux i64 =" 0 input)
output
@@ -2344,7 +2667,8 @@
(let' [sign (if ("lux i64 <" value +0)
"+"
"-")]
- (("lux type check" (-> Int Text Text)
+ (("lux type check"
+ (-> Int Text Text)
(function' again [input output]
(if ("lux i64 =" +0 input)
(text#composite sign output)
@@ -2389,16 +2713,7 @@
(if (text#= module current_module)
{#Some ("lux type as" Macro def_value)}
{#None}))
- {#None})
-
- {#Type [exported? type labels]}
- {#None}
-
- {#Tag _}
- {#None}
-
- {#Slot _}
- {#None}}
+ {#None})}
("lux type check" Global gdef))))
(def' .private (named_macro full_name)
@@ -2654,7 +2969,8 @@
(do meta#monad
[type_fn (normal_type type_fn)
args (monad#each meta#monad normal_type args)]
- (in (list#mix ("lux type check" (-> Code Code Code)
+ (in (list#mix ("lux type check"
+ (-> Code Code Code)
(function' [arg type_fn] (` {.#Apply (, arg) (, type_fn)})))
type_fn
args)))
@@ -2713,8 +3029,8 @@
..#source source/pre
..#current_module current_module/pre
..#modules modules/pre
- ..#scopes (list#partial [#name (list)
- #inner 0
+ ..#scopes (list#partial [#scope_name (list)
+ #inner_scopes 0
#locals [#counter 0
#mappings (list [..quantification_level [.Nat ("lux type as" Nat -1)]])]
#captured [#counter 0
@@ -2817,9 +3133,9 @@
(macro (_ tokens)
({{#Item value actions}
(let' [dummy (local$ "")]
- (meta#in (list (list#mix ("lux type check" (-> Code Code Code)
- (function' [pre post] (` ({(, dummy) (, post)}
- (, pre)))))
+ (meta#in (list (list#mix ("lux type check"
+ (-> Code Code Code)
+ (function' [pre post] (` ({(, dummy) (, post)} (, pre)))))
value
actions))))
@@ -2855,12 +3171,13 @@
(def' .private (type#encoded type)
(-> Type Text)
({{#Primitive name params}
- ({{#End}
- name
-
- _
- (all text#composite "(" name " " (|> params (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) ")")}
- params)
+ (all text#composite
+ "(Primitive " (text#encoded name)
+ (|> params
+ (list#each (function' [it] (|> it type#encoded (text#composite " "))))
+ list#reversed
+ (list#mix text#composite ""))
+ ")")
{#Sum _}
(all text#composite "{" (|> (flat_variant type) (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) "}")
@@ -2943,6 +3260,12 @@
{#Primitive "#I64" {#Item {#Primitive "#Rev" {#End}} {#End}}}
(in (rev$ (as Rev value)))
+
+ {#Primitive "#Tag" {#End}}
+ (in (symbol$ name))
+
+ {#Primitive "#Slot" {#End}}
+ (in (symbol$ name))
_
(failure (all text#composite
@@ -3621,7 +3944,7 @@
{#Left (all text#composite "Unknown module: " name)}))))
(def (type_slot [module name])
- (-> Symbol (Meta [Nat (List Symbol) Bit Type]))
+ (-> Symbol (Meta [Bit Label]))
(do meta#monad
[=module (..module module)
.let [[..#module_hash _
@@ -3630,17 +3953,50 @@
..#imports _
..#module_state _] =module]]
(when (property#value name definitions)
- {#Some {#Slot [exported type group index]}}
- (meta#in [index
- (list#each (function (_ slot)
- [module slot])
- group)
- exported
- type])
+ {#Some {#Definition [exported type value]}}
+ (meta#in [exported (as Label value)])
_
(failure (text#composite "Unknown slot: " (symbol#encoded [module name]))))))
+(def (slot_family expected_module expected_record)
+ (-> Text Type (Meta (Maybe (List Symbol))))
+ (do meta#monad
+ [module (..module expected_module)
+ actual_module ..current_module_name
+ .let [[..#module_hash _
+ ..#module_aliases _
+ ..#definitions definitions
+ ..#imports _
+ ..#module_state _] module]]
+ (in ((is (-> (List [Text Global])
+ (Maybe (List Symbol)))
+ (function (again remaining)
+ (when remaining
+ {#Item [slot head] tail}
+ (when head
+ {#Definition [exported? type value]}
+ (if (and (type#= Slot type)
+ (or exported?
+ (text#= expected_module actual_module)))
+ (let [[label actual_record] (as Label value)]
+ (if (type#= expected_record actual_record)
+ (when label
+ {#Some [lefts right? family]}
+ {#Some family}
+
+ {#None}
+ {#Some (list [expected_module slot])})
+ (again tail)))
+ (again tail))
+
+ _
+ (again tail))
+
+ {#End}
+ {#None})))
+ definitions))))
+
(def (record_slots type)
(-> Type (Meta (Maybe [(List Symbol) (List Type)])))
(when type
@@ -3662,15 +4018,17 @@
..#imports _
..#module_state _] =module]]
(when (property#value name definitions)
- {#Some {#Type [exported? {#Named _ _type} {#Right slots}]}}
- (when (interface_methods _type)
- {#Some members}
- (meta#in {#Some [(list#each (function (_ slot) [module slot])
- {#Item slots})
- members]})
+ {#Some {#Definition [exported? type value]}}
+ (if (type#= Type type)
+ (do meta#monad
+ [slots (slot_family module (as Type value))]
+ (when [slots (interface_methods (as Type value))]
+ [{#Some slots} {#Some members}]
+ (in {#Some [slots members]})
- _
- (meta#in {#None}))
+ _
+ (record_slots unnamed)))
+ (in {#None}))
_
(record_slots unnamed)))
@@ -3867,6 +4225,51 @@
(meta#in [type {#None}])}
it))
+(def (enumeration' idx xs)
+ (All (_ a)
+ (-> Nat (List a) (List [Nat a])))
+ (when xs
+ {#Item x xs'}
+ {#Item [idx x] (enumeration' ("lux i64 +" 1 idx) xs')}
+
+ {#End}
+ {#End}))
+
+(def (enumeration xs)
+ (All (_ a)
+ (-> (List a) (List [Nat a])))
+ (enumeration' 0 xs))
+
+(def (label_definitions module export_policy associated_type label_type family labels)
+ (-> Text Code Code Code Code (List Text) (List Code))
+ (when (list#reversed labels)
+ (list single)
+ (list (` (def (, export_policy) (, (local$ single))
+ (<| (as (, label_type))
+ (is Label)
+ [{#None} (, associated_type)]))))
+
+ (list#partial right lefts)
+ (list#partial
+ (` (def (, family)
+ (List Symbol)
+ (list (,* (list#each (function (_ it)
+ (` [(, (text$ module)) (, (text$ it))]))
+ labels)))))
+ (` (def (, export_policy) (, (local$ right))
+ (<| (as (, label_type))
+ (is Label)
+ [{#Some [(, (nat$ ("lux i64 -" 1 (list#size lefts)))) #1 (, family)]} (, associated_type)])))
+ (list#each (function (_ [lefts it])
+ (` (def (, export_policy) (, (local$ it))
+ (<| (as (, label_type))
+ (is Label)
+ [{#Some [(, (nat$ lefts)) #0 (, family)]} (, associated_type)]))))
+ (enumeration (list#reversed lefts))))
+
+ _
+ (list)))
+
(def .public type
(macro (_ tokens)
(when (typeP tokens)
@@ -3874,6 +4277,7 @@
(do meta#monad
[type+labels?? (..type_declaration type_codes)
module_name current_module_name
+ g!family (..generated_symbol "g!family")
.let' [type_name (local$ name)
[type labels??] type+labels??
type' (is (Maybe Code)
@@ -3889,23 +4293,22 @@
(let [typeC (` {.#Named [(, (text$ module_name))
(, (text$ name))]
(..type_literal (, type''))})]
- (meta#in (list (when labels??
- {#Some labels}
- (` ("lux def type tagged" (, type_name)
- (, typeC)
- (, (when labels
- {#Left tags}
- (` {(,* (list#each text$ tags))})
-
- {#Right slots}
- (` [(,* (list#each text$ slots))])))
- (, export_policy)))
-
- _
- (` ("lux def" (, type_name)
- ("lux type check type"
- (, typeC))
- (, export_policy)))))))
+ (in (when labels??
+ {#Some labels}
+ (list#partial (` (def (, export_policy) (, type_name)
+ Type
+ (, typeC)))
+ (when labels
+ {#Left tags}
+ (label_definitions module_name export_policy type_name (` Tag) g!family tags)
+
+ {#Right slots}
+ (label_definitions module_name export_policy type_name (` Slot) g!family slots)))
+
+ _
+ (list (` (def (, export_policy) (, type_name)
+ Type
+ (, typeC)))))))
{#None}
(failure (..wrong_syntax_error (symbol ..type)))))
@@ -4141,18 +4544,7 @@
{#Definition [exported? def_type def_value]}
(if exported?
(list name)
- (list))
-
- {#Type [exported? type labels]}
- (if exported?
- (list name)
- (list))
-
- {#Tag _}
- (list)
-
- {#Slot _}
- (list))))
+ (list)))))
(let [[..#module_hash _ ..#module_aliases _ ..#definitions definitions ..#imports _ ..#module_state _] =module]
definitions))]
{#Right state (list#conjoint to_alias)})
@@ -4284,16 +4676,7 @@
(definition_type real_name state)
{#Definition [exported? def_type def_value]}
- {#Some def_type}
-
- {#Type [exported? type labels]}
- {#Some ..Type}
-
- {#Tag _}
- {#None}
-
- {#Slot _}
- {#None})))))
+ {#Some def_type})))))
(def (type_variable idx bindings)
(-> Nat (List [Nat (Maybe Type)]) (Maybe Type))
@@ -4505,20 +4888,32 @@
_
(failure (..wrong_syntax_error (symbol ..cond))))))
-(def (enumeration' idx xs)
- (All (_ a)
- (-> Nat (List a) (List [Nat a])))
- (when xs
- {#Item x xs'}
- {#Item [idx x] (enumeration' ("lux i64 +" 1 idx) xs')}
+(type (Try value)
+ (Variant
+ {#Failure Text}
+ {#Success value}))
+
+(def (access_pattern g!_ g!output lefts right? members)
+ (-> Code Code Nat Bit (List Type) (Try (List Code)))
+ (when ((is (-> Nat (List Type) (List Code)
+ (List Code))
+ (function (again index input output)
+ (when input
+ (list#partial head tail)
+ (if ("lux i64 =" index (if right?
+ ("lux i64 +" 1 lefts)
+ lefts))
+ (list#reversed (list#partial g!output output))
+ (again ("lux i64 +" 1 index) tail (list#partial g!_ output)))
+
+ (list)
+ (list))))
+ 0 members (list))
+ (list)
+ {#Failure "Cannot synthesize access pattern."}
- {#End}
- {#End}))
-
-(def (enumeration xs)
- (All (_ a)
- (-> (List a) (List [Nat a])))
- (enumeration' 0 xs))
+ pattern
+ {#Success pattern}))
(def .public the
(macro (_ tokens)
@@ -4527,24 +4922,27 @@
(do meta#monad
[slot (normal slot')
output (..type_slot slot)
- .let [[idx tags exported? type] output]
- g!_ (..generated_symbol "_")
- g!output (..generated_symbol "")]
- (when (interface_methods type)
- {#Some members}
- (let [pattern (|> (zipped_2 tags (enumeration members))
- (list#each (is (-> [Symbol [Nat Type]] (List Code))
- (function (_ [[r_module r_name] [r_idx r_type]])
- (list (symbol$ [r_module r_name])
- (if ("lux i64 =" idx r_idx)
- g!output
- g!_)))))
- list#conjoint
- tuple$)]
- (meta#in (list (` ({(, pattern) (, g!output)} (, record))))))
-
- _
- (failure "the can only use records.")))
+ .let [[exported? [label' type]] output]]
+ (when label'
+ {.#None}
+ (in (list record))
+
+ {.#Some [lefts right? family]}
+ (do meta#monad
+ [g!_ (..generated_symbol "_")
+ g!output (..generated_symbol "")
+ .let [idx (if right?
+ (is Nat ("lux i64 +" 1 lefts))
+ lefts)
+ pattern (|> (enumeration family)
+ (list#each (is (-> [Nat Symbol] (List Code))
+ (function (_ [r_idx slot])
+ (list (symbol$ slot)
+ (if ("lux i64 =" idx r_idx)
+ g!output
+ g!_)))))
+ list#conjoint)]]
+ (in (list (` ({[(,* pattern)] (, g!output)} (, record))))))))
(list [_ {#Tuple slots}] record)
(meta#in (list (list#mix (is (-> Code Code Code)
@@ -4757,37 +5155,38 @@
(do meta#monad
[slot (normal slot')
output (..type_slot slot)
- .let [[idx tags exported? type] output]]
- (when (interface_methods type)
- {#Some members}
+ .let [[exported? [label' type]] output]]
+ (when label'
+ {.#None}
+ (in (list value))
+
+ {.#Some [lefts right? family]}
(do meta#monad
[pattern' (monad#each meta#monad
- (is (-> [Symbol [Nat Type]] (Meta [Symbol Nat Code]))
- (function (_ [r_slot_name [r_idx r_type]])
+ (is (-> [Nat Symbol] (Meta [Symbol Nat Code]))
+ (function (_ [r_idx r_slot_name])
(do meta#monad
[g!slot (..generated_symbol "")]
- (meta#in [r_slot_name r_idx g!slot]))))
- (zipped_2 tags (enumeration members)))]
- (let [pattern (|> pattern'
+ (in [r_slot_name r_idx g!slot]))))
+ (enumeration family))
+ .let [pattern (|> pattern'
+ (list#each (is (-> [Symbol Nat Code] (List Code))
+ (function (_ [r_slot_name r_idx r_var])
+ (list (symbol$ r_slot_name)
+ r_var))))
+ list#conjoint)
+ idx (if right?
+ (is Nat ("lux i64 +" 1 lefts))
+ lefts)
+ output (|> pattern'
(list#each (is (-> [Symbol Nat Code] (List Code))
(function (_ [r_slot_name r_idx r_var])
(list (symbol$ r_slot_name)
- r_var))))
- list#conjoint
- tuple$)
- output (|> pattern'
- (list#each (is (-> [Symbol Nat Code] (List Code))
- (function (_ [r_slot_name r_idx r_var])
- (list (symbol$ r_slot_name)
- (if ("lux i64 =" idx r_idx)
- value
- r_var)))))
- list#conjoint
- tuple$)]
- (meta#in (list (` ({(, pattern) (, output)} (, record)))))))
-
- _
- (failure "has can only use records.")))
+ (if ("lux i64 =" idx r_idx)
+ value
+ r_var)))))
+ list#conjoint)]]
+ (in (list (` ({[(,* pattern)] [(,* output)]} (, record))))))))
(list [_ {#Tuple slots}] value record)
(when slots
@@ -4841,37 +5240,38 @@
(do meta#monad
[slot (normal slot')
output (..type_slot slot)
- .let [[idx tags exported? type] output]]
- (when (interface_methods type)
- {#Some members}
+ .let [[exported? [label' type]] output]]
+ (when label'
+ {.#None}
+ (in (list (` ((, fun) (, record)))))
+
+ {.#Some [lefts right? family]}
(do meta#monad
[pattern' (monad#each meta#monad
- (is (-> [Symbol [Nat Type]] (Meta [Symbol Nat Code]))
- (function (_ [r_slot_name [r_idx r_type]])
+ (is (-> [Nat Symbol] (Meta [Symbol Nat Code]))
+ (function (_ [r_idx r_slot_name])
(do meta#monad
[g!slot (..generated_symbol "")]
- (meta#in [r_slot_name r_idx g!slot]))))
- (zipped_2 tags (enumeration members)))]
- (let [pattern (|> pattern'
+ (in [r_slot_name r_idx g!slot]))))
+ (enumeration family))
+ .let [pattern (|> pattern'
+ (list#each (is (-> [Symbol Nat Code] (List Code))
+ (function (_ [r_slot_name r_idx r_var])
+ (list (symbol$ r_slot_name)
+ r_var))))
+ list#conjoint)
+ idx (if right?
+ (is Nat ("lux i64 +" 1 lefts))
+ lefts)
+ output (|> pattern'
(list#each (is (-> [Symbol Nat Code] (List Code))
(function (_ [r_slot_name r_idx r_var])
(list (symbol$ r_slot_name)
- r_var))))
- list#conjoint
- tuple$)
- output (|> pattern'
- (list#each (is (-> [Symbol Nat Code] (List Code))
- (function (_ [r_slot_name r_idx r_var])
- (list (symbol$ r_slot_name)
- (if ("lux i64 =" idx r_idx)
- (` ((, fun) (, r_var)))
- r_var)))))
- list#conjoint
- tuple$)]
- (meta#in (list (` ({(, pattern) (, output)} (, record)))))))
-
- _
- (failure "revised can only use records.")))
+ (if ("lux i64 =" idx r_idx)
+ (` ((, fun) (, r_var)))
+ r_var)))))
+ list#conjoint)]]
+ (in (list (` ({[(,* pattern)] [(,* output)]} (, record))))))))
(list [_ {#Tuple slots}] fun record)
(when slots