git.iko.soy/elk
on e75937e help sign in
elk/elm/src/Types/Types.hs
87 lines 2.2 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 = tipe "String"
35text = tipe "Text"
37time = SuperType "Time" (Set.fromList [ int, float ])
39element = tipe "Element"
40direction = tipe "Direction"
41form = tipe "Form"
42line = tipe "Line"
43shape = tipe "Shape"
44color = tipe "Color"
45point = tupleOf [int,int]
47listOf t = ADT "List" [t]
48signalOf t = ADT "Signal" [t]
49tupleOf ts = ADT ("Tuple" ++ show (length ts)) ts
50maybeOf t = ADT "Maybe" [t]
52jsBool = tipe "JSBool"
53jsNumber = tipe "JSNumber"
54jsString = tipe "JSString"
55jsElement = tipe "JSElement"
56jsArray t = ADT "JSArray" [t]
57jsTuple ts = ADT ("JSTuple" ++ show (length ts)) ts
59infixr ==>
60t1 ==> t2 = LambdaT t1 t2
62infix 8 -:
63name -: tipe = (,) name $ Forall [] [] tipe
65hasType t = map (-: t)
67parens = ("("++) . (++")")
69instance Show Type where
70 show t =
71 case t of
72 { LambdaT t1@(LambdaT _ _) t2 -> parens (show t1) ++ " -> " ++ show t2
73 ; LambdaT t1 t2 -> show t1 ++ " -> " ++ show t2
74 ; VarT x -> show x
75 ; ADT "List" [tipe] -> "[" ++ show tipe ++ "]"
76 ; ADT name cs ->
77 if isTupleString name
78 then parens . intercalate "," $ map show cs
79 else case cs of [] -> name
80 _ -> parens $ name ++ " " ++ unwords (map show cs)
81 }
83instance Show SuperType where
84 show (SuperType n ts) = "" ++ n ++ " (a type in {" ++ subs ++ "})"
85 where subs = intercalate "," . map show $ Set.toList ts
87isTupleString str = "Tuple" `isPrefixOf` str && all isDigit (drop 5 str)