git.iko.soy/elk
on 501c607 help sign in
elk/src/Parse/Type.hs
91 lines 2.1 kB history raw
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2module Parse.Type where
4import Control.Applicative ((<$>),(<*>),(<*))
5import Data.List (intercalate)
6import Text.Parsec ((<|>), (<?>), char, many, optionMaybe, string, try)
8import qualified AST.Type as T
9import qualified AST.Variable as Var
10import Parse.Helpers
13tvar :: IParser T.RawType
14tvar =
15 T.Var <$> lowVar <?> "type variable"
18tuple :: IParser T.RawType
19tuple =
20 do ts <- parens (commaSep expr)
21 case ts of
22 [t] -> return t
23 _ -> return (T.tupleOf ts)
26record :: IParser T.RawType
27record =
28 do char '{'
29 whitespace
30 rcrd <- extended <|> normal
31 dumbWhitespace
32 char '}'
33 return rcrd
34 where
35 normal = flip T.Record Nothing <$> commaSep field
37 -- extended record types require at least one field
38 extended = do
39 ext <- try (lowVar <* (whitespace >> string "|"))
40 whitespace
41 flip T.Record (Just (T.Var ext)) <$> commaSep1 field
43 field = do
44 lbl <- rLabel
45 whitespace >> hasType >> whitespace
46 (,) lbl <$> expr
49capTypeVar :: IParser String
50capTypeVar =
51 intercalate "." <$> dotSep1 capVar
54constructor0 :: IParser T.RawType
55constructor0 =
56 do name <- capTypeVar
57 return (T.Type (Var.Raw name))
60term :: IParser T.RawType
61term =
62 tuple <|> record <|> tvar <|> constructor0
65app :: IParser T.RawType
66app =
67 do f <- constructor0 <|> try tupleCtor <?> "type constructor"
68 args <- spacePrefix term
69 case args of
70 [] -> return f
71 _ -> return (T.App f args)
72 where
73 tupleCtor = do
74 n <- length <$> parens (many (char ','))
75 let ctor = "_Tuple" ++ show (if n == 0 then 0 else n+1)
76 return (T.Type (Var.Raw ctor))
79expr :: IParser T.RawType
80expr =
81 do t1 <- app <|> term
82 arr <- optionMaybe $ try (whitespace >> arrow)
83 case arr of
84 Just _ -> T.Lambda t1 <$> (whitespace >> expr)
85 Nothing -> return t1
88constructor :: IParser (String, [T.RawType])
89constructor =
90 (,) <$> (capTypeVar <?> "another type constructor")
91 <*> spacePrefix term