Filled out the very basics of a CHP backend, enough to get some proc headers

backends/GenerateCHP.hs

@@ -19,16 +19,92 @@ 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 ()"
-  genAST tr
+  flip evalStateT (Right h, "", [0]) $ genAST tr
 
-genAST _ = return ()
+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-})"]