aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/library/lux.lux')
-rw-r--r--stdlib/source/library/lux.lux298
1 files changed, 154 insertions, 144 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux
index d717434be..e9b07fe8f 100644
--- a/stdlib/source/library/lux.lux
+++ b/stdlib/source/library/lux.lux
@@ -196,9 +196,10 @@
#1)
... (type: .public Location
-... {#module Text
-... #line Nat
-... #column Nat})
+... (Record
+... [#module Text
+... #line Nat
+... #column Nat]))
("lux def type tagged" Location
(#Named ["library/lux" "Location"]
(#Product Text (#Product Nat Nat)))
@@ -208,8 +209,9 @@
#1)
... (type: .public (Ann m v)
-... {#meta m
-... #datum v})
+... (Record
+... [#meta m
+... #datum v]))
("lux def type tagged" Ann
(#Named ["library/lux" "Ann"]
(#UnivQ #End
@@ -442,8 +444,9 @@
.public)
... (type: .public (Bindings k v)
-... {#counter Nat
-... #mappings (List [k v])})
+... (Record
+... [#counter Nat
+... #mappings (List [k v])]))
("lux def type tagged" Bindings
(#Named ["library/lux" "Bindings"]
(#UnivQ #End
@@ -472,10 +475,11 @@
.public)
... (type: .public Scope
-... {#name (List Text)
-... #inner Nat
-... #locals (Bindings Text [Type Nat])
-... #captured (Bindings Text [Type Ref])})
+... (Record
+... [#name (List Text)
+... #inner Nat
+... #locals (Bindings Text [Type Nat])
+... #captured (Bindings Text [Type Ref])]))
("lux def type tagged" Scope
(#Named ["library/lux" "Scope"]
(#Product ... name
@@ -540,12 +544,12 @@
... (type: .public Module
... (Record
-... {#module_hash Nat
+... [#module_hash Nat
... #module_aliases (List [Text Text])
... #definitions (List [Text Global])
... #imports (List Text)
... #module_annotations (Maybe Code)
-... #module_state Module_State}))
+... #module_state Module_State]))
("lux def type tagged" Module
(#Named ["library/lux" "Module"]
(#Product
@@ -571,9 +575,10 @@
.public)
... (type: .public Type_Context
-... {#ex_counter Nat
-... #var_counter Nat
-... #var_bindings (List [Nat (Maybe Type)])})
+... (Record
+... [#ex_counter Nat
+... #var_counter Nat
+... #var_bindings (List [Nat (Maybe Type)])]))
("lux def type tagged" Type_Context
(#Named ["library/lux" "Type_Context"]
(#Product ... ex_counter
@@ -604,9 +609,10 @@
.public)
... (type: .public Info
-... {#target Text
-... #version Text
-... #mode Mode})
+... (Record
+... [#target Text
+... #version Text
+... #mode Mode]))
("lux def type tagged" Info
(#Named ["library/lux" "Info"]
(#Product
@@ -622,19 +628,20 @@
.public)
... (type: .public Lux
-... {#info Info
-... #source Source
-... #location Location
-... #current_module (Maybe Text)
-... #modules (List [Text Module])
-... #scopes (List Scope)
-... #type_context Type_Context
-... #expected (Maybe Type)
-... #seed Nat
-... #scope_type_vars (List Nat)
-... #extensions Any
-... #eval (-> Type Code (-> Lux (Either Text [Lux Any])))
-... #host Any})
+... (Record
+... [#info Info
+... #source Source
+... #location Location
+... #current_module (Maybe Text)
+... #modules (List [Text Module])
+... #scopes (List Scope)
+... #type_context Type_Context
+... #expected (Maybe Type)
+... #seed Nat
+... #scope_type_vars (List Nat)
+... #extensions Any
+... #eval (-> Type Code (-> Lux (Either Text [Lux Any])))
+... #host Any]))
("lux def type tagged" Lux
(#Named ["library/lux" "Lux"]
({Lux
@@ -1162,15 +1169,15 @@
(def:'' .private (initialized_quantification? lux)
#End
(#Function Lux Bit)
- ({{#info _ #source _ #current_module _ #modules _
+ ({[#info _ #source _ #current_module _ #modules _
#scopes scopes #type_context _ #host _
#seed _ #expected _ #location _ #extensions _
- #scope_type_vars _ #eval _}
+ #scope_type_vars _ #eval _]
(list\mix (function'' [scope verdict]
({#1 #1
- _ ({{#name _ #inner _ #captured _
- #locals {#counter _
- #mappings locals}}
+ _ ({[#name _ #inner _ #captured _
+ #locals [#counter _
+ #mappings locals]]
(list\mix (function'' [local verdict]
({[local _]
({#1 #1
@@ -1518,19 +1525,19 @@
(def:''' .private maybe_monad
#End
($' Monad Maybe)
- {#in
+ [#in
(function' [x] (#Some x))
#then
(function' [f ma]
({#None #None
(#Some a) (f a)}
- ma))})
+ ma))])
(def:''' .private meta_monad
#End
($' Monad Meta)
- {#in
+ [#in
(function' [x]
(function' [state]
(#Right state x)))
@@ -1543,7 +1550,7 @@
(#Right [state' a])
(f a state')}
- (ma state))))})
+ (ma state))))])
(macro:' .private (do tokens)
({(#Item monad (#Item [_ (#Tuple bindings)] (#Item body #End)))
@@ -1570,7 +1577,8 @@
var))))
body
(list\reversed (pairs bindings)))]
- (in_meta (list (form$ (list (record$ (list [(record$ (list [(tag$ ["library/lux" "in"]) g!in] [(tag$ ["library/lux" "then"]) g!then]))
+ (in_meta (list (form$ (list (record$ (list [(tuple$ (list (tag$ ["library/lux" "in"]) g!in
+ (tag$ ["library/lux" "then"]) g!then))
body']))
monad)))))
@@ -1585,7 +1593,7 @@
(-> a ($' m b))
($' List a)
($' m ($' List b))))
- (let' [{#in in #then _} m]
+ (let' [[#in in #then _] m]
({#End
(in #End)
@@ -1604,7 +1612,7 @@
b
($' List a)
($' m b)))
- (let' [{#in in #then _} m]
+ (let' [[#in in #then _] m]
({#End
(in y)
@@ -1660,11 +1668,11 @@
#End
(-> Name ($' Meta Name))
(let' [[module name] full_name
- {#info info #source source #current_module _ #modules modules
+ [#info info #source source #current_module _ #modules modules
#scopes scopes #type_context types #host host
#seed seed #expected expected #location location #extensions extensions
- #scope_type_vars scope_type_vars #eval _eval} state]
- ({(#Some {#module_hash _ #module_aliases _ #definitions definitions #imports _ #module_annotations _ #module_state _})
+ #scope_type_vars scope_type_vars #eval _eval] state]
+ ({(#Some [#module_hash _ #module_aliases _ #definitions definitions #imports _ #module_annotations _ #module_state _])
({(#Some constant)
({(#Alias real_name)
(#Right [state real_name])
@@ -1849,10 +1857,10 @@
(def:'' .private (current_module_name state)
#End
($' Meta Text)
- ({{#info info #source source #current_module current_module #modules modules
+ ({[#info info #source source #current_module current_module #modules modules
#scopes scopes #type_context types #host host
#seed seed #expected expected #location location #extensions extensions
- #scope_type_vars scope_type_vars #eval _eval}
+ #scope_type_vars scope_type_vars #eval _eval]
({(#Some module_name)
(#Right [state module_name])
@@ -2201,7 +2209,7 @@
($' Maybe Macro))
(do maybe_monad
[$module (plist\value module modules)
- gdef (let' [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #module_annotations _ #module_state _} ("lux type check" Module $module)]
+ gdef (let' [[#module_hash _ #module_aliases _ #definitions bindings #imports _ #module_annotations _ #module_state _] ("lux type check" Module $module)]
(plist\value name bindings))]
({(#Alias [r_module r_name])
(macro'' modules current_module r_module r_name)
@@ -2244,11 +2252,11 @@
[current_module current_module_name]
(let' [[module name] full_name]
(function' [state]
- ({{#info info #source source #current_module _ #modules modules
+ ({[#info info #source source #current_module _ #modules modules
#scopes scopes #type_context types #host host
#seed seed #expected expected
#location location #extensions extensions
- #scope_type_vars scope_type_vars #eval _eval}
+ #scope_type_vars scope_type_vars #eval _eval]
(#Right state (macro'' modules current_module module name))}
state)))))
@@ -2533,16 +2541,16 @@
(def:''' .private (identifier prefix state)
#End
(-> Text ($' Meta Code))
- ({{#info info #source source #current_module _ #modules modules
+ ({[#info info #source source #current_module _ #modules modules
#scopes scopes #type_context types #host host
#seed seed #expected expected
#location location #extensions extensions
- #scope_type_vars scope_type_vars #eval _eval}
- (#Right {#info info #source source #current_module _ #modules modules
+ #scope_type_vars scope_type_vars #eval _eval]
+ (#Right [#info info #source source #current_module _ #modules modules
#scopes scopes #type_context types #host host
#seed ("lux i64 +" 1 seed) #expected expected
#location location #extensions extensions
- #scope_type_vars scope_type_vars #eval _eval}
+ #scope_type_vars scope_type_vars #eval _eval]
(local_identifier$ ($_ text\composite "__gensym__" prefix (nat\encoded seed))))}
state))
@@ -3255,10 +3263,10 @@
(def: (module name)
(-> Text (Meta Module))
(function (_ state)
- (let [{#info info #source source #current_module _ #modules modules
+ (let [[#info info #source source #current_module _ #modules modules
#scopes scopes #type_context types #host host
#seed seed #expected expected #location location #extensions extensions
- #scope_type_vars scope_type_vars #eval _eval} state]
+ #scope_type_vars scope_type_vars #eval _eval] state]
(case (plist\value name modules)
(#Some module)
(#Right state module)
@@ -3270,7 +3278,7 @@
(-> Name (Meta [Nat (List Name) Bit Type]))
(do meta_monad
[=module (..module module)
- .let [{#module_hash _ #module_aliases _ #definitions definitions #imports _ #module_annotations _ #module_state _} =module]]
+ .let [[#module_hash _ #module_aliases _ #definitions definitions #imports _ #module_annotations _ #module_state _] =module]]
(case (plist\value (text\composite "#" name) definitions)
(#Some (#Slot [exported type group index]))
(in_meta [index
@@ -3298,7 +3306,7 @@
(#Named [module name] unnamed)
(do meta_monad
[=module (..module module)
- .let [{#module_hash _ #module_aliases _ #definitions definitions #imports _ #module_annotations _ #module_state _} =module]]
+ .let [[#module_hash _ #module_aliases _ #definitions definitions #imports _ #module_annotations _ #module_state _] =module]]
(case (plist\value name definitions)
(#Some (#Type [exported? (#Named _ _type) (#Right slots)]))
(case (interface_methods _type)
@@ -3319,10 +3327,10 @@
(def: expected_type
(Meta Type)
(function (_ state)
- (let [{#info info #source source #current_module _ #modules modules
+ (let [[#info info #source source #current_module _ #modules modules
#scopes scopes #type_context types #host host
#seed seed #expected expected #location location #extensions extensions
- #scope_type_vars scope_type_vars #eval _eval} state]
+ #scope_type_vars scope_type_vars #eval _eval] state]
(case expected
(#Some type)
(#Right state type)
@@ -3394,13 +3402,13 @@
(list\each (function (_ tag) [(product\right tag) (tag$ tag)])
tags))]
members (monad\each meta_monad
- (: (-> Code (Meta [Code Code]))
+ (: (-> Code (Meta (List Code)))
(function (_ token)
(case token
(^ [_ (#Form (list [_ (#Text "lux def")] [_ (#Identifier "" tag_name)] value meta export_policy))])
(case (plist\value tag_name tag_mappings)
(#Some tag)
- (in [tag value])
+ (in (list tag value))
_
(failure (text\composite "Unknown implementation member: " tag_name)))
@@ -3408,7 +3416,7 @@
_
(failure "Invalid implementation member."))))
(list\conjoint tokens'))]
- (in (list (record$ members)))))
+ (in (list (tuple$ (list\conjoint members))))))
(def: (text\interposed separator parts)
(-> Text (List Text) Text)
@@ -3539,20 +3547,10 @@
_
#None))
-(def: un_paired
- (-> (List [Code Code]) (List Code))
- (let [pair_list (: (-> [Code Code] (List Code))
- (function (_ [left right])
- (list left right)))]
- (function (_ it)
- (|> it
- (list\each pair_list)
- list\conjoint))))
-
(macro: .public (Record tokens)
(case tokens
- (^ (list [_ (#Record record)]))
- (case (everyP slotP (un_paired record))
+ (^ (list [_ (#Tuple record)]))
+ (case (everyP slotP record)
(#Some slots)
(in_meta (list (` (..Tuple (~+ (list\each product\right slots))))
(tuple$ (list\each (function (_ slot)
@@ -3728,14 +3726,14 @@
(type: Refer
(Record
- {#refer_defs Referrals
- #refer_open (List Openings)}))
+ [#refer_defs Referrals
+ #refer_open (List Openings)]))
(type: Importation
(Record
- {#import_name Text
+ [#import_name Text
#import_alias (Maybe Text)
- #import_refer Refer}))
+ #import_refer Refer]))
(def: (referral_references defs)
(-> (List Code) (Meta (List Text)))
@@ -3921,10 +3919,10 @@
[_ (#Identifier ["" module_name])]
(do meta_monad
[absolute_module_name (..absolute_module_name nested? relative_root module_name)]
- (in (list {#import_name absolute_module_name
+ (in (list [#import_name absolute_module_name
#import_alias #None
- #import_refer {#refer_defs #All
- #refer_open (list)}})))
+ #import_refer [#refer_defs #All
+ #refer_open (list)]])))
... Nested
(^ [_ (#Tuple (list& [_ (#Identifier ["" module_name])] extra))])
@@ -3945,10 +3943,10 @@
sub_imports
_
- (list& {#import_name absolute_module_name
+ (list& [#import_name absolute_module_name
#import_alias #None
- #import_refer {#refer_defs referral
- #refer_open openings}}
+ #import_refer [#refer_defs referral
+ #refer_open openings]]
sub_imports))))
(^ [_ (#Tuple (list& [_ (#Text alias)] [_ (#Identifier ["" module_name])] extra))])
@@ -3970,10 +3968,10 @@
sub_imports
_
- (list& {#import_name absolute_module_name
+ (list& [#import_name absolute_module_name
#import_alias (#Some module_alias)
- #import_refer {#refer_defs referral
- #refer_open openings}}
+ #import_refer [#refer_defs referral
+ #refer_open openings]]
sub_imports))))
... Unrecognized syntax.
@@ -3989,10 +3987,10 @@
(def: (exported_definitions module state)
(-> Text (Meta (List Text)))
(let [[current_module modules] (case state
- {#info info #source source #current_module current_module #modules modules
+ [#info info #source source #current_module current_module #modules modules
#scopes scopes #type_context types #host host
#seed seed #expected expected #location location #extensions extensions
- #scope_type_vars scope_type_vars #eval _eval}
+ #scope_type_vars scope_type_vars #eval _eval]
[current_module modules])]
(case (plist\value module modules)
(#Some =module)
@@ -4018,7 +4016,7 @@
(#Slot _)
(list))))
- (let [{#module_hash _ #module_aliases _ #definitions definitions #imports _ #module_annotations _ #module_state _} =module]
+ (let [[#module_hash _ #module_aliases _ #definitions definitions #imports _ #module_annotations _ #module_state _] =module]
definitions))]
(#Right state (list\conjoint to_alias)))
@@ -4069,17 +4067,17 @@
(def: (in_env name state)
(-> Text Lux (Maybe Type))
(case state
- {#info info #source source #current_module _ #modules modules
+ [#info info #source source #current_module _ #modules modules
#scopes scopes #type_context types #host host
#seed seed #expected expected #location location #extensions extensions
- #scope_type_vars scope_type_vars #eval _eval}
+ #scope_type_vars scope_type_vars #eval _eval]
(list\one (: (-> Scope (Maybe Type))
(function (_ env)
(case env
- {#name _
+ [#name _
#inner _
- #locals {#counter _ #mappings locals}
- #captured {#counter _ #mappings closure}}
+ #locals [#counter _ #mappings locals]
+ #captured [#counter _ #mappings closure]]
(on_either (list\one (: (-> [Text [Type Any]] (Maybe Type))
(function (_ [bname [type _]])
(if (text\= name bname)
@@ -4092,15 +4090,15 @@
(def: (definition_type name state)
(-> Name Lux (Maybe Type))
(let [[v_module v_name] name
- {#info info #source source #current_module _ #modules modules
+ [#info info #source source #current_module _ #modules modules
#scopes scopes #type_context types #host host
#seed seed #expected expected #location location #extensions extensions
- #scope_type_vars scope_type_vars #eval _eval} state]
+ #scope_type_vars scope_type_vars #eval _eval] state]
(case (plist\value v_module modules)
#None
#None
- (#Some {#definitions definitions #module_hash _ #module_aliases _ #imports _ #module_annotations _ #module_state _})
+ (#Some [#definitions definitions #module_hash _ #module_aliases _ #imports _ #module_annotations _ #module_state _])
(case (plist\value v_name definitions)
#None
#None
@@ -4125,15 +4123,15 @@
(def: (definition_value name state)
(-> Name (Meta [Type Any]))
(let [[v_module v_name] name
- {#info info #source source #current_module _ #modules modules
+ [#info info #source source #current_module _ #modules modules
#scopes scopes #type_context types #host host
#seed seed #expected expected #location location #extensions extensions
- #scope_type_vars scope_type_vars #eval _eval} state]
+ #scope_type_vars scope_type_vars #eval _eval] state]
(case (plist\value v_module modules)
#None
(#Left (text\composite "Unknown definition: " (name\encoded name)))
- (#Some {#definitions definitions #module_hash _ #module_aliases _ #imports _ #module_annotations _ #module_state _})
+ (#Some [#definitions definitions #module_hash _ #module_aliases _ #imports _ #module_annotations _ #module_state _])
(case (plist\value v_name definitions)
#None
(#Left (text\composite "Unknown definition: " (name\encoded name)))
@@ -4192,11 +4190,11 @@
(#Left ($_ text\composite "Unknown var: " (name\encoded full_name)))))]
(case temp
(#Right [compiler (#Var type_id)])
- (let [{#info _ #source _ #current_module _ #modules _
+ (let [[#info _ #source _ #current_module _ #modules _
#scopes _ #type_context type_context #host _
#seed _ #expected _ #location _ #extensions extensions
- #scope_type_vars _ #eval _eval} compiler
- {#ex_counter _ #var_counter _ #var_bindings var_bindings} type_context]
+ #scope_type_vars _ #eval _eval] compiler
+ [#ex_counter _ #var_counter _ #var_bindings var_bindings] type_context]
(case (type_variable type_id var_bindings)
#None
temp
@@ -4309,13 +4307,15 @@
g!output (..identifier "")]
(case (interface_methods type)
(#Some members)
- (let [pattern (record$ (list\each (: (-> [Name [Nat Type]] [Code Code])
- (function (_ [[r_module r_name] [r_idx r_type]])
- [(tag$ [r_module r_name])
+ (let [pattern (|> (zipped/2 tags (enumeration members))
+ (list\each (: (-> [Name [Nat Type]] (List Code))
+ (function (_ [[r_module r_name] [r_idx r_type]])
+ (list (tag$ [r_module r_name])
(if ("lux i64 =" idx r_idx)
g!output
- g!_)]))
- (zipped/2 tags (enumeration members))))]
+ g!_)))))
+ list\conjoint
+ tuple$)]
(in_meta (list (` ({(~ pattern) (~ g!output)} (~ record))))))
_
@@ -4415,7 +4415,7 @@
(-> Text Text (Meta Bit))
(do meta_monad
[module (module module_name)
- .let [{#module_hash _ #module_aliases _ #definitions _ #imports imports #module_annotations _ #module_state _} module]]
+ .let [[#module_hash _ #module_aliases _ #definitions _ #imports imports #module_annotations _ #module_state _] module]]
(in (is_member? imports import_name))))
(def: (referrals module_name options)
@@ -4428,8 +4428,8 @@
current_module current_module_name]
(case options
#End
- (in {#refer_defs referral
- #refer_open openings})
+ (in [#refer_defs referral
+ #refer_open openings])
_
(failure ($_ text\composite "Wrong syntax for refer @ " current_module
@@ -4575,18 +4575,22 @@
[g!slot (..identifier "")]
(in_meta [r_slot_name r_idx g!slot]))))
(zipped/2 tags (enumeration members)))]
- (let [pattern (record$ (list\each (: (-> [Name Nat Code] [Code Code])
- (function (_ [r_slot_name r_idx r_var])
- [(tag$ r_slot_name)
- r_var]))
- pattern'))
- output (record$ (list\each (: (-> [Name Nat Code] [Code Code])
- (function (_ [r_slot_name r_idx r_var])
- [(tag$ r_slot_name)
+ (let [pattern (|> pattern'
+ (list\each (: (-> [Name Nat Code] (List Code))
+ (function (_ [r_slot_name r_idx r_var])
+ (list (tag$ r_slot_name)
+ r_var))))
+ list\conjoint
+ tuple$)
+ output (|> pattern'
+ (list\each (: (-> [Name Nat Code] (List Code))
+ (function (_ [r_slot_name r_idx r_var])
+ (list (tag$ r_slot_name)
(if ("lux i64 =" idx r_idx)
value
- r_var)]))
- pattern'))]
+ r_var)))))
+ list\conjoint
+ tuple$)]
(in_meta (list (` ({(~ pattern) (~ output)} (~ record)))))))
_
@@ -4654,18 +4658,22 @@
[g!slot (..identifier "")]
(in_meta [r_slot_name r_idx g!slot]))))
(zipped/2 tags (enumeration members)))]
- (let [pattern (record$ (list\each (: (-> [Name Nat Code] [Code Code])
- (function (_ [r_slot_name r_idx r_var])
- [(tag$ r_slot_name)
- r_var]))
- pattern'))
- output (record$ (list\each (: (-> [Name Nat Code] [Code Code])
- (function (_ [r_slot_name r_idx r_var])
- [(tag$ r_slot_name)
+ (let [pattern (|> pattern'
+ (list\each (: (-> [Name Nat Code] (List Code))
+ (function (_ [r_slot_name r_idx r_var])
+ (list (tag$ r_slot_name)
+ r_var))))
+ list\conjoint
+ tuple$)
+ output (|> pattern'
+ (list\each (: (-> [Name Nat Code] (List Code))
+ (function (_ [r_slot_name r_idx r_var])
+ (list (tag$ r_slot_name)
(if ("lux i64 =" idx r_idx)
(` ((~ fun) (~ r_var)))
- r_var)]))
- pattern'))]
+ r_var)))))
+ list\conjoint
+ tuple$)]
(in_meta (list (` ({(~ pattern) (~ output)} (~ record)))))))
_
@@ -4854,13 +4862,15 @@
(function (_ [module name])
[name (local_identifier$ name)]))
(list& hslot tslots))
- pattern (record$ (list\each (: (-> Name [Code Code])
- (function (_ [module name])
- (let [tag (tag$ [module name])]
- (case (plist\value name slot_pairings)
- (#Some binding) [tag binding]
- #None [tag g!_]))))
- tags))]]
+ pattern (|> tags
+ (list\each (: (-> Name (List Code))
+ (function (_ [module name])
+ (let [tag (tag$ [module name])]
+ (case (plist\value name slot_pairings)
+ (#Some binding) (list tag binding)
+ #None (list tag g!_))))))
+ list\conjoint
+ tuple$)]]
(in_meta (list& pattern body branches)))
_
@@ -5109,10 +5119,10 @@
(def: (scope_type_vars state)
(Meta (List Nat))
(case state
- {#info info #source source #current_module _ #modules modules
+ [#info info #source source #current_module _ #modules modules
#scopes scopes #type_context types #host host
#seed seed #expected expected #location location #extensions extensions
- #scope_type_vars scope_type_vars #eval _eval}
+ #scope_type_vars scope_type_vars #eval _eval]
(#Right [state scope_type_vars])))
(macro: .public (:parameter tokens)
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-01 05:03:38 +0000