Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
curry
curry-frontend
Commits
fe83ac4d
Commit
fe83ac4d
authored
Oct 26, 2015
by
Yannik Potdevin
Browse files
Fixed ticket 1324 (do not expand constructor pattern to failed expression).
parent
d02680b0
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
52 additions
and
26 deletions
+52
-26
src/Transformations/CaseCompletion.hs
src/Transformations/CaseCompletion.hs
+28
-26
test/MissingCaseCompletion.curry
test/MissingCaseCompletion.curry
+24
-0
No files found.
src/Transformations/CaseCompletion.hs
View file @
fe83ac4d
...
...
@@ -183,33 +183,35 @@ completeConsAlts r ea ce alts = do
complPats
<-
mapM
genPat
$
getComplConstrs
mdl
menv
[
c
|
(
Alt
(
ConstructorPattern
c
_
)
_
)
<-
consAlts
]
[
v
,
w
]
<-
newIdentList
2
"x"
let
e'
=
getDefaultAlt
v
return
$
case
complPats
of
[]
->
Case
r
ea
ce
consAlts
ps
->
bindDefVar
v
ce
w
e'
ps
let
me
=
lookupDefaultAlt
v
return
$
let
c
=
Case
r
ea
ce
consAlts
in
case
(
complPats
,
me
)
of
(
[]
,
_
)
->
c
(
_
:
_
,
Nothing
)
->
c
(
ps
,
Just
e'
)
->
bindDefVar
v
ce
w
e'
ps
where
-- existing contructor pattern alternatives
consAlts
=
filter
isConstrAlt
alts
-- generate a new constructor pattern
genPat
(
qid
,
arity
)
=
ConstructorPattern
qid
<$>
newIdentList
arity
"x"
-- default alternative
get
DefaultAlt
v
=
case
find
isVarAlt
alts
of
Just
(
Alt
(
VariablePattern
x
)
de
)
->
replaceVar
x
(
Variable
v
)
de
_
->
failedExpr
-- create a binding for @v = e@ if needed
bindDefVar
v
e
w
e'
ps
|
v
`
elem
`
fv
e'
=
mkBinding
v
e
$
mkCase
(
Variable
v
)
w
e'
ps
|
otherwise
=
mkCase
e
w
e'
ps
-- create a binding for @w = e'@ if needed, and a case expression
-- @case e of { consAlts ++ (ps -> w) }@
mkCase
e
w
e'
ps
=
case
ps
of
[
p
]
->
Case
r
ea
e
(
consAlts
++
[
Alt
p
e'
])
_
->
mkBinding
w
e'
$
Case
r
ea
e
(
consAlts
++
[
Alt
p
(
Variable
w
)
|
p
<-
ps
])
-- existing contructor pattern alternatives
consAlts
=
filter
isConstrAlt
alts
-- generate a new constructor pattern
genPat
(
qid
,
arity
)
=
ConstructorPattern
qid
<$>
newIdentList
arity
"x"
-- default alternative
, if there is one
lookup
DefaultAlt
v
=
fmap
(
\
(
Alt
(
VariablePattern
x
)
de
)
->
replaceVar
x
(
Variable
v
)
de
)
$
find
isVarAlt
alts
-- create a binding for @v = e@ if needed
bindDefVar
v
e
w
e'
ps
|
v
`
elem
`
fv
e'
=
mkBinding
v
e
$
mkCase
(
Variable
v
)
w
e'
ps
|
otherwise
=
mkCase
e
w
e'
ps
-- create a binding for @w = e'@ if needed, and a case expression
-- @case e of { consAlts ++ (ps -> w) }@
mkCase
e
w
e'
ps
=
case
ps
of
[
p
]
->
Case
r
ea
e
(
consAlts
++
[
Alt
p
e'
])
_
->
mkBinding
w
e'
$
Case
r
ea
e
(
consAlts
++
[
Alt
p
(
Variable
w
)
|
p
<-
ps
])
-- If the alternatives' branches contain literal patterns, a complementary
-- constructor list cannot be generated because it would become potentially
...
...
test/MissingCaseCompletion.curry
0 → 100644
View file @
fe83ac4d
-- This module belongs to the ticket 1324
module MissingCaseCompletion where
-- The missing constructor False should not be expanded to "False -> Failed".
-- Instead it should be omitted.
f :: Bool -> Int
f b = case b of
True -> 1
-- The catch all pattern should be expanded to "False -> 0".
g :: Bool -> Int
g b = case b of
True -> 1
_ -> 0
-- The catch all pattern should be expanded to "False -> failed"
h :: Bool -> Int
h b = case b of
True -> 1
_ -> failed
-- To summarize the issue: If a case expression explicitely ignores at least one
-- constructor (i.e. it does not enumerate everyone and does not use a default
-- pattern), do not fill up with missing constructors and failed expressions.
\ No newline at end of file
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment