source: proto/pabloH/pabloc1.hs @ 5596

Last change on this file since 5596 was 4864, checked in by cameron, 4 years ago

Eliminate trivial reassignments

File size: 4.5 KB
Line 
1module PabloCompiler1 where
2
3import ParsePablo
4import PabloIR
5import System.IO (stdout,stderr,hPutStr,hPutStrLn)
6import Control.Monad
7
8compileBinary :: (String, Int, PabloE, PabloE, Operator) -> (Int, [PabloInstruction], Operand)
9compileBinary (pfx, n, e1, e2, op) =
10    let (n1, e1instrs, v1) = compileE(pfx, n, e1)
11        (n2, e2instrs, v2) = compileE(pfx, n1, e2)
12        newTemp = pfx ++ (show n2)
13    in (n2+1, e1instrs ++ e2instrs ++ [Binary(newTemp, op, v1, v2)], IRvar(newTemp))
14
15compileE :: (String, Int, PabloE) -> (Int, [PabloInstruction], Operand)
16compileE (pfx, n, All(0)) = (n, [], IRnum 0)
17compileE (pfx, n, All(1)) = (n, [], IRnum (-1))
18compileE (pfx, n, Var(v)) = (n, [], IRvar v)
19compileE (pfx, n, And(e1, e2)) =  compileBinary(pfx, n, e1, e2, BitwiseAnd)
20compileE (pfx, n, Or(e1, e2)) =  compileBinary(pfx, n, e1, e2, BitwiseOr)
21compileE (pfx, n, Xor(e1, e2)) =  compileBinary(pfx, n, e1, e2, BitwiseXor)
22compileE (pfx, n, Not(e)) =  compileBinary(pfx, n, e, All(1), BitwiseXor)
23compileE (pfx, n, Advance(e, shft)) = 
24    let (n1, instrs, v) = compileE(pfx, n, e)
25        newTemp = pfx ++ (show n1)
26    in (n1+1, instrs ++ [Binary(newTemp, ShiftLeft, v, IRnum shft)], IRvar(newTemp))
27compileE (pfx, n, MatchStar(e1, e2)) = 
28    let (n1, e1instrs, v1) = compileE(pfx, n, e1)
29        (n2, e2instrs, v2) = compileE(pfx, n1, e2) 
30    in codegenMatchStar(pfx, n2, e1instrs++e2instrs, v1, v2)
31
32codegenMatchStar(pfx, n, instrs, v1, v2) =
33    let (t1, t2, t3, t4) = (pfx ++ (show n), pfx ++ (show (n + 1)), pfx ++ (show (n + 2)), pfx ++ (show (n + 3)))
34    in (n + 4, 
35        instrs ++ [Binary(t1, BitwiseAnd, v1, v2), 
36                   Binary(t2, PabloAdd, IRvar(t1), v2),
37                   Binary(t3, BitwiseXor, IRvar(t2), v2),
38                   Binary(t4, BitwiseOr, IRvar(t3), v1)],
39        IRvar(t4))
40
41replaceOrAssignTarget(targetVar, (n, [], v)) = (n, [IRassign(targetVar, v)])
42replaceOrAssignTarget(targetVar, (n, instrs, v)) = 
43    case (last instrs) of
44        Binary(temp, op, e1, e2) -> (n-1, (init instrs) ++ [Binary(targetVar, op, e1, e2)])
45        _ -> (n, instrs ++ [IRassign(targetVar, v)])
46
47compileAssigns :: (String, Int, [PabloS]) -> (Int, [PabloInstruction])
48compileAssigns (pfx, n, []) = (n, [])
49compileAssigns (pfx, n, Assign(varname, e) : more) = 
50   let (n1, instrs) = replaceOrAssignTarget(varname, compileE(pfx, n, e))
51       (n2, moreInstrs) = compileAssigns(pfx, n1, more)
52   in (n2, instrs ++ moreInstrs)
53
54isAssign (Assign(v,e)) = True
55isAssign _ = False
56
57compileStmts :: (String, Int, String, PabloInstruction, [PabloS]) -> (Int, [BasicBlock])
58compileStmts(pfx, n, entryLabel, exitInstr, stmts) =
59    let (assigns, rest) = span isAssign stmts
60        (n1, instrs1) = compileAssigns(pfx, n, assigns)
61    in case rest of
62          [] -> (n1, [Block(entryLabel, instrs1 ++ [exitInstr])])
63          (If(e, thenS, elseS)) : afterIf ->
64              let (n2, eInstrs, v1) = compileE(pfx, n1, e)
65                  thenLabel         = "if.body" ++ (show n2)
66                  elseLabel         = "if.else" ++ (show n2)
67                  endLabel          = "if.end" ++ (show n2)
68                  (n3, thenIR)      = compileStmts(pfx, n2 + 1, thenLabel, Branch(endLabel), thenS)
69                  (n4, elseIR)      = compileStmts(pfx, n3 + 1, elseLabel, Branch(endLabel), elseS)
70                  (n5, afterIfIR)   = compileStmts(pfx, n4 + 1, endLabel, exitInstr, afterIf)
71              in (n5, Block(entryLabel, instrs1 ++ eInstrs ++ [CondBranch(v1, thenLabel, elseLabel)]) : (thenIR ++ elseIR ++ afterIfIR))
72          (While(e, repeatS)) : afterWhile ->
73              let (n2, eInstrs, v1) = compileE(pfx, n1, e)
74                  testLabel         = "while.test" ++ (show n2)
75                  bodyLabel         = "while.body" ++ (show n2)
76                  endLabel          = "while.end" ++ (show n2)
77                  (n3, repeatIR)    = compileStmts(pfx, n2 + 1, bodyLabel, Branch(testLabel), repeatS)
78                  (n4, afterIR)     = compileStmts(pfx, n3 + 1, endLabel, exitInstr, afterWhile)
79                  block1            = Block(entryLabel, instrs1 ++ [Branch testLabel])
80                  block2            = Block(testLabel, eInstrs ++ [CondBranch(v1, bodyLabel, endLabel)])
81              in (n4, block1 : block2 : (repeatIR ++ afterIR))
82     
83compileMain stmts = 
84    let (n, compiled) = compileStmts("tmp", 0, "entry", Ret, stmts)
85    in IR compiled
86
87doCompile(srcfile) = do
88    srcText <- readFile srcfile
89    case parsePablo srcText of
90        Nothing -> hPutStrLn stdout "Pablo parsing failure"
91        Just pabloCode ->
92            hPutStrLn stdout (show (compileMain pabloCode))
Note: See TracBrowser for help on using the repository browser.