Compiler.hs

{-
 - Copyright (c) 2009, ERICSSON AB All rights reserved.
 - 
 - Redistribution and use in source and binary forms, with or without
 - modification, are permitted provided that the following conditions
 - are met:
 - 
 -     * Redistributions of source code must retain the above copyright
 -     notice,
 -       this list of conditions and the following disclaimer.
 -     * Redistributions in binary form must reproduce the above copyright
 -       notice, this list of conditions and the following disclaimer
 -       in the documentation and/or other materials provided with the
 -       distribution.
 -     * Neither the name of the ERICSSON AB nor the names of its
 -     contributors
 -       may be used to endorse or promote products derived from this
 -       software without specific prior written permission.
 - 
 - THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 - "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 - LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 - A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 - HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 - SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 - LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 - DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 - THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 - (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 - OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 -}

module Feldspar.Compiler.Compiler
    ( compile
    , standaloneCompile
    , icompile
    , icompile'
    , defaultOptions
    , unrollOptions
    , noSimplification
    , noPrimitiveInstructionHandling
    , includeGeneration
    ) where

import Data.Map
import Feldspar hiding ((++))
import Feldspar.Core.Graph
import Feldspar.Core.Expr (toGraph)
import qualified Feldspar.Core.Expr as Expr
import Feldspar.Compiler.Options
import Feldspar.Compiler.Transformation.GraphToImperative
import Feldspar.Compiler.Transformation.Lifting
import Feldspar.Compiler.Optimization.PrimitiveInstructions
import Feldspar.Compiler.Optimization.Simplification
import Feldspar.Compiler.Optimization.Unroll
import Feldspar.Compiler.Transformation.GraphUtils
import Feldspar.Compiler.Imperative.Representation hiding (Normal)

------------------------------------------
-- Header file for generated C porgrams --
------------------------------------------

intro = "#include \"feldspar.h\"\n\n"

type Stage t = (t -> String -> Options -> [ImpFunction]) 

-------------------------
-- Core compiler --
-------------------------

coreCompile :: (Expr.Program t) => (Stage t -> t -> FilePath -> String -> Options -> IO ())
     -> t -> FilePath -> String -> Options -> IO ()
coreCompile write prg fileName funname opts = write stage prg fileName funname opts where
    stage :: (Expr.Program t) => t -> String -> Options -> [ImpFunction]
    stage = case debug opts of
        NoDebug                         -> stage7
        NoSimplification                -> stage5
        NoPrimitiveInstructionHandling  -> stage3

-------------------------
-- Standalone compiler --
-------------------------

includeGeneration :: FilePath -> IO ()
includeGeneration fileName 
   = appendFile fileName intro

standaloneWrite stage prg fileName functionName opts 
   = appendFile fileName $ toC 0 $ stage prg functionName opts

standaloneCompile:: (Expr.Program t) => t -> FilePath -> String -> Options -> IO ()
standaloneCompile prg fileName functionName opts
   = coreCompile standaloneWrite prg fileName functionName opts


------------------------------------------------
-- Invoking the compiler from the interpreter --
------------------------------------------------


fileWrite stage prg fileName functionName opts 
  = writeFile fileName $  intro ++ (toC 0 $ stage prg functionName opts)  

compile :: (Expr.Program t) => t -> FilePath -> String -> Options -> IO ()
compile prg fileName functionName opts
   = coreCompile fileWrite prg fileName functionName opts


writeOut stage prg fileName functionName opts
   = putStrLn $ intro ++ (toC 0 $ stage prg functionName opts)

icompile :: (Expr.Program t) => t -> IO ()
icompile prg 
   = coreCompile writeOut prg "" "test" defaultOptions   
   
icompile' :: (Expr.Program t) => t -> String -> Options -> IO ()
icompile' prg functionName opts  
  = coreCompile writeOut prg "" functionName opts

------------------------
-- Predefined options --
------------------------

defaultOptions
    = Options
    { platform  = AnsiC
    , unroll    = NoUnroll
    , debug     = NoDebug
    }

unrollOptions
    = defaultOptions { unroll = Unroll 8 }

noSimplification
    = defaultOptions { debug = NoSimplification }

noPrimitiveInstructionHandling
    = defaultOptions { debug = NoPrimitiveInstructionHandling }

----------------------
-- Helper functions --
----------------------

stage1:: (Expr.Program t) => t -> HierarchicalGraph 
stage1 = makeHierarchical . toGraph

stage2:: (Expr.Program t) => t -> HierarchicalGraph
stage2 = replaceNoInlines . stage1

stage3:: (Expr.Program t) => t -> String -> Options -> [ImpFunction]
stage3 prg name opt = graphToImperative name $ stage2 prg

stage4:: (Expr.Program t) => t -> String -> Options -> [ImpFunction]
stage4 prg name opt = handlePrimitives opt $ stage3 prg name opt

stage5:: (Expr.Program t) => t -> String -> Options -> [ImpFunction]
stage5 prg name opt = fst . computeSemInfVar $ stage4 prg name opt

stage6:: (Expr.Program t) => t -> String -> Options -> [ImpFunction]
stage6 prg name opt = doSimplification $ stage5 prg name opt 

stage7:: (Expr.Program t) => t -> String -> Options -> [ImpFunction]
stage7 prg name opt = doUnroll opt $ stage6 prg name opt