git.iko.soy/elk
on 6c90aba help sign in
elk/elm/src/Types/Types.hs
90 lines 2.4 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 deriving (Eq, Ord)
15data Scheme = Forall [X] [Constraint] Type deriving (Eq, Ord, Show)
17data SuperType = SuperType String (Set.Set Type) deriving (Eq, Ord)
19data Constraint = Type :=: Type
20 | Type :<: SuperType
21 | Type :<<: Scheme
22 deriving (Eq, Ord, Show)
24tipe t = ADT t []
27int = tipe "Int"
28float = tipe "Float"
29number = SuperType "Number" (Set.fromList [ int, float ])
31char = tipe "Char"
32bool = tipe "Bool"
34string = listOf char -- tipe "String"
35text = tipe "Text"
37time = SuperType "Time" (Set.fromList [ int, float, tipe "Number" ])
39element = tipe "Element"
40direction = tipe "Direction"
41form = tipe "Form"
42line = tipe "Line"
43shape = tipe "Shape"
44color = tipe "Color"
46listOf t = ADT "List" [t]
47signalOf t = ADT "Signal" [t]
48tupleOf ts = ADT ("Tuple" ++ show (length ts)) ts
49maybeOf t = ADT "Maybe" [t]
50pairOf t = tupleOf [t,t]
51point = pairOf int
52appendable t = SuperType "Appendable" (Set.fromList [ string, text, listOf t ])
54jsBool = tipe "JSBool"
55jsNumber = tipe "JSNumber"
56jsString = tipe "JSString"
57jsElement = tipe "JSElement"
58jsArray t = ADT "JSArray" [t]
59jsTuple ts = ADT ("JSTuple" ++ show (length ts)) ts
61infixr ==>
62t1 ==> t2 = LambdaT t1 t2
64infix 8 -:
65name -: tipe = (,) name $ Forall [] [] tipe
67hasType t = map (-: t)
69parens = ("("++) . (++")")
71instance Show Type where
72 show t =
73 case t of
74 { LambdaT t1@(LambdaT _ _) t2 -> parens (show t1) ++ " -> " ++ show t2
75 ; LambdaT t1 t2 -> show t1 ++ " -> " ++ show t2
76 ; VarT x -> 't' : show x
77 ; ADT "List" [ADT "Char" []] -> "String"
78 ; ADT "List" [tipe] -> "[" ++ show tipe ++ "]"
79 ; ADT name cs ->
80 if isTupleString name
81 then parens . intercalate "," $ map show cs
82 else case cs of [] -> name
83 _ -> parens $ name ++ " " ++ unwords (map show cs)
84 }
86instance Show SuperType where
87 show (SuperType n ts) = "" ++ n ++ " (a type in {" ++ subs ++ "})"
88 where subs = intercalate "," . map show $ Set.toList ts
90isTupleString str = "Tuple" `isPrefixOf` str && all isDigit (drop 5 str)