From 891b1cfc82322f8017f0a4f6b707d6fe52024545 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 3 Sep 2021 21:51:30 -0400 Subject: Unified tuple and record syntax. --- stdlib/source/library/lux.lux | 298 ++++++++++++++++++++++-------------------- 1 file changed, 154 insertions(+), 144 deletions(-) (limited to 'stdlib/source/library/lux.lux') 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) -- cgit v1.2.3