diff --git a/fco/Makefile b/fco/Makefile index 67859b6..6d9e3ba 100644 --- a/fco/Makefile +++ b/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 diff --git a/fco/Pass.hs b/fco/Pass.hs index 1744b8d..43dc891 100644 --- a/fco/Pass.hs +++ b/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 diff --git a/fco/PhaseIntermediate.hs b/fco/PhaseIntermediate.hs index ab52491..ab1e787 100644 --- a/fco/PhaseIntermediate.hs +++ b/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 diff --git a/fco/PhaseOutput.hs b/fco/PhaseOutput.hs index c71c9a8..cd4e6f1 100644 --- a/fco/PhaseOutput.hs +++ b/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 diff --git a/fco/PhaseSource.hs b/fco/PhaseSource.hs index d4c38f5..520f423 100644 --- a/fco/PhaseSource.hs +++ b/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 diff --git a/fco/Tree.hs b/fco/Tree.hs index 6d0f818..1963738 100644 --- a/fco/Tree.hs +++ b/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 diff --git a/fco/make-passthrough.py b/fco/make-passthrough.py index 3ed1d04..6fbeb7f 100644 --- a/fco/make-passthrough.py +++ b/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: