Rename Pass -> Transform, and make transforms operate inside the State monad

fco/Makefile

@@ -1,7 +1,7 @@
 all: fco
 
 sources = \
-	BasePasses.hs \
+	BaseTransforms.hs \
 	Parse.hs \
 	Pass.hs \
 	PhaseIntermediate.hs \
@@ -14,6 +14,6 @@ sources = \
 fco: $(sources)
 	ghc -o fco --make Main
 
-BasePasses.hs: Tree.hs make-passthrough.py
+BaseTransforms.hs: Tree.hs make-passthrough.py
 	python make-passthrough.py
 

fco/Pass.hs

@@ -3,43 +3,48 @@
 module Pass where
 
 import Tree
+import Control.Monad.State
 
 type Progress = (String -> IO ())
 
+type ITransform st = Node -> State st Node
 -- This is actually a fraction of a pass: an operation upon the tree.
 -- The arguments are:
 -- - "next": the next pass to try if this one doesn't match;
 -- - "top": the pass to use recursively on subnodes;
 -- - the input node.
-type Pass = (Node -> Node) -> (Node -> Node) -> Node -> Node
+type Transform st = ITransform st -> ITransform st -> ITransform st
 
-runPasses :: [Pass] -> Node -> Node
-runPasses passes = top
+runTransforms :: st -> [Transform st] -> Node -> Node
+runTransforms initState passes node = evalState (top node) initState
   where
-    fail :: Node -> Node
+    fail :: ITransform st
     fail n = error $ "No match for node: " ++ (show n)
 
-    makePassList :: [Pass] -> [Node -> Node]
-    makePassList (p:[]) = [p fail top]
-    makePassList (p:ps) = p (head rest) top : rest
-      where rest = makePassList ps
+    makeTransformList (p:[]) = [p fail top]
+    makeTransformList (p:ps) = p (head rest) top : rest
+      where rest = makeTransformList ps
 
-    passList :: [Node -> Node]
-    passList = makePassList passes
+    passList = makeTransformList passes
 
-    top :: Node -> Node
     top = head passList
 
-data Phase = Phase String [Pass] [(String, Pass)]
+type Pass = Node -> Node
+
+makePass :: st -> Transform st -> [Transform st] -> Pass
+makePass initState t bases = runTransforms initState (t : bases)
+
+data Phase = Phase String [(String, Pass)]
 
 runPhase :: Phase -> Node -> Progress -> IO Node
-runPhase (Phase name bases passes) n progress = do
+runPhase (Phase name passes) n progress = do
   progress $ "Phase: " ++ name
   runPhase' (reverse passes) n
   where
     runPhase' :: [(String, Pass)] -> Node -> IO Node
     runPhase' [] n = do return n
-    runPhase' ((name, p):ps) n = do rest <- runPhase' ps n
-                                    progress $ "  Pass: " ++ name
-                                    return $ runPasses (p : bases) rest
+    runPhase' ((name, pass):passes) n = do
+      rest <- runPhase' passes n
+      progress $ "  Pass: " ++ name
+      return $ pass rest
 

fco/PhaseIntermediate.hs

@@ -4,23 +4,24 @@ module PhaseIntermediate (phaseIntermediate) where
 
 import Tree
 import Pass
-import BasePasses
+import BaseTransforms
+
+bases = [baseTransformOc, baseTransformInt]
 
 phaseIntermediate
   = (Phase "Intermediate mangling"
-      [basePassOc, basePassInt]
       [
-        ("Gather declarations", gatherDecls)
+        ("Gather declarations", makePass () gatherDecls bases)
       ])
 
-gatherDecls :: Pass
+gatherDecls :: Transform ()
 gatherDecls next top node
   = case node of
-      OcDecl d c -> let c' = top c
-                        d' = top d
-                    in
-                    case c' of
-                      IntDeclSet ds cs -> IntDeclSet (d':ds) cs
-                      _ -> IntDeclSet [d'] c'
+      OcDecl d c -> do
+        c' <- top c
+        d' <- top d
+        return $ case c' of
+          IntDeclSet ds cs -> IntDeclSet (d':ds) cs
+          _ -> IntDeclSet [d'] c'
       _ -> next node
 

fco/PhaseOutput.hs

@@ -4,16 +4,17 @@ module PhaseOutput (phaseOutput) where
 
 import Tree
 import Pass
-import BasePasses
+import BaseTransforms
+
+bases = [baseTransformOc, baseTransformInt, baseTransformC]
 
 phaseOutput
   = (Phase "C output"
-      [basePassOc, basePassInt, basePassC]
       [
-        ("Convert expressions", convExpressions)
+        ("Convert expressions", makePass () convExpressions bases)
       ])
 
-convExpressions :: Pass
+convExpressions :: Transform ()
 convExpressions next top node
   = case node of
     _ -> next node

fco/PhaseSource.hs

@@ -4,18 +4,30 @@ module PhaseSource (phaseSource) where
 
 import Tree
 import Pass
-import BasePasses
+import BaseTransforms
+import Control.Monad.State
+
+bases = [baseTransformOc]
 
 phaseSource
   = (Phase "Source rewriting"
-      [basePassOc]
       [
-        ("C-ify identifiers", cifyIdentifiers)
+        ("C-ify identifiers", makePass () cifyIdentifiers bases),
+        ("Number identifiers", makePass 0 numberIdentifiers bases)
       ])
 
-cifyIdentifiers :: Pass
+cifyIdentifiers :: Transform ()
 cifyIdentifiers next top node
   = case node of
-      OcName n -> OcName [if c == '.' then '_' else c | c <- n]
+      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

@@ -3,7 +3,7 @@
 module Tree where
 
 data Node =
--- {{{ BEGIN basePassOc
+-- {{{ BEGIN baseTransformOc
   OcDecl Node Node
   | OcAlt [Node]
   | OcAltRep Node Node
@@ -138,11 +138,11 @@ data Node =
   | OcName String
 -- }}} END
 
--- {{{ BEGIN basePassInt
+-- {{{ BEGIN baseTransformInt
   | IntDeclSet [Node] Node
 -- }}} END
 
--- {{{ BEGIN basePassC
+-- {{{ BEGIN baseTransformC
   | CCode String
 -- }}} END
 

fco/make-passthrough.py

@@ -1,5 +1,5 @@
 #!/usr/bin/python
-# Update the boring bass passes from the data type definition in Tree.
+# Generate the base transforms from the data type definition in Tree.
 
 import os, sys, re
 
@@ -8,7 +8,7 @@ def die(*s):
 	sys.exit(1)
 
 def update_def(func, f, newf):
-	newf.write("\n" + func + " :: Pass\n")
+	newf.write("\n" + func + " :: Transform st\n")
 	newf.write(func + " next top node\n")
 	newf.write("  = case node of\n")
 	while True:
@@ -28,37 +28,45 @@ def update_def(func, f, newf):
 		args = fields[1:]
 
 		lhs = []
+		lines = []
 		rhs = []
-		i = 0
+		i = 1
 		for arg in args:
-			n = "abcdefghijklm"[i]
+			n = "a" + str(i)
 			i += 1
 
 			lhs.append(n)
+			var = "v" + n
 			if arg == "Node":
-				rhs.append("(top " + n + ")")
+				lines.append(var + " <- top " + n)
+				rhs.append(var)
 			elif arg == "[Node]":
-				rhs.append("(map top " + n + ")")
+				lines.append(var + " <- mapM top " + n)
+				rhs.append(var)
 			else:
 				rhs.append(n)
 
 		space = ""
 		if lhs != []:
 			space = " "
-		newf.write("      " + name + space + " ".join(lhs) + " -> " + name + space + " ".join(rhs) + "\n")
+		newf.write("      " + name + space + " ".join(lhs) + " -> do\n")
+		for l in lines:
+			newf.write("        " + l + "\n")
+		newf.write("        return $ " + name + space + " ".join(rhs) + "\n")
 	newf.write("      _ -> next node\n")
 
 def main():
 	f = open("Tree.hs")
-	newf = open("BasePasses.hs", "w")
+	newf = open("BaseTransforms.hs", "w")
 
-	newf.write("""-- Base passes
+	newf.write("""-- Base transforms
 -- Automatically generated from Tree.hs -- do not edit!
 
-module BasePasses where
+module BaseTransforms where
 
 import Tree
 import Pass
+import Control.Monad
 """)
 
 	while 1: