-- 
-- 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.PhracPrelude (

  addBuiltins, ImplicitPrelude(..),

) where

import qualified Data.Generics as Gen
import Control.Exception        ( evaluate )

import Phrac.ParseSyntax
import Phrac.Error
import Phrac.Lexer
import Phrac.Parser
import Phrac.Constants

builtinInfo = emptyInfo { info_builtin = True,
                          info_toplevel = True }

-- by convention, all type variables must start with `__'. This prevents
-- tests from breaking just because of changes to the prelude.

builtinTypes = 
    [TypeDef "Int" [] [] builtinInfo,
     TypeDef "Char" [] [] builtinInfo,
     TypeDef "->" ["__a", "__b"] [] builtinInfo,
     TypeDef "Unit" [] [DataConstructor "()" []] builtinInfo,
     TypeDef "(,)" ["__a", "__b"] [DataConstructor "Pair" 
                                    [TyVar "__a", TyVar "__b"]] builtinInfo
    ]

addBuiltinTypes (Program types classes insts binds) = 
    Program (builtinTypes ++ types) classes insts binds

preludeFileName = phracWorkingDirectory ++ "/PhracPrelude.phc"

data ImplicitPrelude = ImplicitPrelude
                     | NoImplicitPrelude
                       deriving (Eq, Show)

addBuiltins :: ImplicitPrelude -> Program -> IO Program
addBuiltins impl (Program tydefs classes insts binds) = 
    do parseSyntax <- if impl == NoImplicitPrelude
                         then return (Program [] [] [] [])
                         else loadPrelude
       let prelude = addBuiltinTypes parseSyntax
           Program tydefs' classes' insts' binds' = 
               Gen.everywhere (Gen.mkT setBuiltin) 
                  prelude
       return (Program (tydefs'++tydefs) (classes'++classes) (insts'++insts)
               (binds'++binds))
    where setBuiltin :: Info -> Info
          setBuiltin info = info { info_builtin = True }
          loadPrelude =
              do debug ("Prelude path: " ++ preludeFileName)
                 src <- readFile preludeFileName
                 debug "Lexing prelude ..."
                 tokens <- evaluate $ scan src       
                 debug "Parsing prelude ..."
                 evaluate (parse tokens)