git.iko.soy/elk
on 577fc17 help sign in
elk/compiler/Parse/Type.hs
78 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
8import qualified AST.Type as T
9import qualified AST.Variable as Var
10import Parse.Helpers
12tvar :: IParser T.RawType
13tvar = T.Var <$> lowVar <?> "type variable"
15list :: IParser T.RawType
16list = T.listOf <$> braces expr
18tuple :: IParser T.RawType
19tuple = do ts <- parens (commaSep expr)
20 return $ case ts of
21 [t] -> t
22 _ -> T.tupleOf ts
24record :: IParser T.RawType
25record =
26 do char '{' ; whitespace
27 rcrd <- extended <|> normal
28 dumbWhitespace ; char '}'
29 return rcrd
30 where
31 normal = flip T.Record Nothing <$> commaSep field
33 -- extended record types require at least one field
34 extended = do
35 ext <- try (lowVar <* (whitespace >> string "|"))
36 whitespace
37 flip T.Record (Just (T.Var ext)) <$> commaSep1 field
39 field = do
40 lbl <- rLabel
41 whitespace >> hasType >> whitespace
42 (,) lbl <$> expr
44capTypeVar :: IParser String
45capTypeVar = intercalate "." <$> dotSep1 capVar
47constructor0 :: IParser T.RawType
48constructor0 =
49 do name <- capTypeVar
50 return (T.Type (Var.Raw name))
52term :: IParser T.RawType
53term = list <|> tuple <|> record <|> tvar <|> constructor0
55app :: IParser T.RawType
56app =
57 do f <- constructor0 <|> tvar <|> try tupleCtor <?> "type constructor"
58 args <- spacePrefix term
59 return $ case args of
60 [] -> f
61 _ -> T.App f args
62 where
63 tupleCtor = do
64 n <- length <$> parens (many (char ','))
65 let ctor = "_Tuple" ++ show (if n == 0 then 0 else n+1)
66 return (T.Type (Var.Raw ctor))
68expr :: IParser T.RawType
69expr =
70 do t1 <- app <|> term
71 arr <- optionMaybe $ try (whitespace >> arrow)
72 case arr of
73 Just _ -> T.Lambda t1 <$> (whitespace >> expr)
74 Nothing -> return t1
76constructor :: IParser (String, [T.RawType])
77constructor = (,) <$> (capTypeVar <?> "another type constructor")
78 <*> spacePrefix term