diff --git a/fco/PhaseIntermediate.hs b/fco/PhaseIntermediate.hs index ab1e787..282a435 100644 --- a/fco/PhaseIntermediate.hs +++ b/fco/PhaseIntermediate.hs @@ -5,23 +5,67 @@ module PhaseIntermediate (phaseIntermediate) where import Tree import Pass import BaseTransforms +import Control.Monad.State +import Data.Map as Map bases = [baseTransformOc, baseTransformInt] phaseIntermediate = (Phase "Intermediate mangling" [ - ("Gather declarations", makePass () gatherDecls bases) + ("Mark declarations", makePass () markDecls bases) +-- , ("Unique identifiers", makePass (0, Map.empty) uniqueIdentifiers bases) ]) -gatherDecls :: Transform () -gatherDecls next top node +nestDecls :: [(Node, Node)] -> Node -> Node +nestDecls l n = foldl (\a b -> b a) n [IntDecl n d | (OcName n, d) <- l] + +markDecls :: Transform () +markDecls next top node = case node of - OcDecl d c -> do - c' <- top c - d' <- top d - return $ case c' of - IntDeclSet ds cs -> IntDeclSet (d':ds) cs - _ -> IntDeclSet [d'] c' + OcDecl (OcProc nn@(OcName n) args code) body -> do + body' <- top body + code' <- top code + let pdecl = nestDecls [(n, d) | d@(OcFormal _ n) <- args] (OcProc nn args code') + return $ IntDecl n pdecl body' + OcDecl (OcFunc nn@(OcName n) args rets code) body -> do + error "blah" + body' <- top body + code' <- top code + let pdecl = nestDecls [(n, d) | d@(OcFormal _ n) <- args] (OcFunc nn args rets code') + return $ IntDecl n pdecl body' + -- FIXME same for functions + OcDecl d body -> do + body' <- top body + return $ case d of + OcVars t ns -> nestDecls [(n, t) | n <- ns] body' + OcIs (OcName n) _ -> IntDecl n d body' + OcIsType (OcName n) _ _ -> IntDecl n d body' + OcValIs (OcName n) _ -> IntDecl n d body' + OcValIsType (OcName n) _ _ -> IntDecl n d body' + OcDataType (OcName n) _ -> IntDecl n d body' + OcProtocol (OcName n) _ -> IntDecl n d body' + OcFuncIs (OcName n) _ _ _ -> IntDecl n d body' + OcRetypes (OcName n) _ _ -> IntDecl n d body' + OcValRetypes (OcName n) _ _ -> IntDecl n d body' + OcReshapes (OcName n) _ _ -> IntDecl n d body' + OcValReshapes (OcName n) _ _ -> IntDecl n d body' + _ -> error ("Unhandled type of declaration: " ++ (show d)) + _ -> next node + +uniqueIdentifiers :: Transform (Int, Map.Map String String) +uniqueIdentifiers next top node + = case node of + IntDecl name def body -> do + (n, ids) <- get + let newname = name ++ "_" ++ (show n) + put (n + 1, Map.insert name newname ids) + def' <- top def + body' <- top body + modify (\(n, _) -> (n, ids)) + return $ IntDecl newname def' body' + OcName s -> do + (_, ids) <- get + return $ if Map.member s ids then OcName (Map.findWithDefault "" s ids) else error ("Unknown identifier: " ++ s) _ -> next node diff --git a/fco/PhaseSource.hs b/fco/PhaseSource.hs index 520f423..3b48242 100644 --- a/fco/PhaseSource.hs +++ b/fco/PhaseSource.hs @@ -12,22 +12,20 @@ bases = [baseTransformOc] phaseSource = (Phase "Source rewriting" [ - ("C-ify identifiers", makePass () cifyIdentifiers bases), - ("Number identifiers", makePass 0 numberIdentifiers bases) + ("Simplify", makePass () simplify bases), + ("C-ify identifiers", makePass () cifyIdentifiers bases) ]) +simplify :: Transform () +simplify next top node + = case node of + -- FIXME rewrite stuff like OcFuncIs -> OcFunc + -- FIXME could we even rewrite procs and functions to the same thing? + _ -> next node + cifyIdentifiers :: Transform () cifyIdentifiers next top node = case node of OcName n -> return $ OcName [if c == '.' then '_' else c | c <- n] _ -> next node -numberIdentifiers :: Transform Int -numberIdentifiers next top node - = case node of - OcName n -> do - i <- get - put $ i + 1 - return $ OcName (n ++ "." ++ (show i)) - _ -> next node - diff --git a/fco/Tree.hs b/fco/Tree.hs index 1963738..d5ae5d1 100644 --- a/fco/Tree.hs +++ b/fco/Tree.hs @@ -139,7 +139,7 @@ data Node = -- }}} END -- {{{ BEGIN baseTransformInt - | IntDeclSet [Node] Node + | IntDecl String Node Node -- }}} END -- {{{ BEGIN baseTransformC diff --git a/fco/test5.occ b/fco/test5.occ index 687e6a4..1825c5b 100644 --- a/fco/test5.occ +++ b/fco/test5.occ @@ -1,3 +1,13 @@ +PROC p (VAL INT x, y, INT z) + z := x + y +: + +INT FUNCTION f (VAL INT x, y) + VALOF + SKIP + RESULT x + y +: + PROC test.expressions () INT a: INT b: @@ -7,4 +17,5 @@ PROC test.expressions () b := 2 c := 3 c := (42 * a) + (b - (72 / c)) + p (a, b, c) :