API.hs

module Feldspar.Compiler.Frontend.CommandLine.API where

import Feldspar.Compiler.Frontend.CommandLine.API.Library
import Feldspar.Compiler.Backend.C.Library
import System.IO
import Language.Haskell.Interpreter
import qualified Data.Typeable as T

data CompilationResult
	= CompilationSuccess
	| CompilationFailure
	deriving (Eq, Show, T.Typeable)

  -- A general interpreter body for interpreting an expression
generalInterpreterBody :: forall a . (T.Typeable (IO a))
                       => String -- the expression to interpret
                       -> Interpreter (IO a)
generalInterpreterBody expression = interpret expression (as::IO a)

-- A high-level interface for calling the interpreter
highLevelInterpreter :: T.Typeable (IO a)
                     => String -- the module name (for example My.Module)
                     -> String -- the input file name (for example "My/Module.hs")
                     -> [String] -- globalImportList
                     -> Bool -- need to load global modules?
                     -> Bool -- need to import global modules qualified?
                     -> Interpreter (IO a) -- ^ an interpreter body
                     -> IO CompilationResult
highLevelInterpreter moduleName inputFileName importList needGlobal needQualify interpreterBody = do
  actionToExecute <- runInterpreter $ do
    set [ languageExtensions := [GADTs, ScopedTypeVariables, TypeSynonymInstances, StandaloneDeriving,
                                 DeriveDataTypeable, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses,
                                 FunctionalDependencies, ExistentialQuantification, Rank2Types, TypeOperators,
                                 EmptyDataDecls, GeneralizedNewtypeDeriving, TypeFamilies]
      ]
    loadModules $ [inputFileName] ++ if needGlobal then importList else []
    setTopLevelModules [moduleName]
    -- Import modules qualified to prevent name collisions with user defined entities
    if needQualify
      then setImportsQ $ zip importList $ map Just importList
      else setImports importList
    interpreterBody
  case actionToExecute of
    Left err -> do
      printInterpreterError err
      return CompilationFailure
    Right action -> do
      action
      return CompilationSuccess
  -- either printInterpreterError id actionToExecute

printInterpreterError :: InterpreterError -> IO ()
printInterpreterError (WontCompile []) = return ()
printInterpreterError (WontCompile (x:xs)) = do
	printGhcError x
	printInterpreterError (WontCompile xs)
	where
		printGhcError (GhcError {errMsg=s}) = hPutStrLn stderr s
printInterpreterError e = hPutStrLn stderr $ "Code generation failed: " ++ show e