git.iko.soy/elk
on 45cfc8f help sign in
elk/compiler/Types/Types.hs
94 lines 2.7 kB history raw
2module Types.Types where
4import Located
5import Data.Char (isDigit)
6import Data.List (intercalate,isPrefixOf)
7import qualified Data.Set as Set
8import qualified Data.Map as Map
10type X = Int
12data Type = LambdaT Type Type
13 | VarT X
14 | ADT String [Type]
15 | EmptyRecord
16 | RecordT (Map.Map String [Type]) Type
17 | Super (Set.Set Type)
18 deriving (Eq, Ord)
20data Scheme = Forall [X] [Located Constraint] Type deriving (Eq, Ord, Show)
22data Constraint = Type :=: Type
23 | Type :<: Type
24 | X :<<: Scheme
25 deriving (Eq, Ord, Show)
27recordT :: [(String,Type)] -> Map.Map String [Type]
28recordT fields =
29 foldl (\r (x,t) -> Map.insertWith (++) x [t] r) Map.empty fields
31recordOf :: [(String,Type)] -> Type
32recordOf fields = RecordT (recordT fields) EmptyRecord
34tipe t = ADT t []
36int = tipe "Int"
37float = tipe "Float"
38time = tipe "Time"
39date = tipe "Date"
41char = tipe "Char"
42bool = tipe "Bool"
43text = tipe "Text"
44order = tipe "Order"
45string = tipe "String"
47number = Super $ Set.fromList [ int, float, time ]
48appendable t = Super $ Set.fromList [ string, text, listOf (VarT t) ]
49comparable t = Super $ Set.fromList [ int, float, char, string, time, date ]
51element = tipe "Element"
53listOf t = ADT "List" [t]
54signalOf t = ADT "Signal" [t]
55tupleOf ts = ADT ("Tuple" ++ show (length ts)) ts
56maybeOf t = ADT "Maybe" [t]
57eitherOf a b = ADT "Either" [a,b]
58pairOf t = tupleOf [t,t]
59point = pairOf int
61infixr ==>
62t1 ==> t2 = LambdaT t1 t2
64infix 8 -:
65name -: tipe = (,) name $ Forall [] [] tipe
67parens = ("("++) . (++")")
69instance Show Type where
70 show t =
71 let addParens (c:cs) =
72 if notElem ' ' cs || c == '(' then c:cs else parens (c:cs)
73 in case t of
74 LambdaT t1@(LambdaT _ _) t2 -> parens (show t1) ++ " -> " ++ show t2
75 LambdaT t1 t2 -> show t1 ++ " -> " ++ show t2
76 VarT x -> 't' : show x
77 ADT "List" [ADT "Char" []] -> "String"
78 ADT "List" [tipe] -> "[" ++ show tipe ++ "]"
79 ADT name cs ->
80 if isTupleString name
81 then parens . intercalate "," $ map show cs
82 else name ++ concatMap ((' ':) . addParens . show) cs
83 Super ts -> "{" ++ (intercalate "," . map show $ Set.toList ts) ++ "}"
84 EmptyRecord -> "{}"
85 RecordT fs t ->
86 start ++ intercalate ", " (concatMap fields $ Map.toList fs) ++ " }"
87 where field n s = n ++ " : " ++ show s
88 fields (n,ss) = map (field n) ss
89 start = case t of
90 EmptyRecord -> "{ "
91 _ -> "{ " ++ show t ++ " | "
94isTupleString str = "Tuple" `isPrefixOf` str && all isDigit (drop 5 str)