{-# OPTIONS_GHC -fglasgow-exts #-}
-- for deriving Data and Typeable

-- 
-- Copyright (C) 2005 Stefan Wehr - http://www.stefanwehr.de
--
-- This program 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.
-- 
-- This program 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 this program; if not, write to the Free Software
-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-- 

module Phrac.Builtins where

import qualified List
import qualified Data.Generics as Gen

import Phrac.Error
import Phrac.Pretty

--
-- builtin operators
--

--
-- If you change something here, you also have to change TypeInference.hs
--

data Op =  IntAddOp
        |  IntSubOp
        |  IntMulOp
	|  IntQuotOp
	|  IntRemOp
	|  IntNegOp
	|  IntGtOp
	|  IntGeOp
	|  IntLtOp
	|  IntLeOp
	|  IntEqOp
	|  IntNeOp
        deriving (Show, Ord, Eq, Read, Gen.Data, Gen.Typeable)

instance Pretty Op where ppr = text . show

data PrimInfo = PrimInfo String   -- name
                         Op 
                         OpSpec
                         Int      -- arity

primsMap :: [PrimInfo]
primsMap = 
        [ PrimInfo "+" IntAddOp (LeftAssoc, 7) 2
        , PrimInfo "-" IntSubOp (LeftAssoc, 7) 2
          -- IntNegOp must be AFTER IntSubOp
        , PrimInfo "-"  IntNegOp (NoAssoc, maxPrec) 1
        , PrimInfo "*"  IntMulOp (LeftAssoc, 8) 2
        , PrimInfo "/"  IntQuotOp (LeftAssoc, 8) 2
        , PrimInfo "%"  IntRemOp (LeftAssoc, 8) 2
        , PrimInfo ">"  IntGtOp (LeftAssoc, 6) 2
        , PrimInfo ">=" IntGeOp (LeftAssoc, 6) 2
        , PrimInfo "<"  IntLtOp (LeftAssoc, 6) 2
        , PrimInfo "<=" IntLeOp (LeftAssoc, 6) 2
        , PrimInfo "==" IntEqOp (LeftAssoc, 6) 2
        , PrimInfo "/=" IntNeOp (LeftAssoc, 6) 2
        ]

strToPrimOp :: String -> Maybe Op
strToPrimOp s = 
    case List.find f primsMap of
      Just (PrimInfo _ op _ _) -> Just op
      _ -> Nothing
    where f (PrimInfo s' _ _ _) | s == s' = True
                                | otherwise = False

lookupPrim :: Op -> PrimInfo
lookupPrim op = 
    case List.find f primsMap of
      Just i -> i
      Nothing -> panic ("no info for primOp " ++ show op)
    where f (PrimInfo _ op' _ _) | op == op' = True
                                   | otherwise = False

isBinPrimOp :: Op -> Bool
isBinPrimOp op = arityOfPrimOp op == 2

arityOfPrimOp op = 
    case lookupPrim op of
      (PrimInfo _ _ _ a) -> a

specOfPrimOp :: Op -> OpSpec
specOfPrimOp op = 
    case lookupPrim op of
      (PrimInfo _ _ spec _) -> spec
    
primOpToStr :: Op -> String
primOpToStr IntNegOp = "-"
primOpToStr op =
    case lookupPrim op of
      (PrimInfo s _ _ _) -> s

--
-- Names and arities for builtin data constructors,
-- names for builtin types
--

unitDataConstructor = ("()", 0::Int)
pairDataConstructor = ("Pair", 2::Int)
falseDataConstructor = ("False", 0::Int)
trueDataConstructor = ("True", 0::Int)
nilDataConstructor = ("Nil", 0::Int)
consDataConstructor = ("Cons", 2::Int)

dataConstructors = [unitDataConstructor, pairDataConstructor,
                    trueDataConstructor, falseDataConstructor,
                    consDataConstructor, nilDataConstructor]


funTypeConstructor = "->"
pairTypeConstructor = "(,)"
intTypeConstructor = "Int"
boolTypeConstructor = "Bool"
unitTypeConstructor = "Unit"
charTypeConstructor = "Char"

typeConstructors = [funTypeConstructor, pairTypeConstructor,
                    intTypeConstructor, boolTypeConstructor,
                    unitTypeConstructor, charTypeConstructor]