aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/tool/compiler
diff options
context:
space:
mode:
authorEduardo Julian2022-02-16 02:32:09 -0400
committerEduardo Julian2022-02-16 02:32:09 -0400
commitb68f2b6aead6224c14902c80fc00c27705eece6c (patch)
tree69fae48b3cf5ad137ea3ad1e03d490a445f4ef91 /stdlib/source/library/lux/tool/compiler
parent8b6d474dd5d2b323d1dba29359460af4708402ea (diff)
FIXED generating artifact IDs in the context of "lux in-module".
Diffstat (limited to 'stdlib/source/library/lux/tool/compiler')
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux18
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/analysis/coverage.lux (renamed from stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux)443
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/analysis/evaluation.lux48
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/analysis/pattern.lux4
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux14
5 files changed, 276 insertions, 251 deletions
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux
index 65b191979..5ac2fda49 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux
@@ -8,7 +8,7 @@
[control
["[0]" function]
["[0]" maybe]
- ["[0]" try]
+ ["[0]" try {"+" Try}]
["[0]" exception {"+" Exception}]
[parser
["<[0]>" code]]]
@@ -280,7 +280,7 @@
failure
failure)))))
-(def: (locate_error location error)
+(def: (located location error)
(-> Location Text Text)
(%.format (%.location location) text.new_line
error))
@@ -288,7 +288,17 @@
(def: .public (failure error)
(-> Text Operation)
(function (_ [bundle state])
- {try.#Failure (locate_error (value@ .#location state) error)}))
+ {try.#Failure (located (value@ .#location state) error)}))
+
+(def: .public (of_try it)
+ (All (_ a) (-> (Try a) (Operation a)))
+ (function (_ [bundle state])
+ (.case it
+ {try.#Failure error}
+ {try.#Failure (located (value@ .#location state) error)}
+
+ {try.#Success it}
+ {try.#Success [[bundle state] it]})))
(def: .public (except exception parameters)
(All (_ e) (-> (Exception e) e Operation))
@@ -307,7 +317,7 @@
(action bundle,state))
{try.#Failure error}
(let [[bundle state] bundle,state]
- {try.#Failure (locate_error (value@ .#location state) error)})
+ {try.#Failure (located (value@ .#location state) error)})
success
success)))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/coverage.lux
index 7ec92c76b..71bc09f77 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/coverage.lux
@@ -1,46 +1,33 @@
(.using
[library
- [lux "*"
+ [lux {"-" Variant}
[abstract
equivalence
["[0]" monad {"+" do}]]
[control
- ["[0]" maybe]
- ["[0]" try {"+" Try} ("[1]#[0]" monad)]
+ ["[0]" maybe ("[1]#[0]" monoid monad)]
+ ["[0]" try {"+" Try}]
["[0]" exception {"+" exception:}]]
[data
["[0]" bit ("[1]#[0]" equivalence)]
["[0]" text
- ["%" format {"+" Format format}]]
+ ["%" format]]
[collection
["[0]" list ("[1]#[0]" functor mix)]
["[0]" dictionary {"+" Dictionary}]
- ["[0]" set {"+" Set}]]]
+ ["[0]" set {"+" Set} ("[1]#[0]" equivalence)]]]
+ [macro
+ ["[0]" template]]
[math
[number
- ["n" nat]
+ ["n" nat ("[1]#[0]" interval)]
["i" int]
["r" rev]
["f" frac]]]]]
- ["[0]" //// "_"
- [//
- ["/" analysis {"+" Operation}
- ["[1][0]" simple]
- ["[1][0]" complex]
- ["[1][0]" pattern {"+" Pattern}]]
- [///
- ["[1]" phase ("[1]#[0]" monad)]]]])
-
-(exception: .public invalid_tuple_pattern
- "Tuple size must be >= 2")
-
-(def: cases
- (-> (Maybe Nat) Nat)
- (|>> (maybe.else 0)))
-
-(def: known_cases?
- (-> Nat Bit)
- (n.> 0))
+ ["[0]" // "_"
+ ["[1][0]" simple]
+ ["[1][0]" complex]
+ ["[1][0]" pattern {"+" Pattern}]])
... The coverage of a pattern-matching expression summarizes how well
... all the possible values of an input are being covered by the
@@ -51,36 +38,92 @@
... Every other coverage is considered partial, and it would be valued
... as insuficient (since it could lead to runtime errors due to values
... not being handled by any pattern).
-(type: .public Coverage
- (Rec Coverage
- (Variant
- {#Bit Bit}
- {#Nat (Set Nat)}
- {#Int (Set Int)}
- {#Rev (Set Rev)}
- {#Frac (Set Frac)}
- {#Text (Set Text)}
- {#Variant (Maybe Nat) (Dictionary Nat Coverage)}
- {#Seq Coverage Coverage}
- {#Alt Coverage Coverage}
- {#Exhaustive})))
-
-(def: .public (exhaustive? coverage)
- (-> Coverage Bit)
+(template.let [(Variant' @)
+ [[(Maybe Nat) (Dictionary Nat @)]]]
+ (as_is (type: .public Coverage
+ (Rec @
+ (.Variant
+ {#Exhaustive}
+ {#Bit Bit}
+ {#Nat (Set Nat)}
+ {#Int (Set Int)}
+ {#Rev (Set Rev)}
+ {#Frac (Set Frac)}
+ {#Text (Set Text)}
+ {#Variant (Variant' @)}
+ {#Seq @ @}
+ {#Alt @ @})))
+
+ (type: .public Variant
+ (Variant' Coverage))))
+
+(def: .public (minimum [max cases])
+ (-> Variant Nat)
+ (maybe.else (|> cases
+ dictionary.keys
+ (list#mix n.max 0)
+ ++)
+ max))
+
+(def: .public (maximum [max cases])
+ (-> Variant Nat)
+ (maybe.else n#top max))
+
+(def: (alternatives coverage)
+ (-> Coverage (List Coverage))
(case coverage
- {#Exhaustive _}
- #1
+ {#Alt left right}
+ (list& left (alternatives right))
_
- #0))
+ (list coverage)))
-(def: .public (%coverage value)
- (Format Coverage)
+(implementation: .public equivalence
+ (Equivalence Coverage)
+
+ (def: (= reference sample)
+ (case [reference sample]
+ [{#Exhaustive} {#Exhaustive}]
+ #1
+
+ [{#Bit sideR} {#Bit sideS}]
+ (bit#= sideR sideS)
+
+ (^template [<tag>]
+ [[{<tag> partialR} {<tag> partialS}]
+ (set#= partialR partialS)])
+ ([#Nat]
+ [#Int]
+ [#Rev]
+ [#Frac]
+ [#Text])
+
+ [{#Variant allR casesR} {#Variant allS casesS}]
+ (and (# (maybe.equivalence n.equivalence) = allR allS)
+ (# (dictionary.equivalence =) = casesR casesS))
+
+ [{#Seq leftR rightR} {#Seq leftS rightS}]
+ (and (= leftR leftS)
+ (= rightR rightS))
+
+ [{#Alt _} {#Alt _}]
+ (let [flatR (alternatives reference)
+ flatS (alternatives sample)]
+ (and (n.= (list.size flatR) (list.size flatS))
+ (list.every? (function (_ [coverageR coverageS])
+ (= coverageR coverageS))
+ (list.zipped/2 flatR flatS))))
+
+ _
+ #0)))
+
+(open: "/#[0]" ..equivalence)
+
+(def: .public (format value)
+ (%.Format Coverage)
(case value
- {#Bit value'}
- (|> value'
- %.bit
- (text.enclosed ["{#Bit " "}"]))
+ {#Bit it}
+ (%.bit it)
(^template [<tag> <format>]
[{<tag> it}
@@ -88,7 +131,7 @@
set.list
(list#each <format>)
(text.interposed " ")
- (text.enclosed [(format "{" (%.symbol (symbol <tag>)) " ") "}"]))])
+ (text.enclosed ["[" "]"]))])
([#Nat %.nat]
[#Int %.int]
[#Rev %.rev]
@@ -98,60 +141,64 @@
{#Variant ?max_cases cases}
(|> cases
dictionary.entries
- (list#each (function (_ [idx coverage])
- (format (%.nat idx) " " (%coverage coverage))))
+ (list#each (function (_ [tag it])
+ (%.format (%.nat tag) " " (format it))))
(text.interposed " ")
- (text.enclosed ["{" "}"])
- (format (%.nat (..cases ?max_cases)) " ")
- (text.enclosed ["{#Variant " "}"]))
+ (%.format (maybe.else "?" (maybe#each %.nat ?max_cases)) " ")
+ (text.enclosed ["{" "}"]))
{#Seq left right}
- (format "{#Seq " (%coverage left) " " (%coverage right) "}")
+ (%.format "(& " (format left) " " (format right) ")")
{#Alt left right}
- (format "{#Alt " (%coverage left) " " (%coverage right) "}")
+ (%.format "(| " (format left) " " (format right) ")")
{#Exhaustive}
- "#Exhaustive"))
+ "*"))
-(def: .public (determine pattern)
- (-> Pattern (Operation Coverage))
+(exception: .public (invalid_tuple [size Nat])
+ (exception.report
+ ["Expected size" ">= 2"]
+ ["Actual size" (%.nat size)]))
+
+(def: .public (coverage pattern)
+ (-> Pattern (Try Coverage))
(case pattern
- (^or {/pattern.#Simple {/simple.#Unit}}
- {/pattern.#Bind _})
- (////#in {#Exhaustive})
+ (^or {//pattern.#Simple {//simple.#Unit}}
+ {//pattern.#Bind _})
+ {try.#Success {#Exhaustive}}
- ... Simple patterns always have partial coverage because there
+ ... Simple patterns (other than unit/[]) always have partial coverage because there
... are too many possibilities as far as values go.
(^template [<from> <to> <hash>]
- [{/pattern.#Simple {<from> it}}
- (////#in {<to> (set.of_list <hash> (list it))})])
- ([/simple.#Nat #Nat n.hash]
- [/simple.#Int #Int i.hash]
- [/simple.#Rev #Rev r.hash]
- [/simple.#Frac #Frac f.hash]
- [/simple.#Text #Text text.hash])
+ [{//pattern.#Simple {<from> it}}
+ {try.#Success {<to> (set.of_list <hash> (list it))}}])
+ ([//simple.#Nat #Nat n.hash]
+ [//simple.#Int #Int i.hash]
+ [//simple.#Rev #Rev r.hash]
+ [//simple.#Frac #Frac f.hash]
+ [//simple.#Text #Text text.hash])
... Bits are the exception, since there is only "#1" and
... "#0", which means it is possible for bit
... pattern-matching to become exhaustive if complementary parts meet.
- {/pattern.#Simple {/simple.#Bit value}}
- (////#in {#Bit value})
+ {//pattern.#Simple {//simple.#Bit value}}
+ {try.#Success {#Bit value}}
... Tuple patterns can be exhaustive if there is exhaustiveness for all of
... their sub-patterns.
- {/pattern.#Complex {/complex.#Tuple membersP+}}
+ {//pattern.#Complex {//complex.#Tuple membersP+}}
(case (list.reversed membersP+)
- (^or {.#End} {.#Item _ {.#End}})
- (/.except ..invalid_tuple_pattern [])
+ (^or (^ (list)) (^ (list _)))
+ (exception.except ..invalid_tuple [(list.size membersP+)])
{.#Item lastP prevsP+}
- (do ////.monad
- [lastC (determine lastP)]
- (monad.mix ////.monad
+ (do [! try.monad]
+ [lastC (coverage lastP)]
+ (monad.mix !
(function (_ leftP rightC)
- (do ////.monad
- [leftC (determine leftP)]
+ (do !
+ [leftC (coverage leftP)]
(case rightC
{#Exhaustive}
(in leftC)
@@ -162,14 +209,14 @@
... Variant patterns can be shown to be exhaustive if all the possible
... cases are handled exhaustively.
- {/pattern.#Complex {/complex.#Variant [lefts right? value]}}
- (do ////.monad
- [value_coverage (determine value)
+ {//pattern.#Complex {//complex.#Variant [lefts right? value]}}
+ (do try.monad
+ [value_coverage (coverage value)
.let [idx (if right?
(++ lefts)
lefts)]]
(in {#Variant (if right?
- {.#Some idx}
+ {.#Some (++ idx)}
{.#None})
(|> (dictionary.empty n.hash)
(dictionary.has idx value_coverage))}))))
@@ -185,102 +232,70 @@
... always be a pattern prior to them that would match the input.
... Because of that, the presence of redundant patterns is assumed to
... be a bug, likely due to programmer carelessness.
-(exception: .public (redundant_pattern [so_far Coverage
- addition Coverage])
+(exception: .public (redundancy [so_far Coverage
+ addition Coverage])
(exception.report
- ["Coverage so-far" (%coverage so_far)]
- ["Coverage addition" (%coverage addition)]))
+ ["Coverage so-far" (format so_far)]
+ ["Additional coverage" (format addition)]))
-(def: (flat_alt coverage)
- (-> Coverage (List Coverage))
+(exception: .public (variant_mismatch [expected Nat
+ mismatched Nat])
+ (exception.report
+ ["Expected cases" (%.nat expected)]
+ ["Mismatched cases" (%.nat mismatched)]))
+
+(def: .public (exhaustive? coverage)
+ (-> Coverage Bit)
(case coverage
- {#Alt left right}
- (list& left (flat_alt right))
+ {#Exhaustive}
+ #1
_
- (list coverage)))
-
-(implementation: equivalence
- (Equivalence Coverage)
-
- (def: (= reference sample)
- (case [reference sample]
- [{#Exhaustive} {#Exhaustive}]
- #1
-
- [{#Bit sideR} {#Bit sideS}]
- (bit#= sideR sideS)
-
- (^template [<tag>]
- [[{<tag> partialR} {<tag> partialS}]
- (# set.equivalence = partialR partialS)])
- ([#Nat]
- [#Int]
- [#Rev]
- [#Frac]
- [#Text])
-
- [{#Variant allR casesR} {#Variant allS casesS}]
- (and (n.= (cases allR)
- (cases allS))
- (# (dictionary.equivalence =) = casesR casesS))
-
- [{#Seq leftR rightR} {#Seq leftS rightS}]
- (and (= leftR leftS)
- (= rightR rightS))
-
- [{#Alt _} {#Alt _}]
- (let [flatR (flat_alt reference)
- flatS (flat_alt sample)]
- (and (n.= (list.size flatR) (list.size flatS))
- (list.every? (function (_ [coverageR coverageS])
- (= coverageR coverageS))
- (list.zipped/2 flatR flatS))))
-
- _
- #0)))
-
-(open: "coverage#[0]" ..equivalence)
-
-(exception: .public (variants_do_not_match [addition_cases Nat
- so_far_cases Nat])
- (exception.report
- ["So-far Cases" (%.nat so_far_cases)]
- ["Addition Cases" (%.nat addition_cases)]))
+ #0))
... After determining the coverage of each individual pattern, it is
... necessary to merge them all to figure out if the entire
... pattern-matching expression is exhaustive and whether it contains
... redundant patterns.
-(def: .public (merged addition so_far)
+(def: .public (composite addition so_far)
(-> Coverage Coverage (Try Coverage))
- (with_expansions [<redundancy> (exception.except ..redundant_pattern [so_far addition])]
+ (with_expansions [<redundancy> (exception.except ..redundancy [so_far addition])
+ <alternatively> {try.#Success {#Alt addition so_far}}
+ <otherwise> (if (/#= so_far addition)
+ ... The addition cannot possibly improve the coverage.
+ <redundancy>
+ ... There are now 2 alternative paths.
+ <alternatively>)]
(case [addition so_far]
... 2 bit coverages are exhaustive if they complement one another.
[{#Bit sideA} {#Bit sideSF}]
(if (xor sideA sideSF)
- (try#in {#Exhaustive})
+ {try.#Success {#Exhaustive}}
<redundancy>)
(^template [<tag>]
[[{<tag> partialA} {<tag> partialSF}]
- (let [common (set.intersection partialA partialSF)]
- (if (set.empty? common)
- (try#in {<tag> (set.union partialA partialSF)})
- <redundancy>))])
+ (if (set.empty? (set.intersection partialA partialSF))
+ {try.#Success {<tag> (set.union partialA partialSF)}}
+ <redundancy>)])
([#Nat]
[#Int]
[#Rev]
[#Frac]
[#Text])
- [{#Variant allA casesA} {#Variant allSF casesSF}]
- (let [addition_cases (cases allSF)
- so_far_cases (cases allA)]
- (cond (and (known_cases? addition_cases)
- (known_cases? so_far_cases)
- (not (n.= addition_cases so_far_cases)))
- (exception.except ..variants_do_not_match [addition_cases so_far_cases])
+ [{#Variant addition'} {#Variant so_far'}]
+ (let [[allA casesA] addition'
+ [allSF casesSF] so_far'
+ addition_cases (..maximum addition')
+ so_far_cases (..maximum so_far')]
+ (cond (template.let [(known_cases? it)
+ [(n.< n#top it)]]
+ (and (known_cases? so_far_cases)
+ (if (known_cases? addition_cases)
+ (not (n.= so_far_cases addition_cases))
+ (n.> so_far_cases (..minimum addition')))))
+ (exception.except ..variant_mismatch [so_far_cases addition_cases])
(# (dictionary.equivalence ..equivalence) = casesSF casesA)
<redundancy>
@@ -292,48 +307,41 @@
(case (dictionary.value tagA casesSF')
{.#Some coverageSF}
(do !
- [coverageM (merged coverageA coverageSF)]
+ [coverageM (composite coverageA coverageSF)]
(in (dictionary.has tagA coverageM casesSF')))
{.#None}
(in (dictionary.has tagA coverageA casesSF'))))
- casesSF (dictionary.entries casesA))]
- (in (if (and (or (known_cases? addition_cases)
- (known_cases? so_far_cases))
- (n.= (++ (n.max addition_cases so_far_cases))
+ casesSF
+ (dictionary.entries casesA))]
+ (in (if (and (n.= (n.min addition_cases so_far_cases)
(dictionary.size casesM))
- (list.every? exhaustive? (dictionary.values casesM)))
+ (list.every? ..exhaustive? (dictionary.values casesM)))
{#Exhaustive}
- {#Variant (case allSF
- {.#Some _}
- allSF
-
- _
- allA)
- casesM})))))
+ {#Variant (maybe#composite allA allSF) casesM})))))
[{#Seq leftA rightA} {#Seq leftSF rightSF}]
- (case [(coverage#= leftSF leftA) (coverage#= rightSF rightA)]
+ (case [(/#= leftSF leftA) (/#= rightSF rightA)]
... Same prefix
[#1 #0]
(do try.monad
- [rightM (merged rightA rightSF)]
- (if (exhaustive? rightM)
- ... If all that follows is exhaustive, then it can be safely dropped
- ... (since only the "left" part would influence whether the
- ... merged coverage is exhaustive or not).
- (in leftSF)
- (in {#Seq leftSF rightM})))
+ [rightM (composite rightA rightSF)]
+ (in (if (..exhaustive? rightM)
+ ... If all that follows is exhaustive, then it can be safely dropped
+ ... (since only the "left" part would influence whether the
+ ... composite coverage is exhaustive or not).
+ leftSF
+ {#Seq leftSF rightM})))
... Same suffix
[#0 #1]
(do try.monad
- [leftM (merged leftA leftSF)]
+ [leftM (composite leftA leftSF)]
(in {#Seq leftM rightA}))
... The 2 sequences cannot possibly be merged.
[#0 #0]
- (try#in {#Alt so_far addition})
+ <alternatively>
... There is nothing the addition adds to the coverage.
[#1 #1]
@@ -345,18 +353,8 @@
... The addition completes the coverage.
[{#Exhaustive} _]
- (try#in {#Exhaustive})
+ {try.#Success {#Exhaustive}}
- ... The left part will always match, so the addition is redundant.
- (^multi [{#Seq left right} single]
- (coverage#= left single))
- <redundancy>
-
- ... The right part is not necessary, since it can always match the left.
- (^multi [single {#Seq left right}]
- (coverage#= left single))
- (try#in single)
-
... When merging a new coverage against one based on Alt, it may be
... that one of the many coverages in the Alt is complementary to
... the new one, so effort must be made to fuse carefully, to match
@@ -378,8 +376,8 @@
(in [{.#None} (list coverageA)])
{.#Item altSF altsSF'}
- (case (merged coverageA altSF)
- {try.#Success altMSF}
+ (do !
+ [altMSF (composite coverageA altSF)]
(case altMSF
{#Alt _}
(do !
@@ -387,33 +385,36 @@
(in [success {.#Item altSF altsSF+}]))
_
- (in [{.#Some altMSF} altsSF']))
-
- {try.#Failure error}
- {try.#Failure error})
- ))))]
- [successA possibilitiesSF] (fuse_once addition (flat_alt so_far))]
- (loop [successA successA
- possibilitiesSF possibilitiesSF]
- (case successA
- {.#Some coverageA'}
- (do !
- [[successA' possibilitiesSF'] (fuse_once coverageA' possibilitiesSF)]
- (again successA' possibilitiesSF'))
-
- {.#None}
- (case (list.reversed possibilitiesSF)
- {.#Item last prevs}
- (in (list#mix (function (_ left right) {#Alt left right})
- last
- prevs))
-
- {.#End}
- (undefined)))))
+ (in [{.#Some altMSF} altsSF'])))))))]]
+ (loop [addition addition
+ possibilitiesSF (alternatives so_far)]
+ (do !
+ [[addition' possibilitiesSF'] (fuse_once addition possibilitiesSF)]
+ (case addition'
+ {.#Some addition'}
+ (again addition' possibilitiesSF')
+
+ {.#None}
+ (case (list.reversed possibilitiesSF')
+ {.#Item last prevs}
+ (in (list#mix (function (_ left right) {#Alt left right})
+ last
+ prevs))
+
+ {.#End}
+ (undefined))))))
- _
- (if (coverage#= so_far addition)
- ... The addition cannot possibly improve the coverage.
+ ... The left part will always match, so the addition is redundant.
+ [{#Seq left right} single]
+ (if (/#= left single)
<redundancy>
- ... There are now 2 alternative paths.
- (try#in {#Alt so_far addition})))))
+ <otherwise>)
+
+ ... The right part is not necessary, since it can always match the left.
+ [single {#Seq left right}]
+ (if (/#= left single)
+ {try.#Success single}
+ <otherwise>)
+
+ _
+ <otherwise>)))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/evaluation.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/evaluation.lux
index d27d54fe7..7b8181b9c 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/evaluation.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/evaluation.lux
@@ -1,18 +1,22 @@
(.using
[library
[lux "*"
+ [type {"+" :sharing}]
["[0]" meta]
[abstract
[monad {"+" do}]]
[control
- ["[0]" try {"+" Try}]]
+ ["[0]" maybe]
+ ["[0]" try]
+ ["[0]" io]
+ [concurrency
+ ["[0]" atom {"+" Atom}]]]
[data
- [text
- ["%" format]]]
+ [collection
+ ["[0]" dictionary {"+" Dictionary}]]]
[math
- [number {"+" hex}
- ["n" nat]
- ["[0]" i64]]]]]
+ [number
+ ["n" nat]]]]]
["[0]" // {"+" Operation}
[macro {"+" Expander}]
["[1][0]" type]
@@ -28,11 +32,16 @@
[///
["[0]" phase]
[meta
- ["[0]" archive {"+" Archive}]]]]]]])
+ ["[0]" archive {"+" Archive}
+ ["[0]" module]]]]]]]])
(type: .public Eval
(-> Archive Type Code (Operation Any)))
+(def: evals
+ (Atom (Dictionary module.ID Nat))
+ (atom.atom (dictionary.empty n.hash)))
+
(def: .public (evaluator expander synthesis_state generation_state generate)
(All (_ anchor expression artifact)
(-> Expander
@@ -43,9 +52,7 @@
(let [analyze (analysisP.phase expander)]
(function (eval archive type exprC)
(do phase.monad
- [count (extensionP.lifted
- meta.seed)
- exprA (<| (//type.expecting type)
+ [exprA (<| (//type.expecting type)
//scope.reset
(analyze archive exprC))
module (extensionP.lifted
@@ -54,11 +61,18 @@
(do try.monad
[exprS (|> exprA (synthesisP.phase archive) (phase.result synthesis_state))])
(phase.result generation_state)
- (let [shift (|> count
- (i64.left_shifted 32)
- (i64.or (hex "FF,FF,FF,FF")))])
(do phase.monad
- [exprO (generation.with_registry_shift shift
- (generate archive exprS))
- module_id (generation.module_id module archive)]
- (generation.evaluate! [module_id count] exprO)))))))
+ [@module (:sharing [anchor expression artifact]
+ (generation.Phase anchor expression artifact)
+ generate
+
+ (generation.Operation anchor expression artifact module.ID)
+ (generation.module_id module archive))
+ .let [[evals _] (io.run! (atom.update! (dictionary.revised' @module 0 ++) ..evals))
+ @eval (maybe.else 0 (dictionary.value @module evals))]
+ exprO (<| (generation.with_registry_shift (|> @module
+ ("lux i64 left-shift" 16)
+ ("lux i64 or" @eval)
+ ("lux i64 left-shift" 32)))
+ (generate archive exprS))]
+ (generation.evaluate! [@module @eval] exprO)))))))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/pattern.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/pattern.lux
index 21b6218ba..cfce834d0 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/pattern.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/pattern.lux
@@ -5,7 +5,7 @@
[equivalence {"+" Equivalence}]]
[data
[text
- ["%" format {"+" Format}]]]
+ ["%" format]]]
[math
[number
["n" nat]]]]]
@@ -41,7 +41,7 @@
false)))
(def: .public (format it)
- (Format Pattern)
+ (%.Format Pattern)
(case it
{#Simple it}
(//simple.format it)
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 e1b1a8c07..3e81c08b8 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
@@ -22,7 +22,6 @@
["[0]" type
["[0]" check]]]]
["[0]" / "_"
- ["[1][0]" coverage {"+" Coverage}]
["/[1]" // "_"
["[1][0]" complex]
["/[1]" // "_"
@@ -33,7 +32,8 @@
["[1][0]" complex]
["[1][0]" pattern {"+" Pattern}]
["[1][0]" type]
- ["[1][0]" scope]]
+ ["[1][0]" scope]
+ ["[1][0]" coverage {"+" Coverage}]]
[///
["[1]" phase]]]]]])
@@ -64,7 +64,7 @@
(list#each (function (_ [slot value])
(list slot value)))
list#conjoint)))]
- ["Coverage" (/coverage.%coverage coverage)]))
+ ["Coverage" (/coverage.format coverage)]))
(exception: .public (cannot_have_empty_branches [message Text])
message)
@@ -337,11 +337,11 @@
(function (_ [patternT bodyT])
(analyse_pattern {.#None} inputT patternT (analyse archive bodyT)))
branchesT)
- outputHC (|> outputH product.left /coverage.determine)
- outputTC (monad.each ! (|>> product.left /coverage.determine) outputT)
- _ (.case (monad.mix try.monad /coverage.merged outputHC outputTC)
+ outputHC (|> outputH product.left /coverage.coverage /.of_try)
+ outputTC (monad.each ! (|>> product.left /coverage.coverage /.of_try) outputT)
+ _ (.case (monad.mix try.monad /coverage.composite outputHC outputTC)
{try.#Success coverage}
- (///.assertion non_exhaustive_pattern_matching [inputC branches coverage]
+ (///.assertion ..non_exhaustive_pattern_matching [inputC branches coverage]
(/coverage.exhaustive? coverage))
{try.#Failure error}