on 1fcb01f help sign in
51 lines 1.4 kB history raw
2module SourceSyntax.Type where
4import qualified Data.Map as Map
5import SourceSyntax.PrettyPrint
6import Text.PrettyPrint as P
8data Type = Lambda Type Type
9 | Var String
10 | Data String [Type]
11 | EmptyRecord
12 | Record (Map.Map String [Type]) Type
13 deriving (Eq, Show)
15fieldMap :: [(String,Type)] -> Map.Map String [Type]
16fieldMap fields =
17 foldl (\r (x,t) -> Map.insertWith (++) x [t] r) Map.empty fields
19recordOf :: [(String,Type)] -> Type
20recordOf fields = Record (fieldMap fields) EmptyRecord
22listOf :: Type -> Type
23listOf t = Data "List" [t]
25tupleOf :: [Type] -> Type
26tupleOf ts = Data ("_Tuple" ++ show (length ts)) ts
29instance Pretty Type where
30 pretty tipe =
31 case tipe of
32 Lambda t1 t2 -> P.sep [ t, P.sep (map (P.text "->" <+>) ts) ]
33 where t:ts = collectLambdas tipe
34 Var x -> P.text x
35 Data name tipes -> P.hang (P.text name) 2 (P.sep $ map prettyParens tipes)
36 EmptyRecord -> P.braces P.empty
37 Record fields ext -> error "not done yet"
39collectLambdas tipe =
40 case tipe of
41 Lambda arg@(Lambda _ _) body -> P.parens (pretty arg) : collectLambdas body
42 Lambda arg body -> pretty arg : collectLambdas body
43 _ -> [pretty tipe]
45prettyParens tipe = parensIf needed (pretty tipe)
46 where
47 needed =
48 case tipe of
49 Lambda _ _ -> True
50 Data _ _ -> True
51 _ -> False