@@ -16,7 +16,7 @@ import Guid
16data ParseType = VarPT String
16data ParseType = VarPT String
17 | LambdaPT ParseType ParseType
17 | LambdaPT ParseType ParseType
18 | ADTPT String [ParseType]
18 | ADTPT String [ParseType]
19− | RecordPT [(String,ParseType)]
19+ | RecordPT (Maybe ParseType) [(String,ParseType)]
21listPT t = ADTPT "List" [t]
21listPT t = ADTPT "List" [t]
22tuplePT ts = ADTPT ("Tuple" ++ show (length ts)) ts
22tuplePT ts = ADTPT ("Tuple" ++ show (length ts)) ts
@@ -32,10 +32,15 @@ typeTuple = do ts <- parens (commaSep typeExpr)
32 return $ case ts of { [t] -> t ; _ -> tuplePT ts }
32 return $ case ts of { [t] -> t ; _ -> tuplePT ts }
34typeRecord :: IParser ParseType
34typeRecord :: IParser ParseType
35−typeRecord = fmap RecordPT . brackets . commaSep $ do
35+typeRecord = brackets (RecordPT <$> extend <*> fields)
36+ where extend = optionMaybe . try $ do
38+ whitespace >> string "|" >> whitespace
40+ fields = commaSep $ do
36− lbl <- rLabel
41+ lbl <- rLabel
37− whitespace >> hasType >> whitespace
42+ whitespace >> hasType >> whitespace
38− (,) lbl <$> typeExpr
43+ (,) lbl <$> typeExpr
40typeUnambiguous :: IParser ParseType
45typeUnambiguous :: IParser ParseType
41typeUnambiguous = typeList <|> typeTuple <|> typeRecord
46typeUnambiguous = typeList <|> typeTuple <|> typeRecord
@@ -99,9 +104,9 @@ toType :: ParseType -> Type
99toType pt =
104toType pt =
100 let frees :: ParseType -> [String]
105 let frees :: ParseType -> [String]
101 frees pt = case pt of
106 frees pt = case pt of
102− LambdaPT a b -> frees a ++ frees b
107+ LambdaPT a b -> frees a ++ frees b
103− ADTPT _ ts -> concatMap frees ts
108+ ADTPT _ ts -> concatMap frees ts
104− RecordPT fs -> concatMap (frees . snd) fs
109+ RecordPT t fs -> maybe [] frees t ++ concatMap (frees . snd) fs
105 VarPT (c:cs) | isLower c -> [c:cs]
110 VarPT (c:cs) | isLower c -> [c:cs]
106 | otherwise -> []
111 | otherwise -> []
107 in case toTypeWith "" (zip (frees pt) [1..]) pt of
112 in case toTypeWith "" (zip (frees pt) [1..]) pt of
@@ -115,8 +120,9 @@ toTypeWith name tvarDict pt =
115 in case pt of
120 in case pt of
116 LambdaPT t1 t2 -> (==>) <$> toT t1 <*> toT t2
121 LambdaPT t1 t2 -> (==>) <$> toT t1 <*> toT t2
117 ADTPT name args -> ADT name <$> mapM toT args
122 ADTPT name args -> ADT name <$> mapM toT args
118− RecordPT fs -> do fs' <- mapM (\(x,pt) -> (,) x <$> toT pt) fs
123+ RecordPT t fs -> do fs' <- mapM (\(x,pt) -> (,) x <$> toT pt) fs
124+ ext <- maybe (return EmptyRecord) toT t
119− return (RecordT (recordT fs') EmptyRecord)
125+ return (RecordT (recordT fs') ext)
120 VarPT x@(c:_)
126 VarPT x@(c:_)
121 | not (isLower c) -> return $ ADT x []
127 | not (isLower c) -> return $ ADT x []
122 | otherwise -> VarT <$> case lookup x tvarDict of
128 | otherwise -> VarT <$> case lookup x tvarDict of