git.iko.soy/elk
on 028d2ec help sign in
elk/elm/src/Types/Types.hs
103 lines 2.8 kB history raw
2module Types where
4import Data.Char (isDigit)
5import Data.List (intercalate,isPrefixOf)
6import qualified Data.Set as Set
8type X = Int
10data Type = LambdaT Type Type
11 | VarT X
12 | ADT String [Type]
13 | Super (Set.Set Type)
14 deriving (Eq, Ord)
16data Scheme = Forall [X] [Context String Constraint] Type deriving (Eq, Ord)
18data Constraint = Type :=: Type
19 | Type :<: Type
20 | X :<<: Scheme
21 deriving (Eq, Ord, Show)
23data Context c v = Context c v deriving (Eq, Show)
25ctx c = Context ("`" ++ show c ++ "'")
26extendCtx ctx2 (Context ctx1 c) = Context (ctx1 ++ " in " ++ ctx2) c
28instance (Ord a, Eq c) => Ord (Context c a) where
29 compare (Context _ x) (Context _ y) = compare x y
32tipe t = ADT t []
35int = tipe "Int"
36float = tipe "Float"
37number = Super (Set.fromList [ int, float ])
39char = tipe "Char"
40bool = tipe "Bool"
42string = listOf char -- tipe "String"
43text = tipe "Text"
45time = Super (Set.fromList [ int, float ])
47element = tipe "Element"
48direction = tipe "Direction"
49form = tipe "Form"
50line = tipe "Line"
51shape = tipe "Shape"
52color = tipe "Color"
54listOf t = ADT "List" [t]
55signalOf t = ADT "Signal" [t]
56tupleOf ts = ADT ("Tuple" ++ show (length ts)) ts
57maybeOf t = ADT "Maybe" [t]
58pairOf t = tupleOf [t,t]
59point = pairOf int
60appendable t = Super (Set.fromList [ string, text, listOf t ])
61comparable = Super (Set.fromList [ int, float, char, string ])
62transformable = Super (Set.fromList [ shape, line ])
64jsBool = tipe "JSBool"
65jsNumber = tipe "JSNumber"
66jsString = tipe "JSString"
67jsElement = tipe "JSElement"
68jsArray t = ADT "JSArray" [t]
69jsTuple ts = ADT ("JSTuple" ++ show (length ts)) ts
70jsonValue = tipe "JsonValue"
71jsonObject = tipe "JsonObject"
73infixr ==>
74t1 ==> t2 = LambdaT t1 t2
76infix 8 -:
77name -: tipe = (,) name $ Forall [] [] tipe
79hasType t = map (-: t)
81parens = ("("++) . (++")")
83instance Show Type where
84 show t =
85 case t of
86 { LambdaT t1@(LambdaT _ _) t2 -> parens (show t1) ++ " -> " ++ show t2
87 ; LambdaT t1 t2 -> show t1 ++ " -> " ++ show t2
88 ; VarT x -> 't' : show x
89 ; ADT "List" [ADT "Char" []] -> "String"
90 ; ADT "List" [tipe] -> "[" ++ show tipe ++ "]"
91 ; ADT name cs ->
92 if isTupleString name
93 then parens . intercalate "," $ map show cs
94 else case cs of [] -> name
95 _ -> parens $ name ++ " " ++ unwords (map show cs)
96 ; Super ts -> "{" ++ (intercalate "," . map show $ Set.toList ts) ++ "}"
97 }
99instance Show Scheme where
100 show (Forall xs cs t) = "Forall " ++ show xs ++ cs' ++ "\n " ++ show t
101 where cs' = concatMap (concatMap ("\n "++) . lines . show) cs
103isTupleString str = "Tuple" `isPrefixOf` str && all isDigit (drop 5 str)