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 ...@@ -4,6 +4,8 @@ Change log for curry-frontend
Under development Under development
================= =================
* Consider parenthesized type expressions in the Curry AST (by Katharina Rahf)
Version 0.4.0 Version 0.4.0
============= =============
......
...@@ -68,6 +68,7 @@ toType' tvs (CS.ListType ty) ...@@ -68,6 +68,7 @@ toType' tvs (CS.ListType ty)
= TypeConstructor (qualify listId) [toType' tvs ty] = TypeConstructor (qualify listId) [toType' tvs ty]
toType' tvs (CS.ArrowType ty1 ty2) toType' tvs (CS.ArrowType ty1 ty2)
= TypeArrow (toType' tvs ty1) (toType' tvs ty2) = TypeArrow (toType' tvs ty1) (toType' tvs ty2)
toType' tvs (CS.ParenType ty) = toType' tvs ty
fromQualType :: ModuleIdent -> Type -> CS.TypeExpr fromQualType :: ModuleIdent -> Type -> CS.TypeExpr
fromQualType m = fromType . unqualifyType m fromQualType m = fromType . unqualifyType m
...@@ -93,4 +94,4 @@ ppType :: ModuleIdent -> Type -> Doc ...@@ -93,4 +94,4 @@ ppType :: ModuleIdent -> Type -> Doc
ppType m = ppTypeExpr 0 . fromQualType m ppType m = ppTypeExpr 0 . fromQualType m
ppTypeScheme :: ModuleIdent -> TypeScheme -> Doc ppTypeScheme :: ModuleIdent -> TypeScheme -> Doc
ppTypeScheme m (ForAll _ ty) = ppType m ty ppTypeScheme m (ForAll _ ty) = ppType m ty
\ No newline at end of file
...@@ -180,6 +180,7 @@ instance Expr TypeExpr where ...@@ -180,6 +180,7 @@ instance Expr TypeExpr where
fv (TupleType tys) = fv tys fv (TupleType tys) = fv tys
fv (ListType ty) = fv ty fv (ListType ty) = fv ty
fv (ArrowType ty1 ty2) = fv ty1 ++ fv ty2 fv (ArrowType ty1 ty2) = fv ty1 ++ fv ty2
fv (ParenType ty) = fv ty
filterBv :: QuantExpr e => e -> [Ident] -> [Ident] filterBv :: QuantExpr e => e -> [Ident] -> [Ident]
filterBv e = filter (`Set.notMember` Set.fromList (bv e)) filterBv e = filter (`Set.notMember` Set.fromList (bv e))
...@@ -152,6 +152,7 @@ checkType (VariableType tv) = checkType (ConstructorType (qualify tv) []) ...@@ -152,6 +152,7 @@ checkType (VariableType tv) = checkType (ConstructorType (qualify tv) [])
checkType (TupleType tys) = liftM TupleType (mapM checkType tys) checkType (TupleType tys) = liftM TupleType (mapM checkType tys)
checkType (ListType ty) = liftM ListType (checkType ty) checkType (ListType ty) = liftM ListType (checkType ty)
checkType (ArrowType ty1 ty2) = liftM2 ArrowType (checkType ty1) (checkType ty2) checkType (ArrowType ty1 ty2) = liftM2 ArrowType (checkType ty1) (checkType ty2)
checkType (ParenType ty) = liftM ParenType (checkType ty)
checkTypeConstructor :: QualIdent -> [TypeExpr] -> ISC TypeExpr checkTypeConstructor :: QualIdent -> [TypeExpr] -> ISC TypeExpr
checkTypeConstructor tc tys = do checkTypeConstructor tc tys = do
...@@ -199,4 +200,4 @@ errNoElement :: QualIdent -> Ident -> Message ...@@ -199,4 +200,4 @@ errNoElement :: QualIdent -> Ident -> Message
errNoElement tc x = posMessage tc $ hsep $ map text errNoElement tc x = posMessage tc $ hsep $ map text
[ "Hidden constructor or label ", escName x [ "Hidden constructor or label ", escName x
, " is not defined for type ", qualName tc , " is not defined for type ", qualName tc
] ]
\ No newline at end of file
...@@ -269,6 +269,7 @@ checkType v@(VariableType tv) ...@@ -269,6 +269,7 @@ checkType v@(VariableType tv)
checkType (TupleType tys) = TupleType <$> mapM checkType tys checkType (TupleType tys) = TupleType <$> mapM checkType tys
checkType (ListType ty) = ListType <$> checkType ty checkType (ListType ty) = ListType <$> checkType ty
checkType (ArrowType ty1 ty2) = ArrowType <$> checkType ty1 <*> checkType ty2 checkType (ArrowType ty1 ty2) = ArrowType <$> checkType ty1 <*> checkType ty2
checkType (ParenType ty) = ParenType <$> checkType ty
checkClosed :: [Ident] -> TypeExpr -> KCM () checkClosed :: [Ident] -> TypeExpr -> KCM ()
checkClosed tvs (ConstructorType _ tys) = mapM_ (checkClosed tvs) tys checkClosed tvs (ConstructorType _ tys) = mapM_ (checkClosed tvs) tys
...@@ -277,6 +278,7 @@ checkClosed tvs (VariableType tv) = do ...@@ -277,6 +278,7 @@ checkClosed tvs (VariableType tv) = do
checkClosed tvs (TupleType tys) = mapM_ (checkClosed tvs) tys checkClosed tvs (TupleType tys) = mapM_ (checkClosed tvs) tys
checkClosed tvs (ListType ty) = checkClosed tvs ty checkClosed tvs (ListType ty) = checkClosed tvs ty
checkClosed tvs (ArrowType ty1 ty2) = mapM_ (checkClosed tvs) [ty1, ty2] checkClosed tvs (ArrowType ty1 ty2) = mapM_ (checkClosed tvs) [ty1, ty2]
checkClosed tvs (ParenType ty) = checkClosed tvs ty
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- Auxiliary definitions -- Auxiliary definitions
......
...@@ -201,6 +201,7 @@ ft _ (VariableType _) tcs = tcs ...@@ -201,6 +201,7 @@ ft _ (VariableType _) tcs = tcs
ft m (TupleType tys) tcs = foldr (ft m) tcs tys ft m (TupleType tys) tcs = foldr (ft m) tcs tys
ft m (ListType ty) tcs = ft m ty tcs ft m (ListType ty) tcs = ft m ty tcs
ft m (ArrowType ty1 ty2) tcs = ft m ty1 $ ft m ty2 $ 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 -- When a field label occurs in more than one constructor declaration of
-- a data type, the compiler ensures that the label is defined -- a data type, the compiler ensures that the label is defined
...@@ -412,6 +413,8 @@ nameType (ArrowType ty1 ty2) tvs = (ArrowType ty1' ty2', tvs'') ...@@ -412,6 +413,8 @@ nameType (ArrowType ty1 ty2) tvs = (ArrowType ty1' ty2', tvs'')
(ty2', tvs'') = nameType ty2 tvs' (ty2', tvs'') = nameType ty2 tvs'
nameType (VariableType _) [] = internalError nameType (VariableType _) [] = internalError
"TypeCheck.nameType: empty ident list" "TypeCheck.nameType: empty ident list"
nameType (ParenType ty) tvs = (ParenType ty', tvs')
where (ty', tvs') = nameType ty tvs
-- Type Inference: -- Type Inference:
-- Before type checking a group of declarations, a dependency analysis is -- Before type checking a group of declarations, a dependency analysis is
......
...@@ -258,6 +258,7 @@ checkTypeExpr (VariableType v) = visitTypeId v ...@@ -258,6 +258,7 @@ checkTypeExpr (VariableType v) = visitTypeId v
checkTypeExpr (TupleType tys) = mapM_ checkTypeExpr tys checkTypeExpr (TupleType tys) = mapM_ checkTypeExpr tys
checkTypeExpr (ListType ty) = checkTypeExpr ty checkTypeExpr (ListType ty) = checkTypeExpr ty
checkTypeExpr (ArrowType ty1 ty2) = mapM_ checkTypeExpr [ty1, ty2] checkTypeExpr (ArrowType ty1 ty2) = mapM_ checkTypeExpr [ty1, ty2]
checkTypeExpr (ParenType ty) = checkTypeExpr ty
-- Checks locally declared identifiers (i.e. functions and logic variables) -- Checks locally declared identifiers (i.e. functions and logic variables)
-- for shadowing -- for shadowing
...@@ -899,8 +900,7 @@ insertTypeExpr (ConstructorType _ tys) = mapM_ insertTypeExpr tys ...@@ -899,8 +900,7 @@ insertTypeExpr (ConstructorType _ tys) = mapM_ insertTypeExpr tys
insertTypeExpr (TupleType tys) = mapM_ insertTypeExpr tys insertTypeExpr (TupleType tys) = mapM_ insertTypeExpr tys
insertTypeExpr (ListType ty) = insertTypeExpr ty insertTypeExpr (ListType ty) = insertTypeExpr ty
insertTypeExpr (ArrowType ty1 ty2) = mapM_ insertTypeExpr [ty1,ty2] insertTypeExpr (ArrowType ty1 ty2) = mapM_ insertTypeExpr [ty1,ty2]
--mapM_ insertVar (concatMap fst fs) insertTypeExpr (ParenType ty) = insertTypeExpr ty
--maybe (return ()) insertTypeExpr rty
insertConstrDecl :: ConstrDecl -> WCM () insertConstrDecl :: ConstrDecl -> WCM ()
insertConstrDecl (ConstrDecl _ _ c _) = insertConsId c insertConstrDecl (ConstrDecl _ _ c _) = insertConsId c
......
...@@ -194,6 +194,7 @@ identsType (VariableType _) xs = xs ...@@ -194,6 +194,7 @@ identsType (VariableType _) xs = xs
identsType (TupleType tys) xs = foldr identsType xs tys identsType (TupleType tys) xs = foldr identsType xs tys
identsType (ListType ty) xs = identsType ty xs identsType (ListType ty) xs = identsType ty xs
identsType (ArrowType ty1 ty2) xs = identsType ty1 (identsType ty2 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 -- After the interface declarations have been computed, the compiler
-- eventually must add hidden (data) type declarations to the interface -- eventually must add hidden (data) type declarations to the interface
...@@ -248,6 +249,7 @@ usedTypesType (TupleType tys) tcs = foldr usedTypesType tcs tys ...@@ -248,6 +249,7 @@ usedTypesType (TupleType tys) tcs = foldr usedTypesType tcs tys
usedTypesType (ListType ty) tcs = usedTypesType ty tcs usedTypesType (ListType ty) tcs = usedTypesType ty tcs
usedTypesType (ArrowType ty1 ty2) tcs = usedTypesType (ArrowType ty1 ty2) tcs =
usedTypesType ty1 (usedTypesType ty2 tcs) usedTypesType ty1 (usedTypesType ty2 tcs)
usedTypesType (ParenType ty) tcs = usedTypesType ty tcs
definedTypes :: [IDecl] -> [QualIdent] definedTypes :: [IDecl] -> [QualIdent]
definedTypes ds = foldr definedType [] ds definedTypes ds = foldr definedType [] ds
......
...@@ -112,6 +112,7 @@ trTypeExpr (TupleType tys) = trTypeExpr $ case tys of ...@@ -112,6 +112,7 @@ trTypeExpr (TupleType tys) = trTypeExpr $ case tys of
trTypeExpr (ListType ty) = trTypeExpr $ ConstructorType qListId [ty] trTypeExpr (ListType ty) = trTypeExpr $ ConstructorType qListId [ty]
trTypeExpr (ArrowType ty1 ty2) = CFuncType <$> trTypeExpr ty1 trTypeExpr (ArrowType ty1 ty2) = CFuncType <$> trTypeExpr ty1
<*> trTypeExpr ty2 <*> trTypeExpr ty2
trTypeExpr (ParenType ty) = trTypeExpr ty
trInfixDecl :: Decl -> GAC [COpDecl] trInfixDecl :: Decl -> GAC [COpDecl]
trInfixDecl (InfixDecl _ fix mprec ops) = mapM trInfix (reverse ops) trInfixDecl (InfixDecl _ fix mprec ops) = mapM trInfix (reverse ops)
......
...@@ -564,6 +564,7 @@ cs2ilType ids (CS.TupleType typeexprs) ...@@ -564,6 +564,7 @@ cs2ilType ids (CS.TupleType typeexprs)
_ -> let (ids', ilTypeexprs) = mapAccumL cs2ilType ids typeexprs _ -> let (ids', ilTypeexprs) = mapAccumL cs2ilType ids typeexprs
tuplen = length ilTypeexprs tuplen = length ilTypeexprs
in (ids', IL.TypeConstructor (qTupleId tuplen) ilTypeexprs) in (ids', IL.TypeConstructor (qTupleId tuplen) ilTypeexprs)
cs2ilType ids (CS.ParenType ty) = cs2ilType ids ty
isPublicDataDecl :: IL.Decl -> FlatState Bool isPublicDataDecl :: IL.Decl -> FlatState Bool
isPublicDataDecl (IL.DataDecl qid _ _) = isPublic False qid isPublicDataDecl (IL.DataDecl qid _ _) = isPublic False qid
......
...@@ -323,6 +323,7 @@ idsTypeExpr (VariableType v) = [Identifier IdRefer (qualify v)] ...@@ -323,6 +323,7 @@ idsTypeExpr (VariableType v) = [Identifier IdRefer (qualify v)]
idsTypeExpr (TupleType tys) = concatMap idsTypeExpr tys idsTypeExpr (TupleType tys) = concatMap idsTypeExpr tys
idsTypeExpr (ListType ty) = idsTypeExpr ty idsTypeExpr (ListType ty) = idsTypeExpr ty
idsTypeExpr (ArrowType ty1 ty2) = concatMap idsTypeExpr [ty1, ty2] idsTypeExpr (ArrowType ty1 ty2) = concatMap idsTypeExpr [ty1, ty2]
idsTypeExpr (ParenType ty) = idsTypeExpr ty
idsFieldDecl :: FieldDecl -> [Code] idsFieldDecl :: FieldDecl -> [Code]
idsFieldDecl (FieldDecl _ ls ty) = idsFieldDecl (FieldDecl _ ls ty) =
......
...@@ -93,15 +93,16 @@ modifyTypeExpr tcEnv (ConstructorType q tys) = case qualLookupTC q tcEnv of ...@@ -93,15 +93,16 @@ modifyTypeExpr tcEnv (ConstructorType q tys) = case qualLookupTC q tcEnv of
(genTypeSynDeref (zip [0 .. ar - 1] tys) ty) (genTypeSynDeref (zip [0 .. ar - 1] tys) ty)
_ -> ConstructorType (fromMaybe q (lookupTCId q tcEnv)) _ -> ConstructorType (fromMaybe q (lookupTCId q tcEnv))
(map (modifyTypeExpr tcEnv) tys) (map (modifyTypeExpr tcEnv) tys)
modifyTypeExpr _ v@(VariableType _) = v modifyTypeExpr _ v@(VariableType _) = v
modifyTypeExpr tcEnv (ArrowType ty1 ty2) modifyTypeExpr tcEnv (ArrowType ty1 ty2)
= ArrowType (modifyTypeExpr tcEnv ty1) (modifyTypeExpr tcEnv ty2) = ArrowType (modifyTypeExpr tcEnv ty1) (modifyTypeExpr tcEnv ty2)
modifyTypeExpr tcEnv (TupleType tys) modifyTypeExpr tcEnv (TupleType tys)
| null tys = ConstructorType qUnitId [] | null tys = ConstructorType qUnitId []
| otherwise = ConstructorType (qTupleId $ length tys) | otherwise = ConstructorType (qTupleId $ length tys)
(map (modifyTypeExpr tcEnv) tys) (map (modifyTypeExpr tcEnv) tys)
modifyTypeExpr tcEnv (ListType ty) modifyTypeExpr tcEnv (ListType ty)
= ConstructorType (qualify listId) [modifyTypeExpr tcEnv ty] = ConstructorType (qualify listId) [modifyTypeExpr tcEnv ty]
modifyTypeExpr tcEnv (ParenType ty) = modifyTypeExpr tcEnv ty
-- --
genTypeSynDeref :: [(Int, TypeExpr)] -> Type -> TypeExpr genTypeSynDeref :: [(Int, TypeExpr)] -> Type -> TypeExpr
......
...@@ -102,6 +102,7 @@ qTypeExpr (TupleType tys) = TupleType <$> mapM qTypeExpr tys ...@@ -102,6 +102,7 @@ qTypeExpr (TupleType tys) = TupleType <$> mapM qTypeExpr tys
qTypeExpr (ListType ty) = ListType <$> qTypeExpr ty qTypeExpr (ListType ty) = ListType <$> qTypeExpr ty
qTypeExpr (ArrowType ty1 ty2) = ArrowType <$> qTypeExpr ty1 qTypeExpr (ArrowType ty1 ty2) = ArrowType <$> qTypeExpr ty1
<*> qTypeExpr ty2 <*> qTypeExpr ty2
qTypeExpr (ParenType ty) = ParenType <$> qTypeExpr ty
qEquation :: Qual Equation qEquation :: Qual Equation
qEquation (Equation p lhs rhs) = Equation p <$> qLhs lhs <*> qRhs rhs 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