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