git.iko.soy/elk
on f39142d help sign in
elk/elm/src/Types/Types.hs
91 lines 2.5 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 ])
53comparable = SuperType "Comparable" (Set.fromList [ int, float, char, string, tipe "Number", tipe "Time" ])
55jsBool = tipe "JSBool"
56jsNumber = tipe "JSNumber"
57jsString = tipe "JSString"
58jsElement = tipe "JSElement"
59jsArray t = ADT "JSArray" [t]
60jsTuple ts = ADT ("JSTuple" ++ show (length ts)) ts
62infixr ==>
63t1 ==> t2 = LambdaT t1 t2
65infix 8 -:
66name -: tipe = (,) name $ Forall [] [] tipe
68hasType t = map (-: t)
70parens = ("("++) . (++")")
72instance Show Type where
73 show t =
74 case t of
75 { LambdaT t1@(LambdaT _ _) t2 -> parens (show t1) ++ " -> " ++ show t2
76 ; LambdaT t1 t2 -> show t1 ++ " -> " ++ show t2
77 ; VarT x -> 't' : show x
78 ; ADT "List" [ADT "Char" []] -> "String"
79 ; ADT "List" [tipe] -> "[" ++ show tipe ++ "]"
80 ; ADT name cs ->
81 if isTupleString name
82 then parens . intercalate "," $ map show cs
83 else case cs of [] -> name
84 _ -> parens $ name ++ " " ++ unwords (map show cs)
85 }
87instance Show SuperType where
88 show (SuperType n ts) = "" ++ n ++ " (a type in {" ++ subs ++ "})"
89 where subs = intercalate "," . map show $ Set.toList ts
91isTupleString str = "Tuple" `isPrefixOf` str && all isDigit (drop 5 str)