Changed where we generate the .inc file from being in the backend, to being a pass just after type-checking
We need to generate the externals after we've inferred channel directions, but before we do further work (like adding _sizes parameters and so on).
This commit is contained in:
parent
abce001bab
commit
db9b8e9d91
20
Main.hs
20
Main.hs
|
@ -257,10 +257,10 @@ compileFull inputFile moutputFile
|
|||
let cFile = outputFile ++ extension
|
||||
hFile = outputFile ++ ".h"
|
||||
iFile = outputFile ++ ".inc"
|
||||
lift $ modify $ \cs -> cs { csOutputIncFile = Just iFile }
|
||||
lift $ withOutputFile cFile $ \hb ->
|
||||
withOutputFile hFile $ \hh ->
|
||||
withOutputFile iFile $ \hi ->
|
||||
compile ModeCompile inputFile ((hb, hh, hi), hFile)
|
||||
compile ModeCompile inputFile ((hb, hh), hFile)
|
||||
noteFile cFile
|
||||
when (csRunIndent optsPS) $
|
||||
exec $ "indent " ++ cFile
|
||||
|
@ -282,7 +282,7 @@ compileFull inputFile moutputFile
|
|||
exec $ cCommand sFile oFile (csCompilerFlags optsPS)
|
||||
-- Analyse the assembly for stack sizes, and output a
|
||||
-- "post" C file
|
||||
lift $ withOutputFile postCFile $ \h -> postCAnalyse sFile ((h,intErr,intErr),intErr)
|
||||
lift $ withOutputFile postCFile $ \h -> postCAnalyse sFile ((h,intErr),intErr)
|
||||
-- Compile this new "post" C file into an object file
|
||||
exec $ cCommand postCFile postOFile (csCompilerFlags optsPS)
|
||||
-- Link the object files into a binary
|
||||
|
@ -325,13 +325,12 @@ compileFull inputFile moutputFile
|
|||
ExitFailure n -> dieReport (Nothing, "Command \"" ++ cmd ++ "\" failed: exited with code: " ++ show n)
|
||||
|
||||
-- | Picks out the handle from the options and passes it to the function:
|
||||
useOutputOptions :: (((Handle, Handle, Handle), String) -> PassM ()) -> PassM ()
|
||||
useOutputOptions :: (((Handle, Handle), String) -> PassM ()) -> PassM ()
|
||||
useOutputOptions func
|
||||
= do optsPS <- get
|
||||
withHandleFor (csOutputFile optsPS) $ \hb ->
|
||||
withHandleFor (csOutputHeaderFile optsPS) $ \hh ->
|
||||
withHandleFor (csOutputIncFile optsPS) $ \hi ->
|
||||
func ((hb, hh, hi), csOutputHeaderFile optsPS)
|
||||
func ((hb, hh), csOutputHeaderFile optsPS)
|
||||
where
|
||||
withHandleFor "-" func = func stdout
|
||||
withHandleFor file func =
|
||||
|
@ -376,11 +375,12 @@ showTokens html ts = evalState (mapM showToken ts >>* spaceOut) 0
|
|||
then (" ", "<br/>\n", \s -> "<b>" ++ s ++ "</b>")
|
||||
else (" ", "\n", id)
|
||||
|
||||
|
||||
-- | Compile a file.
|
||||
-- This is written in the PassM monad -- as are most of the things it calls --
|
||||
-- because then it's very easy to pass the state around.
|
||||
compile :: CompMode -> String -> ((Handle, Handle, Handle), String) -> PassM ()
|
||||
compile mode fn (outHandles@(outHandle, _, _), headerName)
|
||||
compile :: CompMode -> String -> ((Handle, Handle), String) -> PassM ()
|
||||
compile mode fn (outHandles@(outHandle, _), headerName)
|
||||
= do optsPS <- get
|
||||
|
||||
debug "{{{ Parse"
|
||||
|
@ -441,8 +441,8 @@ compile mode fn (outHandles@(outHandle, _, _), headerName)
|
|||
progress "Done"
|
||||
|
||||
-- | Analyse an assembly file.
|
||||
postCAnalyse :: String -> ((Handle, Handle, Handle), String) -> PassM ()
|
||||
postCAnalyse fn ((outHandle, _, _), _)
|
||||
postCAnalyse :: String -> ((Handle, Handle), String) -> PassM ()
|
||||
postCAnalyse fn ((outHandle, _), _)
|
||||
= do asm <- liftIO $ readFile fn
|
||||
|
||||
progress "Analysing assembly"
|
||||
|
|
|
@ -155,7 +155,7 @@ cgenOps = GenOps {
|
|||
--}}}
|
||||
|
||||
--{{{ top-level
|
||||
generateC :: (Handle, Handle, Handle) -> String -> A.AST -> PassM ()
|
||||
generateC :: (Handle, Handle) -> String -> A.AST -> PassM ()
|
||||
generateC = generate cgenOps
|
||||
|
||||
cgenTopLevel :: String -> A.AST -> CGen ()
|
||||
|
|
|
@ -58,7 +58,6 @@ type CGenOutput = Either [String] Handle
|
|||
data CGenOutputs = CGenOutputs
|
||||
{ cgenBody :: CGenOutput
|
||||
, cgenHeader :: CGenOutput
|
||||
, cgenOccamInc :: CGenOutput
|
||||
}
|
||||
|
||||
--{{{ monad definition
|
||||
|
@ -246,10 +245,10 @@ fget :: (GenOps -> a) -> CGen a
|
|||
fget = asks
|
||||
|
||||
-- Handles are body, header, occam-inc
|
||||
generate :: GenOps -> (Handle, Handle, Handle) -> String -> A.AST -> PassM ()
|
||||
generate ops (hb, hh, hi) hname ast
|
||||
generate :: GenOps -> (Handle, Handle) -> String -> A.AST -> PassM ()
|
||||
generate ops (hb, hh) hname ast
|
||||
= evalStateT (runReaderT (call genTopLevel hname ast) ops)
|
||||
(CGenOutputs (Right hb) (Right hh) (Right hi))
|
||||
(CGenOutputs (Right hb) (Right hh))
|
||||
|
||||
genComma :: CGen ()
|
||||
genComma = tell [","]
|
||||
|
|
|
@ -122,7 +122,7 @@ chansToAny = cppOnlyPass "Transform channels to ANY"
|
|||
|
||||
--{{{ top-level
|
||||
-- | Transforms the given AST into a pass that generates C++ code.
|
||||
generateCPPCSP :: (Handle, Handle, Handle) -> String -> A.AST -> PassM ()
|
||||
generateCPPCSP :: (Handle, Handle) -> String -> A.AST -> PassM ()
|
||||
generateCPPCSP = generate cppgenOps
|
||||
|
||||
cppcspPrereq :: [Property]
|
||||
|
|
|
@ -106,7 +106,7 @@ data CompState = CompState {
|
|||
csVerboseLevel :: Int,
|
||||
csOutputFile :: String,
|
||||
csOutputHeaderFile :: String,
|
||||
csOutputIncFile :: String,
|
||||
csOutputIncFile :: Maybe String,
|
||||
csKeepTemporaries :: Bool,
|
||||
csEnabledWarnings :: Set WarningType,
|
||||
csRunIndent :: Bool,
|
||||
|
@ -156,7 +156,7 @@ emptyState = CompState {
|
|||
csVerboseLevel = 0,
|
||||
csOutputFile = "-",
|
||||
csOutputHeaderFile = "-",
|
||||
csOutputIncFile = "-",
|
||||
csOutputIncFile = Nothing,
|
||||
csKeepTemporaries = False,
|
||||
csEnabledWarnings = Set.fromList
|
||||
[ WarnInternal
|
||||
|
|
|
@ -21,6 +21,10 @@ module OccamPasses (occamPasses, foldConstants, checkConstants) where
|
|||
|
||||
import Control.Monad.State
|
||||
import Data.Generics
|
||||
import Data.List
|
||||
import qualified Data.Sequence as Seq
|
||||
import qualified Data.Foldable as F
|
||||
import System.IO
|
||||
|
||||
import qualified AST as A
|
||||
import CompState
|
||||
|
@ -46,9 +50,40 @@ occamPasses =
|
|||
, checkConstants
|
||||
, resolveAmbiguities
|
||||
, checkTypes
|
||||
, writeIncFile
|
||||
, pushUpDirections
|
||||
]
|
||||
|
||||
writeIncFile :: Pass
|
||||
writeIncFile = occamOnlyPass "Write .inc file" [] []
|
||||
(passOnlyOnAST "writeIncFile" (\t ->
|
||||
do out <- getCompState >>* csOutputIncFile
|
||||
case out of
|
||||
Just fn -> do f <- liftIO $ openFile fn WriteMode
|
||||
contents <- emitProcsAsExternal t >>* (unlines . F.toList)
|
||||
liftIO $ hPutStr f contents
|
||||
liftIO $ hClose f
|
||||
Nothing -> return ()
|
||||
return t
|
||||
))
|
||||
where
|
||||
emitProcsAsExternal :: A.AST -> PassM (Seq.Seq String)
|
||||
emitProcsAsExternal (A.Spec _ (A.Specification _ n (A.Proc _ _ fs _)) scope)
|
||||
= do thisProc <- sequence (
|
||||
[return "#PRAGMA EXTERNAL \"PROC "
|
||||
,showCode n
|
||||
,return "("
|
||||
] ++ intersperse (return ",") (map showCode fs) ++
|
||||
[return ") = 42\""
|
||||
]) >>* concat
|
||||
emitProcsAsExternal scope >>* (thisProc Seq.<|)
|
||||
emitProcsAsExternal (A.Spec _ _ scope) = emitProcsAsExternal scope
|
||||
emitProcsAsExternal (A.ProcThen _ _ scope) = emitProcsAsExternal scope
|
||||
emitProcsAsExternal (A.Only {}) = return Seq.empty
|
||||
emitProcsAsExternal (A.Several _ ss)
|
||||
= foldl (liftM2 (Seq.><)) (return Seq.empty) (map emitProcsAsExternal ss)
|
||||
|
||||
|
||||
-- | Fixed the types of array constructors according to the replicator count
|
||||
fixConstructorTypes :: Pass
|
||||
fixConstructorTypes = occamOnlyPass "Fix the types of array constructors"
|
||||
|
|
Loading…
Reference in New Issue
Block a user