.kakrc

@@ -1,10 +1,9 @@
-set global makecmd 'cabal build'
+hook -once -group eoc global KakBegin .* %{
-#hook -once -group eoc global KakBegin .* %{
+    repl-buffer-new racket -i
-#    repl-buffer-new racket -i
+    repl-buffer-send-text "(require xrepl)
-#    repl-buffer-send-text "(require xrepl)
+"
-#"
+%}
-#%}
+
-#
+define-command xrepl-enter %{
-#define-command xrepl-enter %{
+    repl-buffer-send-text ",en %val{buffile}"
-#    repl-buffer-send-text ",en %val{buffile}"
+}
-#}

Setup.hs

@@ -1,2 +0,0 @@
-import Distribution.Simple
-main = defaultMain

bin/Parse.hs

@@ -1,17 +0,0 @@
-module Main where
-
-import Data.Either (isRight)
-import qualified Data.ByteString.Lazy as B
-import System.Exit
-import Bril
-
-main :: IO ()
-main = do
-    json <- B.getContents
-    let parsed = parseBrilJSON json
-    if isRight parsed
-       then do
-           B.putStr json
-           exitWith ExitSuccess
-        else
-            exitWith (ExitFailure 1)

bril-sources/add.json

@@ -1,37 +0,0 @@
-{
-"functions": [
-    {
-      "instrs": [
-        {
-          "dest": "v0",
-          "op": "const",
-          "type": "int",
-          "value": 1
-        },
-        {
-          "dest": "v1",
-          "op": "const",
-          "type": "int",
-          "value": 2
-        },
-        {
-          "args": [
-            "v0",
-            "v1"
-          ],
-          "dest": "v2",
-          "op": "add",
-          "type": "int"
-        },
-        {
-          "args": [
-            "v2"
-          ],
-          "op": "print"
-        }
-      ],
-      "name": "main"
-    }
-  ]
-}
-

eoc.cabal

@@ -1,58 +0,0 @@
-cabal-version:       2.0
--- Initial package description 'eoc.cabal' generated by 'cabal init'.  For
--- further documentation, see http://haskell.org/cabal/users-guide/
-
-name:                eoc
-version:             0.1.0.0
--- synopsis:
--- description:
--- bug-reports:
--- license:
-license-file:        LICENSE
-author:              Enrico Lumetti
-maintainer:          enrico.lumetti@gmail.com
--- copyright:
--- category:
-build-type:          Simple
-extra-source-files:  README.md
-
-library eoc-lib
-    exposed-modules: Eoc, Bril, Bril.CFG
-    hs-source-dirs: lib
-    build-depends:
-        base >=4.13 && <4.18,
-        text >= 2.0,
-        aeson >= 2.2,
-        sorted-list ^>= 0.2,
-        bytestring ^>= 0.11,
-        scientific ^>= 0.3,
-        containers ^>= 0.6.7
-  default-language: Haskell2010
-  default-extensions: DeriveGeneric, OverloadedStrings
-
-executable parse
-  main-is:             bin/Parse.hs
-  -- other-modules:
-  -- other-extensions:
-  build-depends:
-      base >=4.13 && <4.18,
-      bytestring ^>= 0.11,
-      eoc-lib
-  -- hs-source-dirs:
-  default-language:    Haskell2010
-  default-extensions: DeriveGeneric, OverloadedStrings
-
-test-suite tests
-    type: exitcode-stdio-1.0
-    main-is: Main.hs
-    build-depends:
-        base >=4.13 && <4.18,
-        HUnit >=1.6,
-        QuickCheck ^>=2.15,
-        eoc-lib,
-        text >= 2.0,
-        aeson >= 2.2
-    hs-source-dirs: tests
-    default-language: Haskell2010
-    default-extensions: DeriveGeneric, OverloadedStrings
-

lib/Bril.hs

@@ -1,297 +0,0 @@
-module Bril (
-    Function (..), Type (..), Value (..), InstrOperation (..), FunctionArg (..), Program (..),
-    Instruction (..),
-    parseValue,
-    parseBrilFromPath, parseBrilJSON,
-    )where
-
-import Data.Aeson (FromJSON, ToJSON, parseJSON, toJSON, object, withObject, withText, withBool, withScientific, (.:), (.:?), (.=), (.?=), eitherDecode)
-import Data.Aeson.Types (Parser, modifyFailure)
-import qualified Data.Aeson (Value, Object, Key)
-import Data.Aeson.KeyMap
-import Data.Int (Int64)
-import qualified Data.Text as T
-import Data.Text.Read (Reader, signed, decimal)
-import Data.SortedList
-import Data.Maybe (fromMaybe, isJust)
-import Data.Scientific (isInteger, toBoundedInteger)
-
-import qualified Data.ByteString.Lazy as LB
-
-data Program = Program { programFns :: [Function] }
-    deriving (Show, Eq)
-
-type VarName = String
-type FuncName = String
-
-data Function = Function {
-        functionName :: FuncName,
-        returnType :: Maybe Type,
-        functionArgs :: [FunctionArg],
-        instructions :: [Instruction]
-    } deriving (Show, Eq)
-
-data Type = Int | Bool
-    deriving (Show, Eq)
-data Value = IntValue Int64 | BoolValue Bool
-    deriving (Eq, Show)
-
-data FunctionArg = FunctionArg {
-        argName :: VarName,
-        argType :: Type
-    } deriving (Show, Eq)
-
-data Instruction =
-    Label String
-  | LiteralInstr {
-        value :: Value,
-        dest :: VarName
-    }
-  | ValueInstr {
-       op :: InstrOperation,
-       type_ :: Type,
-       dest :: VarName,
-       args :: [VarName],
-       funcs :: [FuncName],
-       labels :: [String]
-     }
-   | EffectInstr {
-        op :: InstrOperation,
-        args :: [VarName],
-        funcs :: [FuncName],
-        labels :: [String]
-     }
-   deriving (Show, Eq)
-
-data InstrOperation =
-    Add | Mul | Sub | Div | Eq | Lt | Gt | Le | Ge | Not | And | Or |
-    Jmp | Br | Call | Ret | Id | Print | Nop | Phi
-   deriving (Eq)
-
-data Arity =
-    Arity Int Int Int -- min, max, labels arity
-  | VarArgs
-   deriving (Eq, Show)
-
-valueOps = toSortedList ([
-        "add", "mul", "sub", "div", "eq", "lt", "gt", "le", "ge", "not", "and", "or", "id"
-    ] :: [T.Text])
-
-effectOps = toSortedList ([
-        "nop", "call", "jmp", "br", "print", "ret"
-    ] :: [T.Text])
-
-arity instr
-    | instr `elem` [Add, Mul, Sub, Div, Eq, Lt, Gt, Le, Ge, And, Or] = Arity 2 2 0
-    | instr `elem` [Id, Not] = Arity 1 1 0
-    | instr == Ret  = Arity 0 1 0
-    | instr == Jmp = Arity 0 0 1
-    | instr == Br = Arity 1 1 2
-    | instr == Nop = Arity 0 0 0
-    | otherwise = VarArgs
-
-checkArity :: InstrOperation -> [b] -> [c] -> Bool
-checkArity instr args labels =
-    case arity instr of
-        Arity n m l ->
-            (((length args) >= n) && ((length args) <= m)) && ((length labels) == l)
-        VarArgs -> True
-
-instrFromString s
-    | s == "add" = Add
-    | s == "sub" = Sub
-    | s == "mul" = Mul
-    | s == "eq" = Eq
-    | s == "lt" = Lt
-    | s == "gt" = Gt
-    | s == "le" = Le
-    | s == "ge" = Ge
-    | s == "not" = Not
-    | s == "and" = And
-    | s == "or" = Or
-    | s == "jmp" = Jmp
-    | s == "br" = Br
-    | s == "ret" = Ret
-    | s == "call" = Call
-    | s == "print" = Print
-    | s == "id" = Id
-    | s == "nop" = Nop
-    | otherwise = error "wrong instruction name"
-
-instance Show InstrOperation where
-    show op = case op of
-        Add   -> "add"
-        Sub   -> "sub"
-        Mul   -> "mul"
-        Eq    -> "eq"
-        Lt    -> "lt"
-        Gt    -> "gt"
-        Le    -> "le"
-        Ge    -> "ge"
-        Not   -> "not"
-        And   -> "and"
-        Or    -> "or"
-        Jmp   -> "jmp"
-        Br    -> "br"
-        Ret   -> "ret"
-        Call  -> "call"
-        Print -> "print"
-        Id    -> "id"
-        Nop   -> "nop"
-
-
-optionalArrayField :: FromJSON a => Data.Aeson.Object -> Data.Aeson.Key -> Parser [a]
-optionalArrayField v field =
-    ((v .:? field) >>= (return . fromMaybe []))
-
-
-instance FromJSON Program  where
-    parseJSON = withObject "Program" $ \v -> Program
-        <$> v .: "functions"
-
-instance FromJSON Function where
-    parseJSON = withObject "Function" $ \v -> Function
-        <$> v .: "name"
-        <*> v .:? "type"
-        <*> v `optionalArrayField` "args"
-        <*> v .: "instrs"
-
-instance FromJSON Instruction where
-    parseJSON = withObject "Instruction" $ \v ->
-        if (Data.Aeson.KeyMap.member "label" v)
-            then Label <$> v .: "label"
-            else do
-                op <- (v .: "op") :: Parser T.Text
-                parseInstr op v
-     where
-        parseInstr op
-            | op == "const" = parseLiteralInstr
-            | op `elemOrd` valueOps = parseValueInstr op
-            | op `elemOrd` effectOps = parseEffectInstr op
-            | otherwise = const $ fail ("Invalid op: " ++ (T.unpack op))
-        parseLiteralInstr v = do
-            type_ <- (v .: "type") :: Parser Type
-            LiteralInstr
-                <$> ((v .: "value") >>= (parseValue type_))
-                <*> v .: "dest"
-        parseValueInstr op v = do
-            dest  <- (v .: "dest") :: Parser VarName
-            args  <- (v `optionalArrayField` "args") :: Parser [VarName]
-            labels  <- (v `optionalArrayField` "labels") :: Parser [VarName]
-            funcs  <- (v `optionalArrayField` "funcs") :: Parser [VarName]
-            let instr = instrFromString op
-            if not (checkArity instr args labels)
-                then fail $ unexpectedArityError op args labels
-                else ValueInstr
-                    <$> return instr
-                    <*> v .: "type"
-                    <*> v .: "dest"
-                    <*> return args
-                    <*> return funcs
-                    <*> return labels
-        parseEffectInstr op v = do
-            args  <- (v `optionalArrayField` "args") :: Parser [VarName]
-            labels  <- (v `optionalArrayField` "labels") :: Parser [VarName]
-            funcs  <- (v `optionalArrayField` "funcs") :: Parser [VarName]
-            dest <- (v .:? "dest") :: Parser (Maybe VarName)
-            if (op == "call") && ((length funcs) /= 1)
-                then fail $ "call op must have exactly one entry in \"funcs\""
-                else if (isJust dest) && (op == "call")
-                    then parseValueInstr op v
-                    else do
-                        let instr = instrFromString op
-                        if not (checkArity instr args labels)
-                            then fail $ unexpectedArityError op args labels
-                            else EffectInstr
-                                <$> return instr
-                                <*> return args
-                                <*> return funcs
-                                <*> return labels
-
-        unexpectedArityError op args labels =
-            "wrong arity for " ++ (T.unpack op) ++ ": got " ++ (show (length args)) ++ ", " ++ (show (length labels))
-
-instance FromJSON FunctionArg where
-    parseJSON = withObject "FunctionArg" $ \v -> FunctionArg
-        <$> v .: "name"
-        <*> v .: "type"
-
-instance FromJSON Type where
-    parseJSON = withText "Type" $ \v ->
-        case v of
-             "int" -> return Int
-             "bool" -> return Bool
-             _ -> fail "wrong type"
-
-parseValue :: Type -> Data.Aeson.Value -> Parser Value
-parseValue Bool =
-    withBool "BoolValue" (return . BoolValue)
-
-parseValue Int =
-    withScientific "IntValue" $ \v ->
-        if (not (isInteger v))
-            then fail $ "Invalid integer literal: " ++ (show v)
-            else do
-                let num = toBoundedInteger v :: Maybe Int64
-                case num of
-                    (Just n) -> return $ IntValue n
-                    _ -> fail $ "Integer exceeds int64: " ++ (show v)
-
-          
-
-parseBrilJSON text = (eitherDecode text :: Either String Program)
-
-parseBrilFromPath path = do
-    contents <- LB.readFile path
-    return $ parseBrilJSON contents
-
-instance ToJSON Type where
-    toJSON Bool = toJSON ("bool" :: T.Text)
-    toJSON Int = toJSON ("int" :: T.Text)
-
-instance ToJSON FunctionArg  where
-    toJSON (FunctionArg argName argType) = object [
-            "name" .= argName,
-            "type" .= argType
-        ]
-
-instance ToJSON Value  where
-    toJSON (IntValue val) = toJSON val
-    toJSON (BoolValue val) = toJSON val
-
-instance ToJSON Instruction where
-    toJSON (Label name) = object [ "label" .= name ]
-    toJSON (LiteralInstr value dest) = object [
-            "op" .= ("const" :: T.Text),
-            "dest" .= dest,
-            "type" .= case value of
-                (IntValue _) -> Int
-                (BoolValue _) -> Bool,
-            "value" .= value
-        ]
-    toJSON (EffectInstr op args funcs labels) = object [
-            "op" .= (show op),
-            "args" .= args,
-            "funcs" .= funcs,
-            "labels" .= labels
-        ]
-    toJSON (ValueInstr op type_ dest args funcs labels) = object [
-            "op" .= (show op),
-            "dest" .= dest,
-            "type" .= type_,
-            "args" .= args,
-            "funcs" .= funcs,
-            "labels" .= labels
-        ]
-
-instance ToJSON Function where
-    toJSON (Function name type_ args instrs) = object $ [
-            "name" .= name,
-            "args" .= args,
-            "instrs" .= instrs
-        ] ++ case type_ of
-            Nothing -> []
-            (Just t) -> ["type" .= t]
-
-instance ToJSON Program where
-    toJSON (Program functions) = object [ "functions" .= functions ]

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
-

lib/Eoc.hs

@@ -1,2 +0,0 @@
-module Eoc where
-

run-tests.sh

@@ -1,3 +0,0 @@
-#!/bin/sh
-
-turnt bril-sources/*.json

tests/Main.hs

@@ -1,115 +0,0 @@
-module Main where
-
-import qualified Bril as B
-import qualified Bril.CFG as BCFG
-import Data.Aeson (eitherDecode, decode, encode, toJSON, parseJSON, Result(..))
-import Data.Aeson.Types (parse)
-import Data.Text
-import Data.Maybe
-import Data.Either
-import Data.Function ((&))
-import Control.Exception (try)
-
-import Test.HUnit
-import qualified Test.QuickCheck as QC
-import qualified System.Exit as Exit
- 
-testTypes :: Test
-testTypes = TestCase $ do
-    assertEqual "int type" (decode "\"int\"" :: Maybe B.Type) (Just B.Int)
-    assertEqual "bool type" (decode "\"bool\"" :: Maybe B.Type) (Just B.Bool)
-
-testLiterals :: Test
-testLiterals = TestCase $ do
-    assertEqual "true literal"
-        (parseLiteral B.Bool True) (Success $ B.BoolValue True)
-    assertEqual "false literal"
-        (parseLiteral B.Bool False) (Success $ B.BoolValue False)
-
-    assertEqual "int literal"
-        (parseLiteral B.Int (1434 :: Int)) (Success $ B.IntValue 1434)
-    assertEqual "wrong int literal"
-        (parseLiteral B.Int (100000000000000000000 :: Integer))
-        (Error "Integer exceeds int64: 1.0e20")
-    assertEqual "wrong int literal"
-        (parseLiteral B.Int (123.5 :: Double)) (Error "Invalid integer literal: 123.5")
-
-    where
-        parseLiteral type_ x = (parse (B.parseValue type_) (toJSON x))
-
-testInstrs :: Test
-testInstrs = TestCase $ do
-    assertEqual "add instr"
-        (eitherDecode "{\"op\": \"add\", \"type\": \"int\", \"dest\": \"x\", \"args\": [\"a\", \"b\"]}")
-        (Right $ B.ValueInstr B.Add B.Int "x" ["a", "b"] [] [])
-
-    assertEqual "sub instr"
-        (decode "{\"op\": \"sub\", \"type\": \"int\", \"dest\": \"x\", \"args\": [\"a\", \"b\"]}")
-        (Just $ B.ValueInstr B.Sub B.Int "x" ["a", "b"] [] [])
-
-    assertEqual "wrong instr"
-        (eitherDecode "{\"op\": \"wrnog\", \"type\": \"int\", \"dest\": \"x\", \"args\": [\"a\", \"b\"]}")
-        (Left "Error in $: Invalid op: wrnog" :: Either String B.Instruction)
-
-    assertEqual "wrong arity"
-        (eitherDecode "{\"op\": \"add\", \"type\": \"int\", \"dest\": \"x\", \"args\": [\"b\"]}")
-        (Left "Error in $: wrong arity for add: got 1, 0" :: Either String B.Instruction)
-
-    assertEqual "wrong label arity"
-        (eitherDecode "{\"op\": \"add\", \"type\": \"int\", \"dest\": \"x\", \"args\": [\"a\", \"b\"], \"labels\": [\"a\"]}")
-        (Left "Error in $: wrong arity for add: got 2, 1" :: Either String B.Instruction)
-
-    assertEqual "parse effect call"
-        (eitherDecode "{\"op\": \"call\", \"args\": [\"a\", \"b\"], \"funcs\": [\"a\"]}")
-        (Right $ B.EffectInstr B.Call ["a", "b"] ["a"] [])
-
-    assertEqual "parse value call"
-        (eitherDecode "{\"op\": \"call\", \"type\": \"bool\", \"dest\": \"z\", \"args\": [\"a\", \"b\"], \"funcs\": [\"a\"]}")
-        (Right $ B.ValueInstr B.Call B.Bool "z" ["a", "b"] ["a"] [])
-
-    assertEqual "parse invalid call"
-        (eitherDecode "{\"op\": \"call\", \"type\": \"bool\", \"dest\": \"z\", \"args\": [\"a\", \"b\"], \"funcs\": []}")
-        (Left "Error in $: call op must have exactly one entry in \"funcs\"" :: Either String B.Instruction)
-
-    assertEqual "parse jmp"
-        (eitherDecode "{\"op\": \"jmp\", \"labels\": [\"a\"]}")
-        (Right $ B.EffectInstr B.Jmp [] [] ["a"])
-
-    assertEqual "parse br"
-        (eitherDecode "{\"op\": \"br\", \"labels\": [\"a\", \"b\"], \"args\": [\"z\"]}")
-        (Right $ B.EffectInstr B.Br ["z"] [] ["a", "b"])
-
-    assertEqual "parse id"
-        (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))
-    case res of
-        (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 [
-        TestLabel "bril parser: type" testTypes,
-        TestLabel "bril parser: literal" testLiterals,
-        TestLabel "bril parser: instruction" testInstrs,
-        TestLabel "bril parser: parse files" testProgramFromFiles
-    ]
- 
-main :: IO ()
-main = do
-    result <- runTestTT tests
-
-    -- QC.quickCheck prop_InvariantBrilSerialization
-    if failures result > 0 then Exit.exitFailure else Exit.exitSuccess

turnt.toml

@@ -1 +0,0 @@
-command = "cabal run -v0 parse < {filename}"