First (aborted) shot at marking declarations

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 ()
+nestDecls :: [(Node, Node)] -> Node -> Node
-gatherDecls next top 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
+      OcDecl (OcProc nn@(OcName n) args code) body -> do
-        c' <- top c
+        body' <- top body
-        d' <- top d
+        code' <- top code
-        return $ case c' of
+        let pdecl = nestDecls [(n, d) | d@(OcFormal _ n) <- args] (OcProc nn args code')
-          IntDeclSet ds cs -> IntDeclSet (d':ds) cs
+        return $ IntDecl n pdecl body'
-          _ -> IntDeclSet [d'] c'
+      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
 

fco/PhaseSource.hs

@@ -12,22 +12,20 @@ bases = [baseTransformOc]
 phaseSource
   = (Phase "Source rewriting"
       [
-        ("C-ify identifiers", makePass () cifyIdentifiers bases),
+        ("Simplify", makePass () simplify bases),
-        ("Number identifiers", makePass 0 numberIdentifiers 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
-

fco/Tree.hs

@@ -139,7 +139,7 @@ data Node =
 -- }}} END
 
 -- {{{ BEGIN baseTransformInt
-  | IntDeclSet [Node] Node
+  | IntDecl String Node Node
 -- }}} END
 
 -- {{{ BEGIN baseTransformC

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)
 :