baskell-0.1: src/Type.hs

{-------------------------------------------------------------------------------

        Copyright:              Bernie Pope 2007

        Module:                 Type

        Description:            A representation of types.

        Primary Authors:        Bernie Pope

-------------------------------------------------------------------------------}

{-
    This file is part of baskell.

    baskell is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    baskell is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with baskell; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}

module Type (Type (..)) where

import Pretty
   ( parensIf
   , text
   , (<+>)
   , render
   , vcat
   , Doc
   , parens
   , cat
   , (<>)
   , punctuate
   , comma
   , brackets
   , int
   , empty
   , ($$)
   , Pretty (..)
   )

import Utils (nameSupply)

import qualified Data.Map as Map

import Data.List (mapAccumL)

--------------------------------------------------------------------------------

-- types
data Type
   = TVar Int             -- type variables, identified by a unique number
   | TInt                 -- integers
   | TChar                -- characters
   | TBool                -- booleans
   | TList Type           -- lists
   | TFun Type Type       -- functions
   | TTuple [Type]        -- tuples
   deriving (Eq, Show)

instance Pretty Type where
   pretty ty = prettyType ty

-- pretty printing of types, type variables get nice names
prettyType :: Type -> Doc
prettyType = snd . prettyTypeWorker False initPrettyState

prettyTypeWorker :: Bool -> PrettyState -> Type -> (PrettyState, Doc)
prettyTypeWorker _bracks state (TVar i)
   = case Map.lookup i varMap of
        Nothing -> (newState, text newName)
        Just name -> (state, text name)
   where
   varMap        = prettyState_varMap state
   nameSupply    = prettyState_nameSupply state
   newName       = head nameSupply
   newState
      = PrettyState
        { prettyState_varMap = Map.insert i newName varMap
        , prettyState_nameSupply = tail nameSupply
        }
prettyTypeWorker _bracks state TInt  = (state, text "Int")
prettyTypeWorker _bracks state TChar = (state, text "Char")
prettyTypeWorker _bracks state TBool = (state, text "Bool")
prettyTypeWorker _bracks state (TList t)
   = (newState, brackets doc)
   where
   (newState, doc) = prettyTypeWorker False state t
prettyTypeWorker bracks state (TFun t1 t2)
   = (newState, doc)
   where
   (t1State, t1Doc)  = prettyTypeWorker True state t1
   (newState, t2Doc) = prettyTypeWorker False t1State t2
   doc = parensIf bracks (t1Doc <+> text "->" <+> t2Doc)
prettyTypeWorker _bracks state (TTuple ts)
   = (newState, doc)
   where
   (newState, tsDoc) = mapAccumL (prettyTypeWorker False) state ts
   doc = parens $ cat $ punctuate comma tsDoc

data PrettyState
   = PrettyState
     { prettyState_varMap     :: Map.Map Int String
     , prettyState_nameSupply :: [String]
     }

initPrettyState :: PrettyState
initPrettyState
   = PrettyState
     { prettyState_varMap     = Map.empty
     , prettyState_nameSupply = nameSupply
     }