aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2021-09-15 01:52:03 -0400
committerEduardo Julian2021-09-15 01:52:03 -0400
commit86c04a4ce3be995edf14ae7f3bf1e137d478c40e (patch)
treed3bc5299e0e82b8253648d6abc8af79de77e5f89
parentfbecb061fb8530ad7d04e8e3f67605e2964822e4 (diff)
Correctly analyzing records in the presence of local bindings.
-rw-r--r--lux-bootstrapper/src/lux/analyser/case.clj2
-rw-r--r--lux-bootstrapper/src/lux/analyser/lux.clj44
-rw-r--r--lux-bootstrapper/src/lux/analyser/module.clj16
-rw-r--r--lux-bootstrapper/src/lux/analyser/record.clj44
-rw-r--r--lux-jvm/source/luxc/lang/directive/jvm.lux4
-rw-r--r--lux-jvm/source/luxc/lang/host/jvm/inst.lux2
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/case.lux2
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux2
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/function.lux2
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/runtime.lux2
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/structure.lux2
-rw-r--r--stdlib/source/library/lux.lux170
-rw-r--r--stdlib/source/library/lux/target/jvm/reflection.lux2
-rw-r--r--stdlib/source/library/lux/target/jvm/type/alias.lux2
-rw-r--r--stdlib/source/library/lux/target/jvm/type/lux.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux105
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux2
-rw-r--r--stdlib/source/test/lux.lux16
20 files changed, 243 insertions, 182 deletions
diff --git a/lux-bootstrapper/src/lux/analyser/case.clj b/lux-bootstrapper/src/lux/analyser/case.clj
index 0f892a5ca..39adc09f5 100644
--- a/lux-bootstrapper/src/lux/analyser/case.clj
+++ b/lux-bootstrapper/src/lux/analyser/case.clj
@@ -336,7 +336,7 @@
(analyse-pattern var?? value-type ?member kont)
(&/$Tuple ?members)
- (|do [rec-members&rec-type (&&record/order-record ?members)]
+ (|do [rec-members&rec-type (&&record/order-record true ?members)]
(|case rec-members&rec-type
(&/$Some [rec-members rec-type])
(|do [must-infer? (&type/unknown? value-type)
diff --git a/lux-bootstrapper/src/lux/analyser/lux.clj b/lux-bootstrapper/src/lux/analyser/lux.clj
index 6b90dc31e..842ad22ef 100644
--- a/lux-bootstrapper/src/lux/analyser/lux.clj
+++ b/lux-bootstrapper/src/lux/analyser/lux.clj
@@ -265,7 +265,7 @@
(analyse-variant analyse (&/$Right exo-type) idx is-last? values)))))
(defn analyse-record [analyse exo-type ?elems]
- (|do [rec-members&rec-type (&&record/order-record ?elems)]
+ (|do [rec-members&rec-type (&&record/order-record false ?elems)]
(|case rec-members&rec-type
(&/$Some [rec-members rec-type])
(|case exo-type
@@ -296,38 +296,30 @@
(&&/$def (&/T [r-module r-name])))))))
(defn ^:private analyse-local [analyse exo-type name]
- (fn [state]
- (|let [stack (&/get$ &/$scopes state)
- no-binding? #(and (->> % (&/get$ &/$locals) (&/get$ &/$mappings) (&/|contains? name) not)
- (->> % (&/get$ &/$captured) (&/get$ &/$mappings) (&/|contains? name) not))
- [inner outer] (&/|split-with no-binding? stack)]
- (|case outer
- (&/$End)
- (&/run-state (|do [module-name &/get-module-name]
- (analyse-global analyse exo-type module-name name))
- state)
-
- (&/$Item bottom-outer _)
- (|let [scopes (&/|map #(&/get$ &/$name %) (&/|reverse inner))
- [=local inner*] (&/fold2 (fn [register+new-inner frame in-scope]
- (|let [[register new-inner] register+new-inner
- [register* frame*] (&&function/close-over in-scope name register frame)]
- (&/T [register* (&/$Item frame* new-inner)])))
- (&/T [(&/|second (or (->> bottom-outer (&/get$ &/$locals) (&/get$ &/$mappings) (&/|get name))
- (->> bottom-outer (&/get$ &/$captured) (&/get$ &/$mappings) (&/|get name))))
- &/$End])
- (&/|reverse inner) scopes)]
+ (|do [local? (&&module/find_local name)]
+ (|case local?
+ (&/$None)
+ (|do [module-name &/get-module-name]
+ (analyse-global analyse exo-type module-name name))
+
+ (&/$Some [local inner outer])
+ (|let [scopes (&/|map #(&/get$ &/$name %) inner)
+ [=local inner*] (&/fold2 (fn [register+new-inner frame in-scope]
+ (|let [[register new-inner] register+new-inner
+ [register* frame*] (&&function/close-over in-scope name register frame)]
+ (&/T [register* (&/$Item frame* new-inner)])))
+ (&/T [local &/$End])
+ inner scopes)]
+ (fn [state]
((|do [_ (&type/check exo-type (&&/expr-type* =local))]
(return (&/|list =local)))
- (&/set$ &/$scopes (&/|++ inner* outer) state)))
- ))))
+ (&/set$ &/$scopes (&/|++ inner* outer) state)))))))
(defn analyse-identifier [analyse exo-type ident]
(|do [:let [[?module ?name] ident]]
(if (= "" ?module)
(analyse-local analyse exo-type ?name)
- (analyse-global analyse exo-type ?module ?name))
- ))
+ (analyse-global analyse exo-type ?module ?name))))
(defn ^:private analyse-apply* [analyse exo-type fun-type ?args]
(|case ?args
diff --git a/lux-bootstrapper/src/lux/analyser/module.clj b/lux-bootstrapper/src/lux/analyser/module.clj
index 8c3a83440..1cf3f6f4f 100644
--- a/lux-bootstrapper/src/lux/analyser/module.clj
+++ b/lux-bootstrapper/src/lux/analyser/module.clj
@@ -520,3 +520,19 @@
_
(&/fail-with-loc "[Analyser Error] Incorrect import syntax.")))
+
+(defn find_local [name]
+ (fn [state]
+ (|let [stack (&/get$ &/$scopes state)
+ no-binding? #(and (->> % (&/get$ &/$locals) (&/get$ &/$mappings) (&/|contains? name) not)
+ (->> % (&/get$ &/$captured) (&/get$ &/$mappings) (&/|contains? name) not))
+ [inner outer] (&/|split-with no-binding? stack)]
+ (|case outer
+ (&/$End)
+ (return* state &/$None)
+
+ (&/$Item bottom-outer _)
+ (let [local (&/|second (or (->> bottom-outer (&/get$ &/$locals) (&/get$ &/$mappings) (&/|get name))
+ (->> bottom-outer (&/get$ &/$captured) (&/get$ &/$mappings) (&/|get name))))]
+ (return* state (&/$Some (&/T [local (&/|reverse inner) outer]))))
+ ))))
diff --git a/lux-bootstrapper/src/lux/analyser/record.clj b/lux-bootstrapper/src/lux/analyser/record.clj
index ecdee63f6..913de4a64 100644
--- a/lux-bootstrapper/src/lux/analyser/record.clj
+++ b/lux-bootstrapper/src/lux/analyser/record.clj
@@ -6,10 +6,26 @@
(lux.analyser [base :as &&]
[module :as &&module])))
+(defn head_slot [slot0]
+ (|do [[module name] (&&/resolved-ident slot0)
+ _exported?&type&slots&_index (fn [lux]
+ (|case ((&&module/find-slot module name) lux)
+ (&/$Left error)
+ (&/$Right (&/T [lux &/$None]))
+
+ (&/$Right [lux* output])
+ (&/$Right (&/T [lux* (&/$Some output)]))))]
+ (return (|case _exported?&type&slots&_index
+ (&/$Some [_exported? type slots _index])
+ (&/$Some (&/T [module slots type]))
+
+ (&/$None)
+ &/$None))))
+
;; [Exports]
(defn order-record
"(-> (List Syntax) (Lux (Maybe (List Syntax))))"
- [pairs]
+ [pattern_matching? pairs]
(if (even? (&/|length pairs))
(let [pairs (&/|as-pairs pairs)]
(|do [module&slot-group&slot-type (|case pairs
@@ -18,20 +34,20 @@
(return (&/$Some (&/T [module &/$End &type/Any]))))
(&/$Item [[_ (&/$Identifier slot0)] _] _)
- (|do [[module name] (&&/resolved-ident slot0)
- _exported?&type&slots&_index (fn [lux]
- (|case ((&&module/find-slot module name) lux)
- (&/$Left error)
- (&/$Right (&/T [lux &/$None]))
-
- (&/$Right [lux* output])
- (&/$Right (&/T [lux* (&/$Some output)]))))]
- (|case _exported?&type&slots&_index
- (&/$Some [_exported? type slots _index])
- (return (&/$Some (&/T [module slots type])))
+ (|case slot0
+ ["" short0]
+ (if pattern_matching?
+ (return &/$None)
+ (|do [local? (&&module/find_local short0)]
+ (|case local?
+ (&/$None)
+ (head_slot slot0)
- (&/$None)
- (return &/$None)))
+ (&/$Some [local _inner _outer])
+ (return &/$None))))
+
+ [module0 short0]
+ (head_slot slot0))
_
(return &/$None))]
diff --git a/lux-jvm/source/luxc/lang/directive/jvm.lux b/lux-jvm/source/luxc/lang/directive/jvm.lux
index 1d1c4c278..e22d9c427 100644
--- a/lux-jvm/source/luxc/lang/directive/jvm.lux
+++ b/lux-jvm/source/luxc/lang/directive/jvm.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux {"-" Type static local}
+ [lux {"-" Type Primitive static local}
["[0]" ffi {"+" Inheritance Privacy State import:}]
[abstract
["[0]" monad {"+" do}]]
@@ -540,7 +540,7 @@
<type_vars> (as_is <anchor> <expression> <directive>)]
(type: Handler'
... (generation.Handler jvm.Anchor (/.Bytecode Inst /.Label) jvm.Definition)
- (-> extension.Symbol
+ (-> extension.Name
(phase.Phase [(extension.Bundle <type_vars>)
(generation.State <type_vars>)]
Synthesis
diff --git a/lux-jvm/source/luxc/lang/host/jvm/inst.lux b/lux-jvm/source/luxc/lang/host/jvm/inst.lux
index 1384d1a73..597426143 100644
--- a/lux-jvm/source/luxc/lang/host/jvm/inst.lux
+++ b/lux-jvm/source/luxc/lang/host/jvm/inst.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux {"-" Type int char try}
+ [lux {"-" Type Primitive int char try}
["[0]" ffi {"+" import: do_to}]
[abstract
[monad {"+" do}]]
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/case.lux b/lux-jvm/source/luxc/lang/translation/jvm/case.lux
index 032b058df..1cded57dd 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/case.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/case.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux {"-" Type Label if let case}
+ [lux {"-" Type Label Primitive if let case}
[abstract
["[0]" monad {"+" do}]]
[control
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
index a8becd813..c31d9b90b 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux {"-" Type Label primitive int char type}
+ [lux {"-" Type Label Primitive int char type}
[ffi {"+" import:}]
[abstract
["[0]" monad {"+" do}]]
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/function.lux b/lux-jvm/source/luxc/lang/translation/jvm/function.lux
index 17a246833..441eac0f6 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/function.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/function.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux {"-" Type Label function}
+ [lux {"-" Type Label Primitive function}
[abstract
["[0]" monad {"+" do}]
["[0]" enum]]
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux
index ae14639f0..58d07e663 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux {"-" Type Label try}
+ [lux {"-" Type Label Primitive try}
[abstract
[monad {"+" do}]
["[0]" enum]]
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux
index bccdf5ec0..81f3faaa8 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux {"-" Type}
+ [lux {"-" Type Primitive}
["[0]" ffi {"+" import:}]
[abstract
["[0]" monad {"+" do}]]
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux
index ad9fcc8d8..d154f0826 100644
--- a/stdlib/source/library/lux.lux
+++ b/stdlib/source/library/lux.lux
@@ -1046,15 +1046,15 @@
(def:'' .private (initialized_quantification? lux)
{#Function Lux Bit}
- ({[#info _ #source _ #current_module _ #modules _
- #scopes scopes #type_context _ #host _
- #seed _ #expected _ #location _ #extensions _
- #scope_type_vars _ #eval _]
+ ({[..#info _ ..#source _ ..#current_module _ ..#modules _
+ ..#scopes scopes ..#type_context _ ..#host _
+ ..#seed _ ..#expected _ ..#location _ ..#extensions _
+ ..#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 _ ("lux text =" ..quantification_level local)}
@@ -1449,7 +1449,7 @@
(-> a ($' m b))
($' List a)
($' m ($' List b))))
- (let' [[#in in #then _] m]
+ (let' [[..#in in ..#then _] m]
({{#End}
(in {#End})
@@ -1467,7 +1467,7 @@
b
($' List a)
($' m b)))
- (let' [[#in in #then _] m]
+ (let' [[..#in in ..#then _] m]
({{#End}
(in y)
@@ -1517,11 +1517,11 @@
(def:''' .private (global_symbol full_name state)
(-> Symbol ($' Meta Symbol))
(let' [[module name] full_name
- [#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_state _]}
+ [..#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_state _]}
({{#Some constant}
({{#Definition _} {#Right [state full_name]}
{#Tag _} {#Right [state full_name]}
@@ -1673,10 +1673,10 @@
(def:'' .private (current_module_name state)
($' Meta Text)
- ({[#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]
+ ({[..#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]
({{#Some module_name}
{#Right [state module_name]}
@@ -1982,7 +1982,7 @@
($' Maybe Macro))
(do maybe_monad
[$module (plist#value module modules)
- gdef (let' [[#module_hash _ #module_aliases _ #definitions bindings #imports _ #module_state _] ("lux type check" Module $module)]
+ gdef (let' [[..#module_hash _ ..#module_aliases _ ..#definitions bindings ..#imports _ ..#module_state _] ("lux type check" Module $module)]
(plist#value name bindings))]
({{#Alias [r_module r_name]}
(macro'' modules current_module r_module r_name)
@@ -2023,11 +2023,11 @@
[current_module current_module_name]
(let' [[module name] full_name]
(function' [state]
- ({[#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]
+ ({[..#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 state (macro'' modules current_module module name)}}
state)))))
@@ -2281,16 +2281,16 @@
(def:''' .private (generated_symbol prefix state)
(-> Text ($' Meta Code))
- ({[#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
- #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]
+ ({[..#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
+ ..#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]
(local_symbol$ ($_ text#composite "__gensym__" prefix (nat#encoded seed)))}}
state))
@@ -2849,10 +2849,10 @@
(def: (module name)
(-> Text (Meta Module))
(function (_ state)
- (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]
+ (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]
(case (plist#value name modules)
{#Some module}
{#Right state module}
@@ -2864,7 +2864,11 @@
(-> Symbol (Meta [Nat (List Symbol) Bit Type]))
(do meta_monad
[=module (..module module)
- .let [[#module_hash _ #module_aliases _ #definitions definitions #imports _ #module_state _] =module]]
+ .let [[..#module_hash _
+ ..#module_aliases _
+ ..#definitions definitions
+ ..#imports _
+ ..#module_state _] =module]]
(case (plist#value name definitions)
{#Some {#Slot [exported type group index]}}
(in_meta [index
@@ -2892,7 +2896,11 @@
{#Named [module name] unnamed}
(do meta_monad
[=module (..module module)
- .let [[#module_hash _ #module_aliases _ #definitions definitions #imports _ #module_state _] =module]]
+ .let [[..#module_hash _
+ ..#module_aliases _
+ ..#definitions definitions
+ ..#imports _
+ ..#module_state _] =module]]
(case (plist#value name definitions)
{#Some {#Type [exported? {#Named _ _type} {#Right slots}]}}
(case (interface_methods _type)
@@ -2913,10 +2921,10 @@
(def: expected_type
(Meta Type)
(function (_ state)
- (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]
+ (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]
(case expected
{#Some type}
{#Right state type}
@@ -3512,10 +3520,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
- #scopes scopes #type_context types #host host
- #seed seed #expected expected #location location #extensions extensions
- #scope_type_vars scope_type_vars #eval _eval]
+ [..#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]
[current_module modules])]
(case (plist#value module modules)
{#Some =module}
@@ -3541,7 +3549,7 @@
{#Slot _}
(list))))
- (let [[#module_hash _ #module_aliases _ #definitions definitions #imports _ #module_state _] =module]
+ (let [[..#module_hash _ ..#module_aliases _ ..#definitions definitions ..#imports _ ..#module_state _] =module]
definitions))]
{#Right state (list#conjoint to_alias)})
@@ -3592,17 +3600,17 @@
(def: (in_env name state)
(-> Text Lux (Maybe Type))
(case state
- [#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]
+ [..#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]
(list#one (: (-> Scope (Maybe Type))
(function (_ env)
(case env
- [#name _
- #inner _
- #locals [#counter _ #mappings locals]
- #captured [#counter _ #mappings closure]]
+ [..#name _
+ ..#inner _
+ ..#locals [..#counter _ ..#mappings locals]
+ ..#captured [..#counter _ ..#mappings closure]]
(on_either (list#one (: (-> [Text [Type Any]] (Maybe Type))
(function (_ [bname [type _]])
(if (text#= name bname)
@@ -3615,15 +3623,19 @@
(def: (definition_type name state)
(-> Symbol Lux (Maybe Type))
(let [[v_module v_name] name
- [#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]
+ [..#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]
(case (plist#value v_module modules)
{#None}
{#None}
- {#Some [#definitions definitions #module_hash _ #module_aliases _ #imports _ #module_state _]}
+ {#Some [..#definitions definitions
+ ..#module_hash _
+ ..#module_aliases _
+ ..#imports _
+ ..#module_state _]}
(case (plist#value v_name definitions)
{#None}
{#None}
@@ -3648,15 +3660,19 @@
(def: (definition_value name state)
(-> Symbol (Meta [Type Any]))
(let [[v_module v_name] name
- [#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]
+ [..#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]
(case (plist#value v_module modules)
{#None}
{#Left (text#composite "Unknown definition: " (symbol#encoded name))}
- {#Some [#definitions definitions #module_hash _ #module_aliases _ #imports _ #module_state _]}
+ {#Some [..#definitions definitions
+ ..#module_hash _
+ ..#module_aliases _
+ ..#imports _
+ ..#module_state _]}
(case (plist#value v_name definitions)
{#None}
{#Left (text#composite "Unknown definition: " (symbol#encoded name))}
@@ -3715,11 +3731,11 @@
{#Left ($_ text#composite "Unknown var: " (symbol#encoded full_name))}))]
(case temp
{#Right [compiler {#Var type_id}]}
- (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]
+ (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]
(case (type_variable type_id var_bindings)
{#None}
temp
@@ -3946,7 +3962,7 @@
(-> Text Text (Meta Bit))
(do meta_monad
[module (module module_name)
- .let [[#module_hash _ #module_aliases _ #definitions _ #imports imports #module_state _] module]]
+ .let [[..#module_hash _ ..#module_aliases _ ..#definitions _ ..#imports imports ..#module_state _] module]]
(in (is_member? imports import_name))))
(def: (referrals module_name options)
@@ -4572,10 +4588,10 @@
(def: (scope_type_vars state)
(Meta (List Nat))
(case state
- [#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]
+ [..#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 [state scope_type_vars]}))
(macro: .public (:parameter tokens)
diff --git a/stdlib/source/library/lux/target/jvm/reflection.lux b/stdlib/source/library/lux/target/jvm/reflection.lux
index 0a40c6cee..a62754a24 100644
--- a/stdlib/source/library/lux/target/jvm/reflection.lux
+++ b/stdlib/source/library/lux/target/jvm/reflection.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux {"-" type}
+ [lux {"-" Primitive type}
["[0]" ffi {"+" import:}]
["[0]" type]
[abstract
diff --git a/stdlib/source/library/lux/target/jvm/type/alias.lux b/stdlib/source/library/lux/target/jvm/type/alias.lux
index 022315da8..8ab181c6c 100644
--- a/stdlib/source/library/lux/target/jvm/type/alias.lux
+++ b/stdlib/source/library/lux/target/jvm/type/alias.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux {"-" Type int char type primitive}
+ [lux {"-" Type Primitive int char type}
[abstract
["[0]" monad {"+" do}]]
[control
diff --git a/stdlib/source/library/lux/target/jvm/type/lux.lux b/stdlib/source/library/lux/target/jvm/type/lux.lux
index d6ffa3fbd..a219d9ef2 100644
--- a/stdlib/source/library/lux/target/jvm/type/lux.lux
+++ b/stdlib/source/library/lux/target/jvm/type/lux.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux {"-" int char type primitive}
+ [lux {"-" Primitive int char type}
[abstract
["[0]" monad {"+" do}]]
[control
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux
index c7339a509..03e7f2105 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux
@@ -251,7 +251,7 @@
record_size,members,recordT (: (Operation (Maybe [Nat (List Code) Type]))
(.case record
{.#Some record}
- (//structure.order record)
+ (//structure.order true record)
{.#None}
(in {.#None})))]
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux
index ae20d2c6f..0273dd26c 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux
@@ -11,7 +11,7 @@
["[0]" state]]
[data
["[0]" product]
- [text
+ ["[0]" text ("[1]#[0]" equivalence)
["%" format {"+" format}]]
[collection
["[0]" list ("[1]#[0]" monad)]
@@ -322,55 +322,76 @@
_
(# ///.monad in {.#None}))))
+(def: (local_binding? name)
+ (-> Text (Meta Bit))
+ (# meta.monad each
+ (list.any? (list.any? (|>> product.left (text#= name))))
+ meta.locals))
+
... Lux already possesses the means to analyse tuples, so
... re-implementing the same functionality for records makes no sense.
... Records, thus, get transformed into tuples by ordering the elements.
-(def: .public (order record)
- (-> (List [Symbol Code]) (Operation (Maybe [Nat (List Code) Type])))
+(def: (order' head_k record)
+ (-> Symbol (List [Symbol Code]) (Operation (Maybe [Nat (List Code) Type])))
+ (do [! ///.monad]
+ [slotH' (///extension.lifted
+ (do meta.monad
+ [head_k (meta.normal head_k)]
+ (meta.try (meta.slot head_k))))]
+ (case slotH'
+ {try.#Success [_ slot_set recordT]}
+ (do !
+ [.let [size_record (list.size record)
+ size_ts (list.size slot_set)]
+ _ (if (n.= size_ts size_record)
+ (in [])
+ (/.except ..record_size_mismatch [size_ts size_record recordT record]))
+ .let [tuple_range (list.indices size_ts)
+ tag->idx (dictionary.of_list symbol.hash (list.zipped/2 slot_set tuple_range))]
+ idx->val (monad.mix !
+ (function (_ [key val] idx->val)
+ (do !
+ [key (///extension.lifted (meta.normal key))]
+ (case (dictionary.value key tag->idx)
+ {.#Some idx}
+ (if (dictionary.key? idx->val idx)
+ (/.except ..cannot_repeat_slot [key record])
+ (in (dictionary.has idx val idx->val)))
+
+ {.#None}
+ (/.except ..slot_does_not_belong_to_record [key recordT]))))
+ (: (Dictionary Nat Code)
+ (dictionary.empty n.hash))
+ record)
+ .let [ordered_tuple (list#each (function (_ idx)
+ (maybe.trusted (dictionary.value idx idx->val)))
+ tuple_range)]]
+ (in {.#Some [size_ts ordered_tuple recordT]}))
+
+ {try.#Failure error}
+ (in {.#None}))))
+
+(def: .public (order pattern_matching? record)
+ (-> Bit (List [Symbol Code]) (Operation (Maybe [Nat (List Code) Type])))
(case record
... empty_record = empty_tuple = unit/any = []
{.#End}
(# ///.monad in {.#Some [0 (list) Any]})
{.#Item [head_k head_v] _}
- (do [! ///.monad]
- [slotH' (///extension.lifted
- (do meta.monad
- [head_k (meta.normal head_k)]
- (meta.try (meta.slot head_k))))]
- (case slotH'
- {try.#Success [_ slot_set recordT]}
- (do !
- [.let [size_record (list.size record)
- size_ts (list.size slot_set)]
- _ (if (n.= size_ts size_record)
- (in [])
- (/.except ..record_size_mismatch [size_ts size_record recordT record]))
- .let [tuple_range (list.indices size_ts)
- tag->idx (dictionary.of_list symbol.hash (list.zipped/2 slot_set tuple_range))]
- idx->val (monad.mix !
- (function (_ [key val] idx->val)
- (do !
- [key (///extension.lifted (meta.normal key))]
- (case (dictionary.value key tag->idx)
- {.#Some idx}
- (if (dictionary.key? idx->val idx)
- (/.except ..cannot_repeat_slot [key record])
- (in (dictionary.has idx val idx->val)))
-
- {.#None}
- (/.except ..slot_does_not_belong_to_record [key recordT]))))
- (: (Dictionary Nat Code)
- (dictionary.empty n.hash))
- record)
- .let [ordered_tuple (list#each (function (_ idx)
- (maybe.trusted (dictionary.value idx idx->val)))
- tuple_range)]]
- (in {.#Some [size_ts ordered_tuple recordT]}))
-
- {try.#Failure error}
- (in {.#None})))
- ))
+ (case head_k
+ ["" head_k']
+ (if pattern_matching?
+ (# ///.monad in {.#None})
+ (do ///.monad
+ [local_binding? (///extension.lifted
+ (local_binding? head_k'))]
+ (if local_binding?
+ (order' head_k record)
+ (in {.#None}))))
+
+ _
+ (order' head_k record))))
(def: .public (record archive analyse members)
(-> Archive Phase (List Code) (Operation Analysis))
@@ -403,7 +424,7 @@
{.#Some slots}
(do !
- [record_size,membersC,recordT (..order slots)]
+ [record_size,membersC,recordT (..order false slots)]
(case record_size,membersC,recordT
{.#None}
(..product archive analyse members)
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
index 2b2290cb3..9a1a9763d 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux {"-" Type Module primitive type char int}
+ [lux {"-" Type Module Primitive type char int}
["[0]" ffi {"+" import:}]
["[0]" meta]
[abstract
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux
index bdad01192..1f4d88c99 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux {"-" Type type}
+ [lux {"-" Type Primitive type}
[target
[jvm
["_" bytecode {"+" Bytecode}]
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index 867fe04ed..932611eed 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -892,8 +892,8 @@
#right r]))
(template: (!pair <left> <right>)
- [[#left <left>
- #right <right>]])
+ [[..#left <left>
+ ..#right <right>]])
(def: for_case
Test
@@ -929,8 +929,8 @@
(/.case [expected_nat expected_int]
[0 +0] true
_ false)
- (/.case [#left expected_nat #right expected_int]
- [#left 0 #right +0] true
+ (/.case [..#left expected_nat ..#right expected_int]
+ [..#left 0 ..#right +0] true
_ false)
(/.case (: (Either Nat Int) {.#Left expected_nat})
{.#Left 0} true
@@ -950,12 +950,12 @@
(/.^or "+0.5" "+1.25") true
_ false)))
(_.cover [/.^]
- (/.case [#left expected_nat #right expected_int]
+ (/.case [..#left expected_nat ..#right expected_int]
(/.^ (!pair 0 +0)) true
_ false))
(_.cover [/.^@]
(let [expected_pair (: (Pair Nat Int)
- [#left expected_nat #right expected_int])]
+ [..#left expected_nat ..#right expected_int])]
(/.case expected_pair
(/.^@ actual_pair (/.^ (!pair actual_left actual_right)))
(and (/.same? expected_pair actual_pair)
@@ -963,7 +963,7 @@
(/.same? expected_int actual_right)))))
(_.cover [/.^multi]
(let [expected_pair (: (Pair Nat Int)
- [#left expected_nat #right expected_int])]
+ [..#left expected_nat ..#right expected_int])]
(and (/.case expected_pair
(/.^multi (/.^ (!pair 0 actual_right))
[actual_right
@@ -992,7 +992,7 @@
(_.cover [/.let]
(and (/.let [actual_nat expected_nat]
(/.same? expected_nat actual_nat))
- (/.let [[actual_left actual_right] [#left expected_nat #right expected_int]]
+ (/.let [[actual_left actual_right] [..#left expected_nat ..#right expected_int]]
(and (/.same? expected_nat actual_left)
(/.same? expected_int actual_right)))))
)))