111 lines
3.6 KiB
Haskell
111 lines
3.6 KiB
Haskell
{-
|
|
Tock: a compiler for parallel languages
|
|
Copyright (C) 2008 University of Kent
|
|
|
|
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, see <http://www.gnu.org/licenses/>.
|
|
-}
|
|
|
|
-- | Generate CHP code from the AST
|
|
module GenerateCHP where
|
|
|
|
import Control.Monad.State
|
|
import Control.Monad.Trans
|
|
import Data.Generics
|
|
import System.IO
|
|
|
|
import qualified AST as A
|
|
import CompState
|
|
import Errors
|
|
import Pass
|
|
import Utils
|
|
|
|
-- Borrowed from GenerateCBased, and simplified:
|
|
|
|
-- A handle/string buffer, the current line, and indent stack (push at head)
|
|
type CGen = StateT (Either [String] Handle, String, [Int]) PassM
|
|
|
|
instance Die CGen where
|
|
dieReport err = lift $ dieReport err
|
|
|
|
instance CSMR CGen where
|
|
getCompState = lift getCompState
|
|
|
|
tell :: [String] -> CGen ()
|
|
tell x = do (hb, cur, curIndent:indentStack) <- get
|
|
let cur' = replace ("\n","\n" ++ replicate curIndent ' ') (cur++concat x)
|
|
let (cur'', prevLines)
|
|
= transformPair reverse reverse $
|
|
span (/= '\n') (reverse cur')
|
|
hb' <- case hb of
|
|
Left prev -> return $ Left (prev ++ lines prevLines)
|
|
Right h -> do liftIO $ hPutStr h prevLines
|
|
return hb
|
|
put (hb, cur'', curIndent:indentStack)
|
|
|
|
pushIndent :: CGen ()
|
|
pushIndent = modify $ \(hb, cur, indents) -> (hb, cur, length cur : indents)
|
|
|
|
popIndent :: CGen ()
|
|
popIndent = modify $ \(hb, cur, _:indents) -> (hb, cur, indents)
|
|
|
|
withIndent :: CGen () -> CGen ()
|
|
withIndent f = pushIndent >> f >> popIndent
|
|
|
|
genName :: A.Name -> CGen ()
|
|
genName n = tell [[if c == '.' then '_' else c | c <- A.nameName n]]
|
|
|
|
generateCHP :: Handle -> A.AST -> PassM ()
|
|
generateCHP h tr = do
|
|
liftIO $ hPutStrLn h "main :: IO ()"
|
|
liftIO $ hPutStrLn h "main = return ()"
|
|
flip evalStateT (Right h, "", [0]) $ genAST tr
|
|
|
|
genAST :: A.AST -> CGen ()
|
|
genAST = genStructured
|
|
|
|
-- TODO do the top-level without the let..in wrappers, to easily support Rain (and
|
|
-- it makes more sense)
|
|
genStructured :: Data a => A.Structured a -> CGen ()
|
|
genStructured (A.Spec m spec scope) = genSpec spec (genStructured scope)
|
|
genStructured (A.ProcThen m proc scope) = genStructured scope
|
|
genStructured (A.Only m item) = tell ["{-ONLY-}"]
|
|
genStructured (A.Several m strs) = mapM_ genStructured strs
|
|
|
|
-- | Should output a spec of the form "let..in" or nothing
|
|
genSpec :: A.Specification -> CGen () -> CGen ()
|
|
genSpec (A.Specification _ n (A.Proc _ _ params body)) scope
|
|
= do tell ["let "]
|
|
pushIndent
|
|
genName n
|
|
tell [" :: "]
|
|
mapM doFormalAndArrow params
|
|
tell [" CHP ()\n"]
|
|
genName n
|
|
sequence [genName pn >> tell [" "] | A.Formal _ _ pn <- params]
|
|
tell ["= do\n "]
|
|
pushIndent
|
|
tell ["return ()\n"] -- TODO
|
|
popIndent
|
|
popIndent -- TODO use withIndent
|
|
tell ["in "]
|
|
withIndent scope
|
|
where
|
|
doFormalAndArrow :: A.Formal -> CGen ()
|
|
doFormalAndArrow (A.Formal _ t _)
|
|
= genType t >> tell [" -> "]
|
|
genSpec _ scope = scope
|
|
|
|
genType :: A.Type -> CGen ()
|
|
genType _ = tell ["({-TYPE-})"]
|