@@ -16,7 +16,7 @@ import Guid
1616data ParseType = VarPT String
1717 | LambdaPT ParseType ParseType
1818 | ADTPT String [ParseType]
19− | RecordPT [(String,ParseType)]
19+ | RecordPT (Maybe ParseType) [(String,ParseType)]
2020
2121listPT t = ADTPT "List" [t]
2222tuplePT ts = ADTPT ("Tuple" ++ show (length ts)) ts
@@ -32,10 +32,15 @@ typeTuple = do ts <- parens (commaSep typeExpr)
3232 return $ case ts of { [t] -> t ; _ -> tuplePT ts }
3333
3434typeRecord :: IParser ParseType
35−typeRecord = fmap RecordPT . brackets . commaSep $ do
36− lbl <- rLabel
37− whitespace >> hasType >> whitespace
38− (,) lbl <$> typeExpr
35+typeRecord = brackets (RecordPT <$> extend <*> fields)
36+ where extend = optionMaybe . try $ do
37+ t <- typeVar
38+ whitespace >> string "|" >> whitespace
39+ return t
40+ fields = commaSep $ do
41+ lbl <- rLabel
42+ whitespace >> hasType >> whitespace
43+ (,) lbl <$> typeExpr
3944
4045typeUnambiguous :: IParser ParseType
4146typeUnambiguous = typeList <|> typeTuple <|> typeRecord
@@ -99,9 +104,9 @@ toType :: ParseType -> Type
99104toType pt =
100105 let frees :: ParseType -> [String]
101106 frees pt = case pt of
102− LambdaPT a b -> frees a ++ frees b
103− ADTPT _ ts -> concatMap frees ts
104− RecordPT fs -> concatMap (frees . snd) fs
107+ LambdaPT a b -> frees a ++ frees b
108+ ADTPT _ ts -> concatMap frees ts
109+ RecordPT t fs -> maybe [] frees t ++ concatMap (frees . snd) fs
105110 VarPT (c:cs) | isLower c -> [c:cs]
106111 | otherwise -> []
107112 in case toTypeWith "" (zip (frees pt) [1..]) pt of
@@ -115,8 +120,9 @@ toTypeWith name tvarDict pt =
115120 in case pt of
116121 LambdaPT t1 t2 -> (==>) <$> toT t1 <*> toT t2
117122 ADTPT name args -> ADT name <$> mapM toT args
118− RecordPT fs -> do fs' <- mapM (\(x,pt) -> (,) x <$> toT pt) fs
119− return (RecordT (recordT fs') EmptyRecord)
123+ RecordPT t fs -> do fs' <- mapM (\(x,pt) -> (,) x <$> toT pt) fs
124+ ext <- maybe (return EmptyRecord) toT t
125+ return (RecordT (recordT fs') ext)
120126 VarPT x@(c:_)
121127 | not (isLower c) -> return $ ADT x []
122128 | otherwise -> VarT <$> case lookup x tvarDict of