git.iko.soy/elk
on d15e080 help sign in
elk/elm/src/Types/Types.hs
107 lines 2.9 kB history raw
2module Types.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 = float --tipe "Time"
46date = tipe "Date"
47month = tipe "Month"
48day = tipe "Day"
50element = tipe "Element"
51direction = tipe "Direction"
52form = tipe "Form"
53line = tipe "Line"
54shape = tipe "Shape"
55color = tipe "Color"
56position = tipe "Position"
57location = tipe "Location"
59listOf t = ADT "List" [t]
60signalOf t = ADT "Signal" [t]
61tupleOf ts = ADT ("Tuple" ++ show (length ts)) ts
62maybeOf t = ADT "Maybe" [t]
63pairOf t = tupleOf [t,t]
64point = pairOf int
65appendable t = Super (Set.fromList [ string, text, listOf t ])
66comparable = Super (Set.fromList [ int, float, char, string, time, date ])
68jsBool = tipe "JSBool"
69jsNumber = tipe "JSNumber"
70jsString = tipe "JSString"
71jsElement = tipe "JSElement"
72jsArray t = ADT "JSArray" [t]
73jsTuple ts = ADT ("JSTuple" ++ show (length ts)) ts
74jsonValue = tipe "JsonValue"
75jsonObject = tipe "JsonObject"
77infixr ==>
78t1 ==> t2 = LambdaT t1 t2
80infix 8 -:
81name -: tipe = (,) name $ Forall [] [] tipe
83hasType t = map (-: t)
85parens = ("("++) . (++")")
87instance Show Type where
88 show t =
89 case t of
90 { LambdaT t1@(LambdaT _ _) t2 -> parens (show t1) ++ " -> " ++ show t2
91 ; LambdaT t1 t2 -> show t1 ++ " -> " ++ show t2
92 ; VarT x -> 't' : show x
93 ; ADT "List" [ADT "Char" []] -> "String"
94 ; ADT "List" [tipe] -> "[" ++ show tipe ++ "]"
95 ; ADT name cs ->
96 if isTupleString name
97 then parens . intercalate "," $ map show cs
98 else case cs of [] -> name
99 _ -> parens $ name ++ " " ++ unwords (map show cs)
100 ; Super ts -> "{" ++ (intercalate "," . map show $ Set.toList ts) ++ "}"
101 }
103instance Show Scheme where
104 show (Forall xs cs t) = "Forall " ++ show xs ++ cs' ++ "\n " ++ show t
105 where cs' = concatMap (concatMap ("\n "++) . lines . show) cs
107isTupleString str = "Tuple" `isPrefixOf` str && all isDigit (drop 5 str)