Enable declaration of recursive record types

src/Checks/TypeCheck.hs

@@ -185,11 +185,16 @@ checkTypeDecls _ []                    =
   internalError "TypeCheck.checkTypeDecls: empty list"
 checkTypeDecls _ [DataDecl    _ _ _ _] = return ()
 checkTypeDecls _ [NewtypeDecl _ _ _ _] = return ()
-checkTypeDecls m [TypeDecl  _ tc _ ty]
+checkTypeDecls m [t@(TypeDecl  _ tc _ ty)]
+  -- enable declaration of recursive record types
+  | isRecordDecl t       = return ()
   | tc `elem` ft m ty [] = report $ errRecursiveTypes [tc]
   | otherwise            = return ()
-checkTypeDecls _ (TypeDecl _ tc _ _ : ds) =
-    report $ errRecursiveTypes $ tc : [tc' | TypeDecl _ tc' _ _ <- ds]
+checkTypeDecls _ ts@(TypeDecl _ tc _ _ : ds)
+  -- enable declaration of mutually recursive record types
+  | any isRecordDecl ts = return ()
+  | otherwise           =
+      report $ errRecursiveTypes $ tc : [tc' | TypeDecl _ tc' _ _ <- ds]
 checkTypeDecls _ _                     =
   internalError "TypeCheck.checkTypeDecls: no type synonym"
 

test/RecursiveRecords.curry

 type R a = { f1 :: a, f2 :: String }
 
 
--- type Person = { name :: String, age :: Int, friends :: [Person] }
---
--- john = { name := "John", age := 21, friends := [tim] }
---
--- tim = { name := "Tim", age := 26, friends := [john] }
---
--- ann = { name := "Ann", age := 20, friends := [john,ann] }
---
--- getFriends :: Person -> [Person]
--- getFriends p = p :> friends
---
--- addFriend :: Person -> Person -> Person
--- addFriend p friend = { friends := friend : (getFriends p) | p }
---
--- getNames :: Person -> [String]
--- getNames { friends = fs | _ } = map (\p -> p :> name) fs
---
--- --------------------------------------------------------------------------------
---
--- type R1 = { r2 :: R2 }
--- type R2 = { r1 :: R1 }
---
--- rec1 = { r2 := rec2 }
--- rec2 = { r1 := rec1 }
---
--- type R3 = { f1 :: TSR3 }
--- type TSR3 = R3
\ No newline at end of file
+type Person = { name :: String, age :: Int, friends :: [Person] }
+
+john = { name := "John", age := 21, friends := [tim] }
+
+tim = { name := "Tim", age := 26, friends := [john] }
+
+ann = { name := "Ann", age := 20, friends := [john,ann] }
+
+getFriends :: Person -> [Person]
+getFriends p = p :> friends
+
+addFriend :: Person -> Person -> Person
+addFriend p friend = { friends := friend : (getFriends p) | p }
+
+getNames :: Person -> [String]
+getNames { friends = fs | _ } = map (\p -> p :> name) fs
+
+--------------------------------------------------------------------------------
+
+type R1 = { r2 :: R2 }
+type R2 = { r1 :: R1 }
+
+rec1 = { r2 := rec2 }
+rec2 = { r1 := rec1 }
+
+type R3 = { r3 :: TSR3 }
+type TSR3 = R3
\ No newline at end of file