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