eoc.cabal

@@ -17,7 +17,7 @@ build-type:          Simple
 extra-source-files:  README.md
 
 library eoc-lib
-    exposed-modules: Eoc, Bril, Bril.CFG
+    exposed-modules: Eoc, Bril
     hs-source-dirs: lib
     build-depends:
         base >=4.13 && <4.18,
@@ -25,9 +25,8 @@ library eoc-lib
         aeson >= 2.2,
         sorted-list ^>= 0.2,
         bytestring ^>= 0.11,
-        scientific ^>= 0.3,
+        scientific ^>= 0.3
-        containers ^>= 0.6.7
+    default-language: Haskell2010
-  default-language: Haskell2010
   default-extensions: DeriveGeneric, OverloadedStrings
 
 executable eoc
@@ -47,7 +46,6 @@ test-suite tests
     build-depends:
         base >=4.13 && <4.18,
         HUnit >=1.6,
-        QuickCheck ^>=2.15,
         eoc-lib,
         text >= 2.0,
         aeson >= 2.2

lib/Bril.hs

@@ -120,24 +120,24 @@ instrFromString s
 
 instance Show InstrOperation where
     show op = case op of
-        Add   -> "add"
+        Nop   -> "add"
-        Sub   -> "sub"
+        Add   -> "sub"
-        Mul   -> "mul"
+        Sub   -> "mul"
-        Eq    -> "eq"
+        Mul   -> "eq"
-        Lt    -> "lt"
+        Eq    -> "lt"
-        Gt    -> "gt"
+        Lt    -> "gt"
-        Le    -> "le"
+        Gt    -> "le"
-        Ge    -> "ge"
+        Le    -> "ge"
-        Not   -> "not"
+        Ge    -> "not"
-        And   -> "and"
+        Not   -> "and"
-        Or    -> "or"
+        And   -> "or"
-        Jmp   -> "jmp"
+        Or    -> "jmp"
-        Br    -> "br"
+        Jmp   -> "br"
-        Ret   -> "ret"
+        Br    -> "ret"
-        Call  -> "call"
+        Ret   -> "call"
-        Print -> "print"
+        Call  -> "print"
-        Id    -> "id"
+        Print -> "id"
-        Nop   -> "nop"
+        Id    -> "nop"
 
 
 optionalArrayField :: FromJSON a => Data.Aeson.Object -> Data.Aeson.Key -> Parser [a]

lib/Bril/CFG.hs

@@ -1,85 +0,0 @@
-module Bril.CFG (BasicBlock, CFG, createCFG) where
-
-import Bril
-import qualified Data.Map.Strict as Map
-
-data BasicBlock = BasicBlock {
-        instrs :: [Instruction],
-        incoming :: [String]
-    }
-   deriving (Show)
-
-data CFG = CFG {
-        cfgBlocks :: Map.Map String BasicBlock,
-        cfgStart :: String
-    }
-   deriving (Show)
-
-createCFG :: [Instruction] -> CFG
-createCFG instrs =
-    let
-        (initCFG, firstLabel) = initializeCFG $ addFallthroughJmp $ splitBBs $ addInitialLabel instrs
-        cfgBlocks' = foldr processBB (cfgBlocks initCFG) (Map.keys (cfgBlocks initCFG))
-    in
-        CFG cfgBlocks' firstLabel
-    where
-        processBB :: String -> Map.Map String BasicBlock -> Map.Map String BasicBlock
-        processBB label m = addBBJumps label (outgoingCFGLabels m label) m
-        addBBJumps :: String -> [String] -> Map.Map String BasicBlock -> Map.Map String BasicBlock
-        addBBJumps bblockLabel incomingLabels m = Map.adjust (addLabels incomingLabels) bblockLabel m
-        addLabels :: [String] -> BasicBlock -> BasicBlock
-        addLabels labels (BasicBlock instrs incoming) = (BasicBlock instrs (incoming ++ labels))
-
-initializeCFG :: [([Instruction], String)] -> (CFG, String)
-initializeCFG instrs =
-    let mappedBlocks = foldr mapBlock Map.empty instrs -- Map.fromList $ map swap instrs
-        firstLabel = snd . head $ instrs
-    in (CFG mappedBlocks firstLabel, firstLabel)
-    where
-        mapBlock (instrs, label) m = Map.insert label (BasicBlock instrs []) m
-
-addFallthroughJmp :: [([Instruction], String)] -> [([Instruction], String)]
-addFallthroughJmp blocks =
-    let blocks' = map addJumpToNextBB $ zip blocks $ tail $ map snd blocks
-    in blocks' ++ [last blocks]
-    where
-        addJumpToNextBB (block@(instrs, label), nextLabel)
-            -- TODO: handle empty instrs
-            | isJump (last instrs) = block
-            | otherwise = (instrs ++ [EffectInstr Jmp [] [] [nextLabel]], label)
-
-splitBBs :: [Instruction] -> [([Instruction], String)]
-splitBBs instrs = zip (tail basicBlocks) labels
-    where
-        (basicBlocks, labels) = foldr splitBBs' ([[]], []) instrs
-        splitBBs' instr (bblocks, labels)
-                | isLabel instr = ([] : bblocks, (labelName instr) : labels)
-                | isJump instr = ([instr] : (tail bblocks) , labels)
-                | otherwise = ((instr : (head bblocks)) : (tail bblocks), labels)
-
-addInitialLabel :: [Instruction] -> [Instruction]
-addInitialLabel instrs@(firstInstr : instrs')
-    | isLabel firstInstr = instrs
-    | otherwise = (Label "@start") : instrs
-addInitialLabel [] = []
-
-labelName (Label name) = name
-isLabel instr = case instr of
-    (Label _) -> True
-    _ -> False
-    
-isJump instr = case instr of
-    (EffectInstr op _ _ _) -> op == Jmp || op == Br
-    _ -> False
-
-outgoingCFGLabels :: Map.Map String BasicBlock -> String -> [String]
-outgoingCFGLabels m label =
-    case Map.lookup label m of
-        Just bb -> outgoingLabels bb
-        _ -> []
-
-outgoingLabels :: BasicBlock -> [String]
-outgoingLabels (BasicBlock instrs _) =
-    let (EffectInstr lastOp _ _ labels) = last instrs
-    in labels
-

tests/Main.hs

@@ -1,8 +1,7 @@
 module Main where
 
 import qualified Bril as B
-import qualified Bril.CFG as BCFG
+import Data.Aeson (eitherDecode, decode, toJSON, parseJSON, Result(..))
-import Data.Aeson (eitherDecode, decode, encode, toJSON, parseJSON, Result(..))
 import Data.Aeson.Types (parse)
 import Data.Text
 import Data.Maybe
@@ -11,7 +10,6 @@ import Data.Function ((&))
 import Control.Exception (try)
 
 import Test.HUnit
-import qualified Test.QuickCheck as QC
 import qualified System.Exit as Exit
  
 testTypes :: Test
@@ -83,10 +81,6 @@ testInstrs = TestCase $ do
         (eitherDecode "{\"op\": \"id\", \"dest\": \"a\", \"type\": \"bool\", \"args\": [\"b\"]}")
         (Right $ B.ValueInstr B.Id B.Bool "a" ["b"] [] [])
 
-    assertEqual "parse label"
-        (eitherDecode "{\"label\": \"test\"}")
-        (Right $ B.Label "test")
-
 testProgramFromFiles :: Test
 testProgramFromFiles = TestCase $ do
     res <- try $ (B.parseBrilFromPath "bril-sources/add.json") :: IO (Either IOError (Either String B.Program))
@@ -94,10 +88,6 @@ testProgramFromFiles = TestCase $ do
         (Right parseResult) -> assertBool "parse add.json" $ isRight parseResult
         _ -> assertFailure "cannot open file"
 
-prop_InvariantBrilSerialization :: B.Program -> Bool
-prop_InvariantBrilSerialization program =
-    (decode (encode program)) == (Just program)
-
 
 tests :: Test
 tests = TestList [
@@ -110,6 +100,4 @@ tests = TestList [
 main :: IO ()
 main = do
     result <- runTestTT tests
-
-    -- QC.quickCheck prop_InvariantBrilSerialization
     if failures result > 0 then Exit.exitFailure else Exit.exitSuccess