Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
curry
curry-frontend
Commits
efb6ab8d
Commit
efb6ab8d
authored
Dec 21, 2015
by
Björn Peemöller
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Consider parenthesized type expressions in Curry AST (by Katharina Rahf)
parent
2a3be814
Changes
13
Hide whitespace changes
Inline
Side-by-side
Showing
13 changed files
with
25 additions
and
8 deletions
+25
-8
CHANGELOG.md
CHANGELOG.md
+2
-0
src/Base/CurryTypes.hs
src/Base/CurryTypes.hs
+2
-1
src/Base/Expr.hs
src/Base/Expr.hs
+1
-0
src/Checks/InterfaceSyntaxCheck.hs
src/Checks/InterfaceSyntaxCheck.hs
+2
-1
src/Checks/KindCheck.hs
src/Checks/KindCheck.hs
+2
-0
src/Checks/TypeCheck.hs
src/Checks/TypeCheck.hs
+3
-0
src/Checks/WarnCheck.hs
src/Checks/WarnCheck.hs
+2
-2
src/Exports.hs
src/Exports.hs
+2
-0
src/Generators/GenAbstractCurry.hs
src/Generators/GenAbstractCurry.hs
+1
-0
src/Generators/GenFlatCurry.hs
src/Generators/GenFlatCurry.hs
+1
-0
src/Html/SyntaxColoring.hs
src/Html/SyntaxColoring.hs
+1
-0
src/ModuleSummary.hs
src/ModuleSummary.hs
+5
-4
src/Transformations/Qual.hs
src/Transformations/Qual.hs
+1
-0
No files found.
CHANGELOG.md
View file @
efb6ab8d
...
...
@@ -4,6 +4,8 @@ Change log for curry-frontend
Under development
=================
*
Consider parenthesized type expressions in the Curry AST (by Katharina Rahf)
Version 0.4.0
=============
...
...
src/Base/CurryTypes.hs
View file @
efb6ab8d
...
...
@@ -68,6 +68,7 @@ toType' tvs (CS.ListType ty)
=
TypeConstructor
(
qualify
listId
)
[
toType'
tvs
ty
]
toType'
tvs
(
CS
.
ArrowType
ty1
ty2
)
=
TypeArrow
(
toType'
tvs
ty1
)
(
toType'
tvs
ty2
)
toType'
tvs
(
CS
.
ParenType
ty
)
=
toType'
tvs
ty
fromQualType
::
ModuleIdent
->
Type
->
CS
.
TypeExpr
fromQualType
m
=
fromType
.
unqualifyType
m
...
...
@@ -93,4 +94,4 @@ ppType :: ModuleIdent -> Type -> Doc
ppType
m
=
ppTypeExpr
0
.
fromQualType
m
ppTypeScheme
::
ModuleIdent
->
TypeScheme
->
Doc
ppTypeScheme
m
(
ForAll
_
ty
)
=
ppType
m
ty
\ No newline at end of file
ppTypeScheme
m
(
ForAll
_
ty
)
=
ppType
m
ty
src/Base/Expr.hs
View file @
efb6ab8d
...
...
@@ -180,6 +180,7 @@ instance Expr TypeExpr where
fv
(
TupleType
tys
)
=
fv
tys
fv
(
ListType
ty
)
=
fv
ty
fv
(
ArrowType
ty1
ty2
)
=
fv
ty1
++
fv
ty2
fv
(
ParenType
ty
)
=
fv
ty
filterBv
::
QuantExpr
e
=>
e
->
[
Ident
]
->
[
Ident
]
filterBv
e
=
filter
(`
Set
.
notMember
`
Set
.
fromList
(
bv
e
))
src/Checks/InterfaceSyntaxCheck.hs
View file @
efb6ab8d
...
...
@@ -152,6 +152,7 @@ checkType (VariableType tv) = checkType (ConstructorType (qualify tv) [])
checkType
(
TupleType
tys
)
=
liftM
TupleType
(
mapM
checkType
tys
)
checkType
(
ListType
ty
)
=
liftM
ListType
(
checkType
ty
)
checkType
(
ArrowType
ty1
ty2
)
=
liftM2
ArrowType
(
checkType
ty1
)
(
checkType
ty2
)
checkType
(
ParenType
ty
)
=
liftM
ParenType
(
checkType
ty
)
checkTypeConstructor
::
QualIdent
->
[
TypeExpr
]
->
ISC
TypeExpr
checkTypeConstructor
tc
tys
=
do
...
...
@@ -199,4 +200,4 @@ errNoElement :: QualIdent -> Ident -> Message
errNoElement
tc
x
=
posMessage
tc
$
hsep
$
map
text
[
"Hidden constructor or label "
,
escName
x
,
" is not defined for type "
,
qualName
tc
]
\ No newline at end of file
]
src/Checks/KindCheck.hs
View file @
efb6ab8d
...
...
@@ -269,6 +269,7 @@ checkType v@(VariableType tv)
checkType
(
TupleType
tys
)
=
TupleType
<$>
mapM
checkType
tys
checkType
(
ListType
ty
)
=
ListType
<$>
checkType
ty
checkType
(
ArrowType
ty1
ty2
)
=
ArrowType
<$>
checkType
ty1
<*>
checkType
ty2
checkType
(
ParenType
ty
)
=
ParenType
<$>
checkType
ty
checkClosed
::
[
Ident
]
->
TypeExpr
->
KCM
()
checkClosed
tvs
(
ConstructorType
_
tys
)
=
mapM_
(
checkClosed
tvs
)
tys
...
...
@@ -277,6 +278,7 @@ checkClosed tvs (VariableType tv) = do
checkClosed
tvs
(
TupleType
tys
)
=
mapM_
(
checkClosed
tvs
)
tys
checkClosed
tvs
(
ListType
ty
)
=
checkClosed
tvs
ty
checkClosed
tvs
(
ArrowType
ty1
ty2
)
=
mapM_
(
checkClosed
tvs
)
[
ty1
,
ty2
]
checkClosed
tvs
(
ParenType
ty
)
=
checkClosed
tvs
ty
-- ---------------------------------------------------------------------------
-- Auxiliary definitions
...
...
src/Checks/TypeCheck.hs
View file @
efb6ab8d
...
...
@@ -201,6 +201,7 @@ ft _ (VariableType _) tcs = tcs
ft
m
(
TupleType
tys
)
tcs
=
foldr
(
ft
m
)
tcs
tys
ft
m
(
ListType
ty
)
tcs
=
ft
m
ty
tcs
ft
m
(
ArrowType
ty1
ty2
)
tcs
=
ft
m
ty1
$
ft
m
ty2
$
tcs
ft
m
(
ParenType
ty
)
tcs
=
ft
m
ty
tcs
-- When a field label occurs in more than one constructor declaration of
-- a data type, the compiler ensures that the label is defined
...
...
@@ -412,6 +413,8 @@ nameType (ArrowType ty1 ty2) tvs = (ArrowType ty1' ty2', tvs'')
(
ty2'
,
tvs''
)
=
nameType
ty2
tvs'
nameType
(
VariableType
_
)
[]
=
internalError
"TypeCheck.nameType: empty ident list"
nameType
(
ParenType
ty
)
tvs
=
(
ParenType
ty'
,
tvs'
)
where
(
ty'
,
tvs'
)
=
nameType
ty
tvs
-- Type Inference:
-- Before type checking a group of declarations, a dependency analysis is
...
...
src/Checks/WarnCheck.hs
View file @
efb6ab8d
...
...
@@ -258,6 +258,7 @@ checkTypeExpr (VariableType v) = visitTypeId v
checkTypeExpr
(
TupleType
tys
)
=
mapM_
checkTypeExpr
tys
checkTypeExpr
(
ListType
ty
)
=
checkTypeExpr
ty
checkTypeExpr
(
ArrowType
ty1
ty2
)
=
mapM_
checkTypeExpr
[
ty1
,
ty2
]
checkTypeExpr
(
ParenType
ty
)
=
checkTypeExpr
ty
-- Checks locally declared identifiers (i.e. functions and logic variables)
-- for shadowing
...
...
@@ -899,8 +900,7 @@ insertTypeExpr (ConstructorType _ tys) = mapM_ insertTypeExpr tys
insertTypeExpr
(
TupleType
tys
)
=
mapM_
insertTypeExpr
tys
insertTypeExpr
(
ListType
ty
)
=
insertTypeExpr
ty
insertTypeExpr
(
ArrowType
ty1
ty2
)
=
mapM_
insertTypeExpr
[
ty1
,
ty2
]
--mapM_ insertVar (concatMap fst fs)
--maybe (return ()) insertTypeExpr rty
insertTypeExpr
(
ParenType
ty
)
=
insertTypeExpr
ty
insertConstrDecl
::
ConstrDecl
->
WCM
()
insertConstrDecl
(
ConstrDecl
_
_
c
_
)
=
insertConsId
c
...
...
src/Exports.hs
View file @
efb6ab8d
...
...
@@ -194,6 +194,7 @@ identsType (VariableType _) xs = xs
identsType
(
TupleType
tys
)
xs
=
foldr
identsType
xs
tys
identsType
(
ListType
ty
)
xs
=
identsType
ty
xs
identsType
(
ArrowType
ty1
ty2
)
xs
=
identsType
ty1
(
identsType
ty2
xs
)
identsType
(
ParenType
ty
)
xs
=
identsType
ty
xs
-- After the interface declarations have been computed, the compiler
-- eventually must add hidden (data) type declarations to the interface
...
...
@@ -248,6 +249,7 @@ usedTypesType (TupleType tys) tcs = foldr usedTypesType tcs tys
usedTypesType
(
ListType
ty
)
tcs
=
usedTypesType
ty
tcs
usedTypesType
(
ArrowType
ty1
ty2
)
tcs
=
usedTypesType
ty1
(
usedTypesType
ty2
tcs
)
usedTypesType
(
ParenType
ty
)
tcs
=
usedTypesType
ty
tcs
definedTypes
::
[
IDecl
]
->
[
QualIdent
]
definedTypes
ds
=
foldr
definedType
[]
ds
...
...
src/Generators/GenAbstractCurry.hs
View file @
efb6ab8d
...
...
@@ -112,6 +112,7 @@ trTypeExpr (TupleType tys) = trTypeExpr $ case tys of
trTypeExpr
(
ListType
ty
)
=
trTypeExpr
$
ConstructorType
qListId
[
ty
]
trTypeExpr
(
ArrowType
ty1
ty2
)
=
CFuncType
<$>
trTypeExpr
ty1
<*>
trTypeExpr
ty2
trTypeExpr
(
ParenType
ty
)
=
trTypeExpr
ty
trInfixDecl
::
Decl
->
GAC
[
COpDecl
]
trInfixDecl
(
InfixDecl
_
fix
mprec
ops
)
=
mapM
trInfix
(
reverse
ops
)
...
...
src/Generators/GenFlatCurry.hs
View file @
efb6ab8d
...
...
@@ -564,6 +564,7 @@ cs2ilType ids (CS.TupleType typeexprs)
_
->
let
(
ids'
,
ilTypeexprs
)
=
mapAccumL
cs2ilType
ids
typeexprs
tuplen
=
length
ilTypeexprs
in
(
ids'
,
IL
.
TypeConstructor
(
qTupleId
tuplen
)
ilTypeexprs
)
cs2ilType
ids
(
CS
.
ParenType
ty
)
=
cs2ilType
ids
ty
isPublicDataDecl
::
IL
.
Decl
->
FlatState
Bool
isPublicDataDecl
(
IL
.
DataDecl
qid
_
_
)
=
isPublic
False
qid
...
...
src/Html/SyntaxColoring.hs
View file @
efb6ab8d
...
...
@@ -323,6 +323,7 @@ idsTypeExpr (VariableType v) = [Identifier IdRefer (qualify v)]
idsTypeExpr
(
TupleType
tys
)
=
concatMap
idsTypeExpr
tys
idsTypeExpr
(
ListType
ty
)
=
idsTypeExpr
ty
idsTypeExpr
(
ArrowType
ty1
ty2
)
=
concatMap
idsTypeExpr
[
ty1
,
ty2
]
idsTypeExpr
(
ParenType
ty
)
=
idsTypeExpr
ty
idsFieldDecl
::
FieldDecl
->
[
Code
]
idsFieldDecl
(
FieldDecl
_
ls
ty
)
=
...
...
src/ModuleSummary.hs
View file @
efb6ab8d
...
...
@@ -93,15 +93,16 @@ modifyTypeExpr tcEnv (ConstructorType q tys) = case qualLookupTC q tcEnv of
(
genTypeSynDeref
(
zip
[
0
..
ar
-
1
]
tys
)
ty
)
_
->
ConstructorType
(
fromMaybe
q
(
lookupTCId
q
tcEnv
))
(
map
(
modifyTypeExpr
tcEnv
)
tys
)
modifyTypeExpr
_
v
@
(
VariableType
_
)
=
v
modifyTypeExpr
tcEnv
(
ArrowType
ty1
ty2
)
modifyTypeExpr
_
v
@
(
VariableType
_
)
=
v
modifyTypeExpr
tcEnv
(
ArrowType
ty1
ty2
)
=
ArrowType
(
modifyTypeExpr
tcEnv
ty1
)
(
modifyTypeExpr
tcEnv
ty2
)
modifyTypeExpr
tcEnv
(
TupleType
tys
)
modifyTypeExpr
tcEnv
(
TupleType
tys
)
|
null
tys
=
ConstructorType
qUnitId
[]
|
otherwise
=
ConstructorType
(
qTupleId
$
length
tys
)
(
map
(
modifyTypeExpr
tcEnv
)
tys
)
modifyTypeExpr
tcEnv
(
ListType
ty
)
modifyTypeExpr
tcEnv
(
ListType
ty
)
=
ConstructorType
(
qualify
listId
)
[
modifyTypeExpr
tcEnv
ty
]
modifyTypeExpr
tcEnv
(
ParenType
ty
)
=
modifyTypeExpr
tcEnv
ty
--
genTypeSynDeref
::
[(
Int
,
TypeExpr
)]
->
Type
->
TypeExpr
...
...
src/Transformations/Qual.hs
View file @
efb6ab8d
...
...
@@ -102,6 +102,7 @@ qTypeExpr (TupleType tys) = TupleType <$> mapM qTypeExpr tys
qTypeExpr
(
ListType
ty
)
=
ListType
<$>
qTypeExpr
ty
qTypeExpr
(
ArrowType
ty1
ty2
)
=
ArrowType
<$>
qTypeExpr
ty1
<*>
qTypeExpr
ty2
qTypeExpr
(
ParenType
ty
)
=
ParenType
<$>
qTypeExpr
ty
qEquation
::
Qual
Equation
qEquation
(
Equation
p
lhs
rhs
)
=
Equation
p
<$>
qLhs
lhs
<*>
qRhs
rhs
...
...
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