git.iko.soy/elk
on fa9d3bf help sign in
elk/compiler/Types/Types.hs
120 lines 3.4 kB history raw
2module Types.Types where
4import Context
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] [Context Constraint] Type deriving (Eq, Ord)
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"
38number = Super (Set.fromList [ int, float ])
40char = tipe "Char"
41bool = tipe "Bool"
43string = listOf char -- tipe "String"
44text = tipe "Text"
46time = float --tipe "Time"
47date = tipe "Date"
48month = tipe "Month"
49day = tipe "Day"
51element = tipe "Element"
52direction = tipe "Direction"
53form = tipe "Form"
54line = tipe "Line"
55shape = tipe "Shape"
56color = tipe "Color"
57position = tipe "Position"
58location = tipe "Location"
60listOf t = ADT "List" [t]
61signalOf t = ADT "Signal" [t]
62tupleOf ts = ADT ("Tuple" ++ show (length ts)) ts
63maybeOf t = ADT "Maybe" [t]
64eitherOf a b = ADT "Either" [a,b]
65pairOf t = tupleOf [t,t]
66point = pairOf int
67appendable t = Super (Set.fromList [ string, text, listOf t ])
68comparable = Super (Set.fromList [ int, float, char, string, time, date ])
70jsBool = tipe "JSBool"
71jsNumber = tipe "JSNumber"
72jsString = tipe "JSString"
73jsElement = tipe "JSElement"
74jsArray t = ADT "JSArray" [t]
75jsTuple ts = ADT ("JSTuple" ++ show (length ts)) ts
76jsonValue = tipe "JsonValue"
77jsonObject = tipe "JsonObject"
79infixr ==>
80t1 ==> t2 = LambdaT t1 t2
82infix 8 -:
83name -: tipe = (,) name $ Forall [] [] tipe
85parens = ("("++) . (++")")
87instance Show Type where
88 show t =
89 let show' t = case t of { LambdaT _ _ -> parens (show t) ; _ -> show t }
90 in case t of
91 LambdaT t1@(LambdaT _ _) t2 -> show' t1 ++ " -> " ++ show t2
92 LambdaT t1 t2 -> show t1 ++ " -> " ++ show t2
93 VarT x -> 't' : show x
94 ADT "List" [ADT "Char" []] -> "String"
95 ADT "List" [tipe] -> "[" ++ show tipe ++ "]"
96 ADT name cs ->
97 if isTupleString name
98 then parens . intercalate "," $ map show cs
99 else case cs of
100 [] -> name
101 _ -> name ++ " " ++ unwords (map show cs)
102 Super ts -> "{" ++ (intercalate "," . map show $ Set.toList ts) ++ "}"
103 EmptyRecord -> "{}"
104 RecordT fs t ->
105 start ++ intercalate ", " (concatMap fields $ Map.toList fs) ++ " }"
106 where field n s = n ++ " :: " ++ show s
107 fields (n,ss) = map (field n) ss
108 start = case t of
109 EmptyRecord -> "{ "
110 _ -> "{ " ++ show t ++ " | "
113instance Show Scheme where
114 show (Forall [] [] t) = show t
115 show (Forall xs cs t) =
116 concat [ "Forall ", show xs
117 , concatMap (("\n "++) . show) cs
118 , "\n ", parens (show t) ]
120isTupleString str = "Tuple" `isPrefixOf` str && all isDigit (drop 5 str)