aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/compiler/default.lux14
-rw-r--r--stdlib/source/lux/compiler/default/name.lux55
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis.lux16
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis/case.lux8
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis/case/coverage.lux34
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis/scope.lux39
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis/structure.lux24
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis/type.lux8
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension.lux41
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux12
-rw-r--r--stdlib/source/lux/compiler/default/phase/translation.lux24
-rw-r--r--stdlib/source/lux/compiler/default/syntax.lux57
-rw-r--r--stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux20
-rw-r--r--stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux12
14 files changed, 165 insertions, 199 deletions
diff --git a/stdlib/source/lux/compiler/default.lux b/stdlib/source/lux/compiler/default.lux
index 73b018c95..9c7b7868d 100644
--- a/stdlib/source/lux/compiler/default.lux
+++ b/stdlib/source/lux/compiler/default.lux
@@ -54,8 +54,11 @@
(#error.Error error)
(#error.Success [source' output])
- (#error.Success [[bundle (set@ #.source source' compiler)]
- output]))))
+ (let [[cursor _] output]
+ (#error.Success [[bundle (|> compiler
+ (set@ #.source source')
+ (set@ #.cursor cursor))]
+ output])))))
## ## (def: (write-module target-dir file-name module-name module artifacts)
## ## (-> File Text Text Module Artifacts (Process Any))
@@ -101,12 +104,7 @@
(<| (phase.timed (name-of ..module-compilation-iteration) "ITERATION")
(do phase.Monad<Operation>
[code (statement.lift-analysis
- (do @
- [code (<| (phase.timed (name-of ..module-compilation-iteration) "syntax")
- (..read reader))
- #let [[cursor _] code]
- _ (analysis.set-cursor cursor)]
- (wrap code)))
+ (..read reader))
_ (<| (phase.timed (name-of ..module-compilation-iteration) "PHASE")
(totalS.phase code))]
init.refresh)))
diff --git a/stdlib/source/lux/compiler/default/name.lux b/stdlib/source/lux/compiler/default/name.lux
index 925b0585d..184b2cab5 100644
--- a/stdlib/source/lux/compiler/default/name.lux
+++ b/stdlib/source/lux/compiler/default/name.lux
@@ -5,33 +5,32 @@
["." text
format]]])
-(def: (sanitize char)
- (-> Nat Text)
- (case char
- (^ (char "*")) "_ASTER_"
- (^ (char "+")) "_PLUS_"
- (^ (char "-")) "_DASH_"
- (^ (char "/")) "_SLASH_"
- (^ (char "\")) "_BSLASH_"
- (^ (char "_")) "_UNDERS_"
- (^ (char "%")) "_PERCENT_"
- (^ (char "$")) "_DOLLAR_"
- (^ (char "'")) "_QUOTE_"
- (^ (char "`")) "_BQUOTE_"
- (^ (char "@")) "_AT_"
- (^ (char "^")) "_CARET_"
- (^ (char "&")) "_AMPERS_"
- (^ (char "=")) "_EQ_"
- (^ (char "!")) "_BANG_"
- (^ (char "?")) "_QM_"
- (^ (char ":")) "_COLON_"
- (^ (char ".")) "_PERIOD_"
- (^ (char ",")) "_COMMA_"
- (^ (char "<")) "_LT_"
- (^ (char ">")) "_GT_"
- (^ (char "~")) "_TILDE_"
- (^ (char "|")) "_PIPE_"
- _ (text.from-code char)))
+(`` (template: (!sanitize char)
+ ("lux syntax char case!" char
+ [["*"] "_ASTER_"
+ ["+"] "_PLUS_"
+ ["-"] "_DASH_"
+ ["/"] "_SLASH_"
+ ["\"] "_BSLASH_"
+ ["_"] "_UNDERS_"
+ ["%"] "_PERCENT_"
+ ["$"] "_DOLLAR_"
+ ["'"] "_QUOTE_"
+ ["`"] "_BQUOTE_"
+ ["@"] "_AT_"
+ ["^"] "_CARET_"
+ ["&"] "_AMPERS_"
+ ["="] "_EQ_"
+ ["!"] "_BANG_"
+ ["?"] "_QM_"
+ [":"] "_COLON_"
+ ["."] "_PERIOD_"
+ [","] "_COMMA_"
+ ["<"] "_LT_"
+ [">"] "_GT_"
+ ["~"] "_TILDE_"
+ ["|"] "_PIPE_"]
+ (text.from-code char))))
(def: #export (normalize name)
(-> Text Text)
@@ -40,7 +39,7 @@
output ""]
(if (n/< name/size idx)
(recur (inc idx)
- (|> (text.nth idx name) maybe.assume sanitize (format output)))
+ (|> ("lux text char" name idx) !sanitize (format output)))
output))))
(def: #export (definition [module short])
diff --git a/stdlib/source/lux/compiler/default/phase/analysis.lux b/stdlib/source/lux/compiler/default/phase/analysis.lux
index 615075800..0a122bf3c 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis.lux
@@ -183,12 +183,12 @@
(function (_ [bundle state])
(let [old-source (get@ #.source state)]
(case (action [bundle (set@ #.source source state)])
- (#error.Error error)
- (#error.Error error)
-
(#error.Success [[bundle' state'] output])
(#error.Success [[bundle' (set@ #.source old-source state')]
- output])))))
+ output])
+
+ (#error.Error error)
+ (#error.Error error)))))
(def: fresh-bindings
(All [k v] (Bindings k v))
@@ -208,12 +208,12 @@
(case (action [bundle (update@ #.scopes (|>> (#.Cons fresh-scope)) state)])
(#error.Success [[bundle' state'] output])
(case (get@ #.scopes state')
- #.Nil
- (#error.Error "Impossible error: Drained scopes!")
-
(#.Cons head tail)
(#error.Success [[bundle' (set@ #.scopes tail state')]
- [head output]]))
+ [head output]])
+
+ #.Nil
+ (#error.Error "Impossible error: Drained scopes!"))
(#error.Error error)
(#error.Error error))))
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/case.lux b/stdlib/source/lux/compiler/default/phase/analysis/case.lux
index 2081ceb61..5044aed92 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/case.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/case.lux
@@ -276,9 +276,6 @@
(def: #export (case analyse inputC branches)
(-> Phase Code (List [Code Code]) (Operation Analysis))
(.case branches
- #.Nil
- (///.throw cannot-have-empty-branches "")
-
(#.Cons [patternH bodyH] branchesT)
(do ///.Monad<Operation>
[[inputT inputA] (//type.with-inference
@@ -297,4 +294,7 @@
(#error.Error error)
(///.fail error))]
- (wrap (#//.Case inputA [outputH outputT])))))
+ (wrap (#//.Case inputA [outputH outputT])))
+
+ #.Nil
+ (///.throw cannot-have-empty-branches "")))
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/case/coverage.lux b/stdlib/source/lux/compiler/default/phase/analysis/case/coverage.lux
index cf9abecd4..aff981e09 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/case/coverage.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/case/coverage.lux
@@ -213,14 +213,6 @@
(def: #export (merge addition so-far)
(-> Coverage Coverage (Error Coverage))
(case [addition so-far]
- ## The addition cannot possibly improve the coverage.
- [_ #Exhaustive]
- (ex.throw redundant-pattern [so-far addition])
-
- ## The addition completes the coverage.
- [#Exhaustive _]
- (error/wrap #Exhaustive)
-
[#Partial #Partial]
(error/wrap #Partial)
@@ -269,14 +261,6 @@
[(#Seq leftA rightA) (#Seq leftSF rightSF)]
(case [(coverage/= leftSF leftA) (coverage/= rightSF rightA)]
- ## There is nothing the addition adds to the coverage.
- [#1 #1]
- (ex.throw redundant-pattern [so-far addition])
-
- ## The 2 sequences cannot possibly be merged.
- [#0 #0]
- (error/wrap (#Alt so-far addition))
-
## Same prefix
[#1 #0]
(do error.Monad<Error>
@@ -292,7 +276,23 @@
[#0 #1]
(do error.Monad<Error>
[leftM (merge leftA leftSF)]
- (wrap (#Seq leftM rightA))))
+ (wrap (#Seq leftM rightA)))
+
+ ## The 2 sequences cannot possibly be merged.
+ [#0 #0]
+ (error/wrap (#Alt so-far addition))
+
+ ## There is nothing the addition adds to the coverage.
+ [#1 #1]
+ (ex.throw redundant-pattern [so-far addition]))
+
+ ## The addition cannot possibly improve the coverage.
+ [_ #Exhaustive]
+ (ex.throw redundant-pattern [so-far addition])
+
+ ## The addition completes the coverage.
+ [#Exhaustive _]
+ (error/wrap #Exhaustive)
## The left part will always match, so the addition is redundant.
(^multi [(#Seq left right) single]
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/scope.lux b/stdlib/source/lux/compiler/default/phase/analysis/scope.lux
index 2c34e7a44..2849e059d 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/scope.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/scope.lux
@@ -1,7 +1,8 @@
(.module:
[lux #*
[control
- monad]
+ monad
+ ["ex" exception (#+ exception:)]]
[data
[text ("text/." Equivalence<Text>)
format]
@@ -46,13 +47,13 @@
(loop [idx 0
mappings (get@ [#.captured #.mappings] scope)]
(case mappings
- #.Nil
- #.None
-
(#.Cons [_name [_source-type _source-ref]] mappings')
(if (text/= name _name)
(#.Some [_source-type (#reference.Foreign idx)])
- (recur (inc idx) mappings')))))
+ (recur (inc idx) mappings'))
+
+ #.Nil
+ #.None)))
(def: (reference? name scope)
(-> Text Scope Bit)
@@ -98,6 +99,12 @@
(#.Some [ref-type ref])]))
)))))
+(exception: #export (cannot-create-local-binding-without-a-scope)
+ "")
+
+(exception: #export (invalid-scope-alteration)
+ "")
+
(def: #export (with-local [name type] action)
(All [a] (-> [Text Type] (Operation a) (Operation a)))
(function (_ [bundle state])
@@ -121,13 +128,13 @@
output]))
_
- (error! "Invalid scope alteration."))
+ (ex.throw invalid-scope-alteration []))
(#e.Error error)
(#e.Error error)))
_
- (#e.Error "Cannot create local binding without a scope."))
+ (ex.throw cannot-create-local-binding-without-a-scope []))
))
(do-template [<name> <val-type>]
@@ -159,27 +166,29 @@
(case (action [bundle (update@ #.scopes
(|>> (#.Cons (scope parent-name name)))
state)])
- (#e.Error error)
- (#e.Error error)
-
(#e.Success [[bundle' state'] output])
(#e.Success [[bundle' (update@ #.scopes
(|>> list.tail (maybe.default (list)))
state')]
output])
- ))
+
+ (#e.Error error)
+ (#e.Error error)))
))
+(exception: #export (cannot-get-next-reference-when-there-is-no-scope)
+ "")
+
(def: #export next-local
(Operation Register)
(extension.lift
(function (_ state)
(case (get@ #.scopes state)
- #.Nil
- (#e.Error "Cannot get next reference when there is no scope.")
-
(#.Cons top _)
- (#e.Success [state (get@ [#.locals #.counter] top)])))))
+ (#e.Success [state (get@ [#.locals #.counter] top)])
+
+ #.Nil
+ (ex.throw cannot-get-next-reference-when-there-is-no-scope [])))))
(def: (ref-to-variable ref)
(-> Ref Variable)
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/structure.lux b/stdlib/source/lux/compiler/default/phase/analysis/structure.lux
index 3988349e0..43cb8e0d2 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/structure.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/structure.lux
@@ -148,12 +148,12 @@
_
(case (type.apply (list inputT) funT)
- #.None
- (///.throw not-a-quantified-type funT)
-
(#.Some outputT)
(//type.with-type outputT
- (sum analyse tag valueC))))
+ (sum analyse tag valueC))
+
+ #.None
+ (///.throw not-a-quantified-type funT)))
_
(///.throw invalid-variant-type [expectedT tag valueC])))))
@@ -241,12 +241,12 @@
_
(case (type.apply (list inputT) funT)
- #.None
- (///.throw not-a-quantified-type funT)
-
(#.Some outputT)
(//type.with-type outputT
- (product analyse membersC))))
+ (product analyse membersC))
+
+ #.None
+ (///.throw not-a-quantified-type funT)))
_
(///.throw invalid-tuple-type [expectedT membersC])
@@ -317,13 +317,13 @@
(do @
[key (extension.lift (macro.normalize key))]
(case (dict.get key tag->idx)
- #.None
- (///.throw tag-does-not-belong-to-record [key recordT])
-
(#.Some idx)
(if (dict.contains? idx idx->val)
(///.throw cannot-repeat-tag [key record])
- (wrap (dict.put idx val idx->val))))))
+ (wrap (dict.put idx val idx->val)))
+
+ #.None
+ (///.throw tag-does-not-belong-to-record [key recordT]))))
(: (Dictionary Nat Code)
(dict.new number.Hash<Nat>))
record)
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/type.lux b/stdlib/source/lux/compiler/default/phase/analysis/type.lux
index 3eb574986..36fee29f8 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/type.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/type.lux
@@ -21,12 +21,12 @@
(All [a] (-> (tc.Check a) (Operation a)))
(function (_ (^@ stateE [bundle state]))
(case (action (get@ #.type-context state))
- (#error.Error error)
- ((///.fail error) stateE)
-
(#error.Success [context' output])
(#error.Success [[bundle (set@ #.type-context context' state)]
- output]))))
+ output])
+
+ (#error.Error error)
+ ((///.fail error) stateE))))
(def: #export with-fresh-env
(All [a] (-> (Operation a) (Operation a)))
diff --git a/stdlib/source/lux/compiler/default/phase/extension.lux b/stdlib/source/lux/compiler/default/phase/extension.lux
index c87d8d54c..f5baf2a5b 100644
--- a/stdlib/source/lux/compiler/default/phase/extension.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension.lux
@@ -61,23 +61,26 @@
(All [s i o]
(-> Text (Handler s i o) (Operation s i o Any)))
(function (_ [bundle state])
- (if (dictionary.contains? name bundle)
- (ex.throw cannot-overwrite name)
+ (case (dictionary.get name bundle)
+ #.None
(#error.Success [[(dictionary.put name handler bundle) state]
- []]))))
+ []])
+
+ _
+ (ex.throw cannot-overwrite name))))
(def: #export (apply where phase [name parameters])
(All [s i o]
(-> Text (Phase s i o) (Extension i) (Operation s i o o)))
(function (_ (^@ stateE [bundle state]))
(case (dictionary.get name bundle)
- #.None
- (ex.throw unknown [where name bundle])
-
(#.Some handler)
((<| (//.timed (name-of ..apply) (%t name))
((handler name phase) parameters))
- stateE))))
+ stateE)
+
+ #.None
+ (ex.throw unknown [where name bundle]))))
(def: #export (localized get set transform)
(All [s s' i o v]
@@ -87,11 +90,11 @@
(function (_ [bundle state])
(let [old (get state)]
(case (operation [bundle (set (transform old) state)])
- (#error.Error error)
- (#error.Error error)
-
(#error.Success [[bundle' state'] output])
- (#error.Success [[bundle' (set old state')] output]))))))
+ (#error.Success [[bundle' (set old state')] output])
+
+ (#error.Error error)
+ (#error.Error error))))))
(def: #export (temporary transform)
(All [s i o v]
@@ -100,11 +103,11 @@
(function (_ operation)
(function (_ [bundle state])
(case (operation [bundle (transform state)])
- (#error.Error error)
- (#error.Error error)
-
(#error.Success [[bundle' state'] output])
- (#error.Success [[bundle' state] output])))))
+ (#error.Success [[bundle' state] output])
+
+ (#error.Error error)
+ (#error.Error error)))))
(def: #export (with-state state)
(All [s i o v]
@@ -129,8 +132,8 @@
(//.Operation [(Bundle s i o) s] v)))
(function (_ [bundle state])
(case (action state)
- (#error.Error error)
- (#error.Error error)
-
(#error.Success [state' output])
- (#error.Success [[bundle state'] output]))))
+ (#error.Success [[bundle state'] output])
+
+ (#error.Error error)
+ (#error.Error error))))
diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux
index 64edb791b..5fac5b1d0 100644
--- a/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux
@@ -1064,12 +1064,12 @@
## else
(wrap #Fail)))))))]
(case (list.search-all pass! candidates)
- #.Nil
- (////.throw no-candidates [class-name method-name (list.search-all hint! candidates)])
-
(#.Cons method #.Nil)
(wrap method)
+ #.Nil
+ (////.throw no-candidates [class-name method-name (list.search-all hint! candidates)])
+
candidates
(////.throw too-many-candidates [class-name method-name candidates]))))
@@ -1124,12 +1124,12 @@
(if passes? (|>> #Pass) (|>> #Hint))
(constructor-signature constructor))))))]
(case (list.search-all pass! candidates)
- #.Nil
- (////.throw no-candidates [class-name ..constructor-method (list.search-all hint! candidates)])
-
(#.Cons constructor #.Nil)
(wrap constructor)
+ #.Nil
+ (////.throw no-candidates [class-name ..constructor-method (list.search-all hint! candidates)])
+
candidates
(////.throw too-many-candidates [class-name ..constructor-method candidates]))))
diff --git a/stdlib/source/lux/compiler/default/phase/translation.lux b/stdlib/source/lux/compiler/default/phase/translation.lux
index b1a224e80..8565cefcc 100644
--- a/stdlib/source/lux/compiler/default/phase/translation.lux
+++ b/stdlib/source/lux/compiler/default/phase/translation.lux
@@ -177,11 +177,11 @@
(-> Text <inputT> (Operation anchor expression statement Any)))
(function (_ (^@ state+ [bundle state]))
(case (:: (get@ #host state) <name> label code)
- (#error.Error error)
- (ex.throw cannot-interpret error)
-
(#error.Success output)
- (#error.Success [state+ output]))))]
+ (#error.Success [state+ output])
+
+ (#error.Error error)
+ (ex.throw cannot-interpret error))))]
[evaluate! expression]
[execute! statement]
@@ -192,11 +192,11 @@
(-> Name expression (Operation anchor expression statement [Text Any])))
(function (_ (^@ stateE [bundle state]))
(case (:: (get@ #host state) define! name code)
- (#error.Error error)
- (ex.throw cannot-interpret error)
-
(#error.Success output)
- (#error.Success [stateE output]))))
+ (#error.Success [stateE output])
+
+ (#error.Error error)
+ (ex.throw cannot-interpret error))))
(def: #export (save! name code)
(All [anchor expression statement]
@@ -239,12 +239,12 @@
(function (_ [bundle state])
(let [cache (get@ #name-cache state)]
(case (dictionary.get lux-name cache)
- (#.Some old-host-name)
- (ex.throw cannot-overwrite-lux-name [lux-name old-host-name host-name])
-
#.None
(#error.Success [[bundle
(update@ #name-cache
(dictionary.put lux-name host-name)
state)]
- []])))))
+ []])
+
+ (#.Some old-host-name)
+ (ex.throw cannot-overwrite-lux-name [lux-name old-host-name host-name])))))
diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux
index 52ac38720..5ada2ad23 100644
--- a/stdlib/source/lux/compiler/default/syntax.lux
+++ b/stdlib/source/lux/compiler/default/syntax.lux
@@ -25,16 +25,15 @@
## [file-name, line, column] to keep track of their provenance and
## location, which is helpful for documentation and debugging.
(.module:
- [lux (#- int rev)
+ [lux #*
[control
monad
- ["p" parser ("parser/." Monad<Parser>)]
["ex" exception (#+ exception:)]]
[data
["." error (#+ Error)]
["." number]
["." text
- ["l" lexer (#+ Offset Lexer)]
+ [lexer (#+ Offset)]
format]
[collection
["." list]
@@ -82,9 +81,6 @@
[!n/- "lux i64 -"]
)
-(type: #export Syntax
- (-> Cursor (Lexer [Cursor Code])))
-
(type: #export Aliases (Dictionary Text Text))
(def: #export no-aliases Aliases (dictionary.new text.Hash<Text>))
@@ -121,42 +117,6 @@
## encoded on the parser.
(def: #export name-separator ".")
-## These are very simple parsers that just cut chunks of text in
-## specific shapes and then use decoders already present in the
-## standard library to actually produce the values from the literals.
-(def: rich-digit
- (Lexer Text)
- (p.either l.decimal
- (p.after (l.this "_") (parser/wrap ""))))
-
-(def: rich-digits^
- (Lexer Text)
- (l.and l.decimal
- (l.some rich-digit)))
-
-(def: sign^ (l.one-of "+-"))
-
-(def: #export (frac where)
- Syntax
- (do p.Monad<Parser>
- [chunk ($_ l.and
- sign^
- rich-digits^
- (l.one-of ".")
- rich-digits^
- (p.default ""
- ($_ l.and
- (l.one-of "eE")
- sign^
- rich-digits^)))]
- (case (:: number.Codec<Text,Frac> decode chunk)
- (#.Left error)
- (p.fail error)
-
- (#.Right value)
- (wrap [(update@ #.column (n/+ (text.size chunk)) where)
- [where (#.Frac value)]]))))
-
(exception: #export (end-of-file {module Text})
(ex.report ["Module" (%t module)]))
@@ -179,13 +139,6 @@
(exception: #export (cannot-close-composite-expression {closing-char Char})
(ex.report ["Closing Character" (text.from-code closing-char)]))
-(def: (ast current-module aliases)
- (-> Text Aliases Syntax)
- (function (ast' where)
- ($_ p.either
- (..frac where)
- )))
-
(type: Parser
(-> Source (Error [Source Code])))
@@ -272,11 +225,11 @@
(template: (!guarantee-no-new-lines content body)
(case ("lux text index" content (static text.new-line) 0)
- (#.Some g!_)
- (ex.throw ..text-cannot-contain-new-lines content)
+ #.None
+ body
g!_
- body))
+ (ex.throw ..text-cannot-contain-new-lines content)))
(template: (!read-text where offset source-code)
(case ("lux text index" source-code (static ..text-delimiter) offset)
diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux
index 9a17deaec..c5165fca7 100644
--- a/stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux
+++ b/stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux
@@ -61,9 +61,7 @@
(|> analysis
(typeA.with-type type)
(phase.run _primitive.state)
- (case> (^multi (#e.Success sumA)
- [(analysis.variant sumA)
- (#.Some variant)])
+ (case> (^ (#e.Success (analysis.variant variant)))
(check-sum' size tag variant)
_
@@ -81,9 +79,7 @@
(tagged module tags type)
(typeA.with-type type)
(phase.run _primitive.state)
- (case> (^multi (#e.Success [_ sumA])
- [(analysis.variant sumA)
- (#.Some variant)])
+ (case> (^ (#e.Success [_ (analysis.variant variant)]))
(check-sum' size tag variant)
_
@@ -91,7 +87,13 @@
(def: (right-size? size)
(-> Nat (-> Analysis Bit))
- (|>> analysis.tuple list.size (n/= size)))
+ (|>> (case> (^ (analysis.tuple elems))
+ (|> elems
+ list.size
+ (n/= size))
+
+ _
+ false)))
(def: (check-record-inference module tags type size analysis)
(-> Text (List module.Tag) Type Nat (Operation [Type Analysis]) Bit)
@@ -133,9 +135,7 @@
(typeA.with-type varT
(/.sum _primitive.phase choice valueC)))
(phase.run _primitive.state)
- (case> (^multi (#e.Success sumA)
- [(analysis.variant sumA)
- (#.Some variant)])
+ (case> (^ (#e.Success (analysis.variant variant)))
(check-sum' size choice variant)
_
diff --git a/stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux b/stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux
index a78aa1a09..fa93777b2 100644
--- a/stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux
+++ b/stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux
@@ -27,13 +27,17 @@
(do @
[size (|> r.nat (:: @ map (|>> (n/% 10) (n/+ 2))))
tagA (|> r.nat (:: @ map (n/% size)))
+ #let [right? (n/= (dec size) tagA)
+ lefts (if right?
+ (dec tagA)
+ tagA)]
memberA //primitive.primitive]
($_ seq
(test "Can synthesize variants."
- (|> (analysis.sum-analysis size tagA memberA)
+ (|> (analysis.variant [lefts right? memberA])
expression.phase
(phase.run [bundle.empty //.init])
- (case> (#error.Success (#//.Structure (#//.Variant [leftsS right?S valueS])))
+ (case> (^ (#error.Success (//.variant [leftsS right?S valueS])))
(let [tagS (if right?S (inc leftsS) leftsS)]
(and (n/= tagA tagS)
(|> tagS (n/= (dec size)) (bit/= right?S))
@@ -50,10 +54,10 @@
membersA (r.list size //primitive.primitive)]
($_ seq
(test "Can synthesize tuple."
- (|> (analysis.product-analysis membersA)
+ (|> (analysis.tuple membersA)
expression.phase
(phase.run [bundle.empty //.init])
- (case> (#error.Success (#//.Structure (#//.Tuple membersS)))
+ (case> (^ (#error.Success (//.tuple membersS)))
(and (n/= size (list.size membersS))
(list.every? (product.uncurry //primitive.corresponds?)
(list.zip2 membersA membersS)))