suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fixed it so that processes at the top-level are not inside let bindings

Browse Source
This commit is contained in:
Neil Brown 2008-11-26 15:28:36 +00:00
parent caff6ae702
commit 5d0391c98d
1 changed files with 22 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
backends/GenerateCHP.hs
View File

@ -57,7 +57,10 @@ pushIndent :: CGen ()
pushIndent = modify $ \(hb, cur, indents) -> (hb, cur, length cur : indents) pushIndent = modify $ \(hb, cur, indents) -> (hb, cur, length cur : indents)
popIndent :: CGen () popIndent :: CGen ()
popIndent = modify $ \(hb, cur, _:indents) -> (hb, cur, indents) popIndent = modify $ \(hb, cur, _:indents) ->
if all (== ' ') cur
then (hb, replicate (head indents) ' ', indents)
else (hb, cur, indents)
withIndent :: CGen () -> CGen () withIndent :: CGen () -> CGen ()
withIndent f = pushIndent >> f >> popIndent withIndent f = pushIndent >> f >> popIndent
@ -77,21 +80,25 @@ generateCHP h tr
= flip evalStateT (Right h, "", [0]) $ genHeader >> genAST tr = flip evalStateT (Right h, "", [0]) $ genHeader >> genAST tr
genAST :: A.AST -> CGen () genAST :: A.AST -> CGen ()
genAST = genStructured genAST = genStructured False
-- TODO do the top-level without the let..in wrappers, to easily support Rain (and genStructured :: Data a => Bool -> A.Structured a -> CGen ()
-- it makes more sense) genStructured False (A.Spec m spec scope)
genStructured :: Data a => A.Structured a -> CGen () = do genSpec spec
genStructured (A.Spec m spec scope) = genSpec spec (genStructured scope) genStructured False scope
genStructured (A.ProcThen m proc scope) = genStructured scope genStructured True (A.Spec m spec 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 "] = do tell ["let "]
pushIndent genSpec spec
tell ["in "]
withIndent $ genStructured True scope
genStructured addLet (A.ProcThen m proc scope) = genStructured addLet scope
genStructured _ (A.Only m item) = tell ["{-ONLY-}"]
genStructured addLet (A.Several m strs) = mapM_ (genStructured addLet) strs
-- | Should output a spec, or nothing
genSpec :: A.Specification -> CGen ()
genSpec (A.Specification _ n (A.Proc _ _ params body))
= withIndent $ do
genName n genName n
tell [" :: "] tell [" :: "]
mapM doFormalAndArrow params mapM doFormalAndArrow params
@ -102,14 +109,11 @@ genSpec (A.Specification _ n (A.Proc _ _ params body)) scope
pushIndent pushIndent
tell ["return ()\n"] -- TODO tell ["return ()\n"] -- TODO
popIndent popIndent
popIndent -- TODO use withIndent
tell ["in "]
withIndent scope
where where
doFormalAndArrow :: A.Formal -> CGen () doFormalAndArrow :: A.Formal -> CGen ()
doFormalAndArrow (A.Formal _ t _) doFormalAndArrow (A.Formal _ t _)
= genType t >> tell [" -> "] = genType t >> tell [" -> "]
genSpec _ scope = scope genSpec _ = return ()
genType :: A.Type -> CGen () genType :: A.Type -> CGen ()
genType A.Int = tell ["Int#"] genType A.Int = tell ["Int#"]