Commit efb6ab8d authored by Björn Peemöller 's avatar Björn Peemöller

Consider parenthesized type expressions in Curry AST (by Katharina Rahf)

parent 2a3be814
......@@ -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
=============
......
......@@ -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
......@@ -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))
......@@ -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
]
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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) =
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment