git.iko.soy/elk
on 28db384 help sign in
elk/compiler/Types/Types.hs
95 lines 2.8 kB history raw
1{-# LANGUAGE DeriveDataTypeable #-}
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
9import Data.Data
11type X = Int
13data Type = LambdaT Type Type
14 | VarT X
15 | ADT String [Type]
16 | EmptyRecord
17 | RecordT (Map.Map String [Type]) Type
18 | Super (Set.Set Type)
19 deriving (Eq, Ord, Data, Typeable)
21data Scheme = Forall [X] [Located Constraint] Type deriving (Eq, Ord, Show, Data, Typeable)
23data Constraint = Type :=: Type
24 | Type :<: Type
25 | X :<<: Scheme
26 deriving (Eq, Ord, Show, Data, Typeable)
28recordT :: [(String,Type)] -> Map.Map String [Type]
29recordT fields =
30 foldl (\r (x,t) -> Map.insertWith (++) x [t] r) Map.empty fields
32recordOf :: [(String,Type)] -> Type
33recordOf fields = RecordT (recordT fields) EmptyRecord
35tipe t = ADT t []
37int = tipe "Int"
38float = tipe "Float"
39time = tipe "Time"
40date = tipe "Date"
42char = tipe "Char"
43bool = tipe "Bool"
44text = tipe "Text"
45order = tipe "Order"
46string = tipe "String"
48number = Super $ Set.fromList [ int, float, time ]
49appendable t = Super $ Set.fromList [ string, text, listOf (VarT t) ]
50comparable t = Super $ Set.fromList [ int, float, char, string, time, date ]
52element = tipe "Element"
54listOf t = ADT "List" [t]
55signalOf t = ADT "Signal" [t]
56tupleOf ts = ADT ("Tuple" ++ show (length ts)) ts
57maybeOf t = ADT "Maybe" [t]
58eitherOf a b = ADT "Either" [a,b]
59pairOf t = tupleOf [t,t]
60point = pairOf int
62infixr ==>
63t1 ==> t2 = LambdaT t1 t2
65infix 8 -:
66name -: tipe = (,) name $ Forall [] [] tipe
68parens = ("("++) . (++")")
70instance Show Type where
71 show t =
72 let addParens (c:cs) =
73 if notElem ' ' cs || c == '(' then c:cs else parens (c:cs)
74 in case t of
75 LambdaT t1@(LambdaT _ _) t2 -> parens (show t1) ++ " -> " ++ show t2
76 LambdaT t1 t2 -> show t1 ++ " -> " ++ show t2
77 VarT x -> 't' : show x
78 ADT "List" [ADT "Char" []] -> "String"
79 ADT "List" [tipe] -> "[" ++ show tipe ++ "]"
80 ADT name cs ->
81 if isTupleString name
82 then parens . intercalate "," $ map show cs
83 else name ++ concatMap ((' ':) . addParens . show) cs
84 Super ts -> "{" ++ (intercalate "," . map show $ Set.toList ts) ++ "}"
85 EmptyRecord -> "{}"
86 RecordT fs t ->
87 start ++ intercalate ", " (concatMap fields $ Map.toList fs) ++ " }"
88 where field n s = n ++ " : " ++ show s
89 fields (n,ss) = map (field n) ss
90 start = case t of
91 EmptyRecord -> "{ "
92 _ -> "{ " ++ show t ++ " | "
95isTupleString str = "Tuple" `isPrefixOf` str && all isDigit (drop 5 str)