git.iko.soy/elk
on 4dc68ac help sign in
elk/compiler/SourceSyntax/Type.hs
56 lines 1.7 kB history raw
1{-# LANGUAGE DeriveDataTypeable #-}
2module SourceSyntax.Type where
4import Data.Data
5import qualified Data.Map as Map
6import qualified SourceSyntax.Helpers as Help
7import SourceSyntax.PrettyPrint
8import Text.PrettyPrint as P
10data Type = Lambda Type Type
11 | Var String
12 | Data String [Type]
13 | EmptyRecord
14 | Record (Map.Map String [Type]) Type
15 deriving (Eq, Show, Data, Typeable)
17fieldMap :: [(String,Type)] -> Map.Map String [Type]
18fieldMap fields =
19 foldl (\r (x,t) -> Map.insertWith (++) x [t] r) Map.empty fields
21recordOf :: [(String,Type)] -> Type
22recordOf fields = Record (fieldMap fields) EmptyRecord
24listOf :: Type -> Type
25listOf t = Data "_List" [t]
27tupleOf :: [Type] -> Type
28tupleOf ts = Data ("_Tuple" ++ show (length ts)) ts
31instance Pretty Type where
32 pretty tipe =
33 case tipe of
34 Lambda t1 t2 -> P.sep [ t, P.sep (map (P.text "->" <+>) ts) ]
35 where t:ts = collectLambdas tipe
36 Var x -> P.text x
37 Data "_List" [t] -> P.brackets (pretty t)
38 Data name tipes
39 | Help.isTuple name -> P.parens . P.sep . P.punctuate P.comma $ map prettyParens tipes
40 | otherwise -> P.hang (P.text name) 2 (P.sep $ map prettyParens tipes)
41 EmptyRecord -> P.braces P.empty
42 Record fields ext -> error "not done yet"
44collectLambdas tipe =
45 case tipe of
46 Lambda arg@(Lambda _ _) body -> P.parens (pretty arg) : collectLambdas body
47 Lambda arg body -> pretty arg : collectLambdas body
48 _ -> [pretty tipe]
50prettyParens tipe = parensIf needed (pretty tipe)
51 where
52 needed =
53 case tipe of
54 Lambda _ _ -> True
55 Data _ _ -> True
56 _ -> False