git.iko.soy/elk
on d178521 help sign in
elk/elm/src/Types/Types.hs
105 lines 2.9 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"
53position = tipe "Position"
54location = tipe "Location"
56listOf t = ADT "List" [t]
57signalOf t = ADT "Signal" [t]
58tupleOf ts = ADT ("Tuple" ++ show (length ts)) ts
59maybeOf t = ADT "Maybe" [t]
60pairOf t = tupleOf [t,t]
61point = pairOf int
62appendable t = Super (Set.fromList [ string, text, listOf t ])
63comparable = Super (Set.fromList [ int, float, char, string ])
64transformable = Super (Set.fromList [ shape, line ])
66jsBool = tipe "JSBool"
67jsNumber = tipe "JSNumber"
68jsString = tipe "JSString"
69jsElement = tipe "JSElement"
70jsArray t = ADT "JSArray" [t]
71jsTuple ts = ADT ("JSTuple" ++ show (length ts)) ts
72jsonValue = tipe "JsonValue"
73jsonObject = tipe "JsonObject"
75infixr ==>
76t1 ==> t2 = LambdaT t1 t2
78infix 8 -:
79name -: tipe = (,) name $ Forall [] [] tipe
81hasType t = map (-: t)
83parens = ("("++) . (++")")
85instance Show Type where
86 show t =
87 case t of
88 { LambdaT t1@(LambdaT _ _) t2 -> parens (show t1) ++ " -> " ++ show t2
89 ; LambdaT t1 t2 -> show t1 ++ " -> " ++ show t2
90 ; VarT x -> 't' : show x
91 ; ADT "List" [ADT "Char" []] -> "String"
92 ; ADT "List" [tipe] -> "[" ++ show tipe ++ "]"
93 ; ADT name cs ->
94 if isTupleString name
95 then parens . intercalate "," $ map show cs
96 else case cs of [] -> name
97 _ -> parens $ name ++ " " ++ unwords (map show cs)
98 ; Super ts -> "{" ++ (intercalate "," . map show $ Set.toList ts) ++ "}"
99 }
101instance Show Scheme where
102 show (Forall xs cs t) = "Forall " ++ show xs ++ cs' ++ "\n " ++ show t
103 where cs' = concatMap (concatMap ("\n "++) . lines . show) cs
105isTupleString str = "Tuple" `isPrefixOf` str && all isDigit (drop 5 str)