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

CHANGELOG.md

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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