From 6ebc9cc13e4d540d2d670e49cc5b44032091c918 Mon Sep 17 00:00:00 2001 From: Adam Sampson Date: Wed, 6 Sep 2006 21:34:54 +0000 Subject: [PATCH] Add code to autogenerate identity passes (and use it) --- fco/PhaseSource.hs | 123 ++++++++++++++++++++++++++++++++++++++++ fco/Tree.hs | 2 + fco/make-passthrough.py | 87 ++++++++++++++++++++++++++++ 3 files changed, 212 insertions(+) create mode 100644 fco/make-passthrough.py diff --git a/fco/PhaseSource.hs b/fco/PhaseSource.hs index f02511a..ca42741 100644 --- a/fco/PhaseSource.hs +++ b/fco/PhaseSource.hs @@ -12,10 +12,133 @@ phaseSource ("Nuke variable names", nukeVars) ]) +-- {{{ BEGIN basePass1 basePass1 :: Pass basePass1 next top node = case node of + OcDecl a b -> OcDecl (top a) (top b) + OcAlt a -> OcAlt (map top a) + OcAltRep a b -> OcAltRep (top a) (top b) + OcPriAlt a -> OcPriAlt (map top a) + OcPriAltRep a b -> OcPriAltRep (top a) (top b) + OcIn a b -> OcIn (top a) (map top b) + OcVariant a b -> OcVariant (top a) (top b) + OcInCase a b -> OcInCase (top a) (map top b) + OcInCaseGuard a b c -> OcInCaseGuard (top a) (top b) (map top c) + OcInTag a b -> OcInTag (top a) (top b) + OcOut a b -> OcOut (top a) (map top b) + OcOutCase a b c -> OcOutCase (top a) (top b) (map top c) + OcExpList a -> OcExpList (map top a) + OcAssign a b -> OcAssign (map top a) (top b) + OcIf a -> OcIf (map top a) + OcIfRep a b -> OcIfRep (top a) (top b) + OcInAfter a b -> OcInAfter (top a) (top b) + OcWhile a b -> OcWhile (top a) (top b) + OcPar a -> OcPar (map top a) + OcParRep a b -> OcParRep (top a) (top b) + OcPriPar a -> OcPriPar (map top a) + OcPriParRep a b -> OcPriParRep (top a) (top b) + OcPlacedPar a -> OcPlacedPar (map top a) + OcPlacedParRep a b -> OcPlacedParRep (top a) (top b) + OcProcessor a b -> OcProcessor (top a) (top b) + OcSkip -> OcSkip + OcStop -> OcStop + OcCase a b -> OcCase (top a) (map top b) + OcSeq a -> OcSeq (map top a) + OcSeqRep a b -> OcSeqRep (top a) (top b) + OcProcCall a b -> OcProcCall (top a) (map top b) + OcMainProcess -> OcMainProcess + OcVars a b -> OcVars (top a) (map top b) + OcIs a b -> OcIs (top a) (top b) + OcIsType a b c -> OcIsType (top a) (top b) (top c) + OcValIs a b -> OcValIs (top a) (top b) + OcValIsType a b c -> OcValIsType (top a) (top b) (top c) + OcPlace a b -> OcPlace (top a) (top b) + OcDataType a b -> OcDataType (top a) (top b) + OcRecord a -> OcRecord (map top a) + OcPackedRecord a -> OcPackedRecord (map top a) + OcFields a b -> OcFields (top a) (map top b) + OcProtocol a b -> OcProtocol (top a) (map top b) + OcTaggedProtocol a b -> OcTaggedProtocol (top a) (map top b) + OcTag a b -> OcTag (top a) (map top b) + OcFormal a b -> OcFormal (top a) (top b) + OcProc a b c -> OcProc (top a) (map top b) (top c) + OcFunc a b c d -> OcFunc (top a) (map top b) (map top c) (top d) + OcFuncIs a b c d -> OcFuncIs (top a) (map top b) (map top c) (top d) + OcRetypes a b c -> OcRetypes (top a) (top b) (top c) + OcValRetypes a b c -> OcValRetypes (top a) (top b) (top c) + OcReshapes a b c -> OcReshapes (top a) (top b) (top c) + OcValReshapes a b c -> OcValReshapes (top a) (top b) (top c) + OcValOf a b -> OcValOf (top a) (top b) + OcSub a b -> OcSub (top a) (top b) + OcSubFromFor a b c -> OcSubFromFor (top a) (top b) (top c) + OcSubFrom a b -> OcSubFrom (top a) (top b) + OcSubFor a b -> OcSubFor (top a) (top b) + OcCaseExps a b -> OcCaseExps (map top a) (top b) + OcElse a -> OcElse (top a) + OcFor a b c -> OcFor (top a) (top b) (top c) + OcConv a b -> OcConv (top a) (top b) + OcRound a b -> OcRound (top a) (top b) + OcTrunc a b -> OcTrunc (top a) (top b) + OcAdd a b -> OcAdd (top a) (top b) + OcSubtr a b -> OcSubtr (top a) (top b) + OcMul a b -> OcMul (top a) (top b) + OcDiv a b -> OcDiv (top a) (top b) + OcMod a b -> OcMod (top a) (top b) + OcRem a b -> OcRem (top a) (top b) + OcPlus a b -> OcPlus (top a) (top b) + OcMinus a b -> OcMinus (top a) (top b) + OcTimes a b -> OcTimes (top a) (top b) + OcBitAnd a b -> OcBitAnd (top a) (top b) + OcBitOr a b -> OcBitOr (top a) (top b) + OcBitXor a b -> OcBitXor (top a) (top b) + OcAnd a b -> OcAnd (top a) (top b) + OcOr a b -> OcOr (top a) (top b) + OcEq a b -> OcEq (top a) (top b) + OcNEq a b -> OcNEq (top a) (top b) + OcLess a b -> OcLess (top a) (top b) + OcMore a b -> OcMore (top a) (top b) + OcLessEq a b -> OcLessEq (top a) (top b) + OcMoreEq a b -> OcMoreEq (top a) (top b) + OcAfter a b -> OcAfter (top a) (top b) + OcMonSub a -> OcMonSub (top a) + OcMonBitNot a -> OcMonBitNot (top a) + OcMonNot a -> OcMonNot (top a) + OcMostPos a -> OcMostPos (top a) + OcMostNeg a -> OcMostNeg (top a) + OcSize a -> OcSize (top a) + OcCall a b -> OcCall (top a) (map top b) + OcBytesIn a -> OcBytesIn (top a) + OcOffsetOf a b -> OcOffsetOf (top a) (top b) + OcGuarded a b -> OcGuarded (top a) (top b) + OcVal a -> OcVal (top a) + OcChanOf a -> OcChanOf (top a) + OcPortOf a -> OcPortOf (top a) + OcTimer -> OcTimer + OcArray a b -> OcArray (top a) (top b) + OcArrayUnsized a -> OcArrayUnsized (top a) + OcCounted a b -> OcCounted (top a) (top b) + OcBool -> OcBool + OcByte -> OcByte + OcInt -> OcInt + OcInt16 -> OcInt16 + OcInt32 -> OcInt32 + OcInt64 -> OcInt64 + OcReal32 -> OcReal32 + OcReal64 -> OcReal64 + OcAny -> OcAny + OcTypedLit a b -> OcTypedLit (top a) (top b) + OcLitReal a -> OcLitReal a + OcLitInt a -> OcLitInt a + OcLitHex a -> OcLitHex a + OcLitByte a -> OcLitByte a + OcLitString a -> OcLitString a + OcLitArray a -> OcLitArray (map top a) + OcTrue -> OcTrue + OcFalse -> OcFalse + OcName a -> OcName a _ -> next node +-- }}} END nukeVars :: Pass nukeVars next top node diff --git a/fco/Tree.hs b/fco/Tree.hs index 66ddec5..e4c1548 100644 --- a/fco/Tree.hs +++ b/fco/Tree.hs @@ -3,6 +3,7 @@ module Tree where data Node = +-- {{{ BEGIN PhaseSource.hs basePass1 OcDecl Node Node | OcAlt [Node] | OcAltRep Node Node @@ -136,6 +137,7 @@ data Node = | OcTrue | OcFalse | OcName String +-- }}} END deriving (Show, Eq) diff --git a/fco/make-passthrough.py b/fco/make-passthrough.py new file mode 100644 index 0000000..e972a63 --- /dev/null +++ b/fco/make-passthrough.py @@ -0,0 +1,87 @@ +#!/usr/bin/python +# Update the boring bass passes from the data type definition in Tree. + +import os, sys, re + +def die(*s): + print >>sys.stderr, "Fatal: " + "".join(map(str, s)) + sys.exit(1) + +def update_def(fn, func, f): + origf = open(fn) + newf = open(fn + ".new", "w") + + while True: + s = origf.readline() + if s == "": + die("Couldn't find start marker for ", func, " in ", fn) + newf.write(s) + if s.strip().startswith("-- {{{ BEGIN " + func): + break + + newf.write(func + " :: Pass\n") + newf.write(func + " next top node\n") + newf.write(" = case node of\n") + while True: + s = f.readline() + if s == "": + die("Unexpected EOF during Node definition") + elif s.strip().startswith("-- }}} END"): + break + + s = s.strip() + if s == "" or s.startswith("--"): + continue + s = s.replace("| ", "") + + fields = s.split() + name = fields[0] + args = fields[1:] + + lhs = [] + rhs = [] + i = 0 + for arg in args: + n = "abcdefghijklm"[i] + i += 1 + + lhs.append(n) + if arg == "Node": + rhs.append("(top " + n + ")") + elif arg == "[Node]": + rhs.append("(map top " + n + ")") + else: + rhs.append(n) + + space = "" + if lhs != []: + space = " " + newf.write(" " + name + space + " ".join(lhs) + " -> " + name + space + " ".join(rhs) + "\n") + newf.write(" _ -> next node\n") + + while True: + s = origf.readline() + if s == "": + die("Couldn't find end marker for ", func, " in ", fn) + if s.strip().startswith("-- }}} END"): + newf.write(s) + break + + newf.write(origf.read()) + + origf.close() + newf.close() + os.rename(fn + ".new", fn) + +def main(): + f = open("Tree.hs") + while 1: + s = f.readline() + if s == "": + break + if s.startswith("-- {{{ BEGIN"): + ss = s.strip().split() + update_def(ss[3], ss[4], f) + f.close() + +main()