Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
curry
curry-frontend
Commits
d02680b0
Commit
d02680b0
authored
Sep 14, 2015
by
Björn Peemöller
Browse files
Fixed wrong desugaring of section in AbstractCurry
parent
27b59ad4
Changes
1
Hide whitespace changes
Inline
Side-by-side
src/Generators/GenAbstractCurry.hs
View file @
d02680b0
...
...
@@ -29,7 +29,6 @@ import qualified Data.Traversable as T (forM)
import
Curry.AbstractCurry
import
Curry.Base.Ident
import
Curry.Base.Position
import
Curry.Syntax
import
Base.CurryTypes
(
fromType
)
...
...
@@ -223,14 +222,9 @@ trExpr (EnumFromThenTo e1 e2 e3) = trExpr
trExpr
(
UnaryMinus
_
e
)
=
trExpr
$
apply
(
Variable
qNegateId
)
[
e
]
trExpr
(
Apply
e1
e2
)
=
CApply
<$>
trExpr
e1
<*>
trExpr
e2
trExpr
(
InfixApply
e1
op
e2
)
=
trExpr
$
apply
(
opToExpr
op
)
[
e1
,
e2
]
trExpr
(
LeftSection
e
op
)
=
do
v
<-
freshVar
"x"
trExpr
$
Lambda
noRef
[
VariablePattern
v
]
$
Apply
(
Apply
(
opToExpr
op
)
e
)
(
Variable
$
qualify
v
)
trExpr
(
RightSection
op
e
)
=
do
v
<-
freshVar
"x"
trExpr
$
Lambda
noRef
[
VariablePattern
v
]
$
Apply
(
Apply
(
opToExpr
op
)
(
Variable
$
qualify
v
))
e
trExpr
(
LeftSection
e
op
)
=
trExpr
$
apply
(
opToExpr
op
)
[
e
]
trExpr
(
RightSection
op
e
)
=
trExpr
$
apply
(
Variable
qFlip
)
[
opToExpr
op
,
e
]
trExpr
(
Lambda
_
ps
e
)
=
inNestedScope
$
CLambda
<$>
mapM
trPat
ps
<*>
trExpr
e
trExpr
(
Let
ds
e
)
=
inNestedScope
$
...
...
@@ -313,6 +307,9 @@ opToExpr :: InfixOp -> Expression
opToExpr
(
InfixOp
op
)
=
Variable
op
opToExpr
(
InfixConstr
c
)
=
Constructor
c
qFlip
::
QualIdent
qFlip
=
qualifyWith
preludeMIdent
(
mkIdent
"flip"
)
qEnumFromId
::
QualIdent
qEnumFromId
=
qualifyWith
preludeMIdent
(
mkIdent
"enumFrom"
)
...
...
@@ -408,17 +405,6 @@ genVarIndex i = do
S
.
put
$
env
{
varIndex
=
idx
+
1
,
varEnv
=
bindNestEnv
i
idx
(
varEnv
env
)
}
return
(
idx
,
idName
i
)
-- Generates an identifier which doesn't occur in the variable table
-- of the current scope.
freshVar
::
String
->
GAC
Ident
freshVar
vname
=
S
.
gets
$
genFreshVar
0
.
varEnv
where
genFreshVar
::
Int
->
NestEnv
a
->
Ident
genFreshVar
idx
vs
|
elemNestEnv
ident
vs
=
genFreshVar
(
idx
+
1
)
vs
|
otherwise
=
ident
where
ident
=
mkIdent
$
vname
++
show
idx
-- Looks up the unique index for the type variable 'ident' in the type
-- variable table of the current scope.
getTVarIndex
::
Ident
->
GAC
CTVarIName
...
...
@@ -478,9 +464,9 @@ getType' f False = do
++
show
f
getTypeVisibility
::
Ident
->
GAC
CVisibility
getTypeVisibility
i
=
S
.
gets
$
\
env
->
getTypeVisibility
i
=
S
.
gets
$
\
env
->
if
Set
.
member
i
(
tyExports
env
)
then
Public
else
Private
getVisibility
::
Ident
->
GAC
CVisibility
getVisibility
i
=
S
.
gets
$
\
env
->
getVisibility
i
=
S
.
gets
$
\
env
->
if
Set
.
member
i
(
valExports
env
)
then
Public
else
Private
Write
Preview
Supports
Markdown
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