diff --git a/ChangeLog.md b/ChangeLog.md index e4acac5..9311cdf 100755 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -2,4 +2,11 @@ ## 0.8 -- Added the frontend including the Lexer, Parser, Rewriter and Analyser. \ No newline at end of file +- Added the frontend including the Lexer, Parser, Rewriter and Analyser. + +## 0.9 + +- Added the intermediate representation language, Espresso, with its own lexer and parser. +- Added IR generation. +- Added Control Flow Graph and variable liveness analysis. +- Added x86_64 assembler code generation for the core of the language. \ No newline at end of file diff --git a/Latte.cabal b/Latte.cabal index dd1e139..6f7235e 100755 --- a/Latte.cabal +++ b/Latte.cabal @@ -4,10 +4,10 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 07a5b34f37f9b22ff69be83173953e37bf15964dd876bd3357dcc6e7e900a54a +-- hash: 028249ea0ebe143be13f7c63bd5fe2393ecd494c17d63a038438551cb0e68895 name: Latte -version: 0.8.0.0 +version: 0.9.0.0 description: Please see the README on GitHub at homepage: https://github.com/githubuser/Latte#readme bug-reports: https://github.com/githubuser/Latte/issues @@ -27,23 +27,54 @@ source-repository head library exposed-modules: + Compiler ErrM Error + Espresso.CodeGen.Generator + Espresso.CodeGen.GenM + Espresso.CodeGen.Labels + Espresso.CodeGen.Operators + Espresso.ControlFlow.CFG + Espresso.ControlFlow.Liveness + Espresso.ControlFlow.Phi + Espresso.Interpreter + Espresso.Syntax.Abs + Espresso.Syntax.Lexer + Espresso.Syntax.Parser + Espresso.Syntax.Printer + Espresso.Types + Espresso.Utilities Identifiers + LatteIO SemanticAnalysis.Analyser SemanticAnalysis.Class SemanticAnalysis.ControlFlow - SemanticAnalysis.Toplevel + SemanticAnalysis.TopLevel Syntax.Abs Syntax.Code Syntax.Lexer Syntax.Parser Syntax.Printer Syntax.Rewriter + Utilities + X86_64.CodeGen.Consts + X86_64.CodeGen.Emit + X86_64.CodeGen.Epilogue + X86_64.CodeGen.Generator + X86_64.CodeGen.GenM + X86_64.CodeGen.Module + X86_64.CodeGen.Prologue + X86_64.CodeGen.RegisterAllocation + X86_64.CodeGen.Stack + X86_64.Loc + X86_64.Optimisation.Peephole + X86_64.Registers + X86_64.Size other-modules: Paths_Latte hs-source-dirs: src + ghc-options: -Wall -fno-warn-type-defaults build-depends: array >=0.5 && <0.6 , base >=4.7 && <5 @@ -53,15 +84,59 @@ library , hspec >=2.7 && <2.8 , mtl >=2.2 && <2.3 , process >=1.6 && <1.7 + , regex >=1.1 && <1.2 default-language: Haskell2010 -executable latc - main-is: Main.hs +executable espi + main-is: Espi.hs other-modules: + Latc_x86_64 Paths_Latte hs-source-dirs: app - ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + ghc-options: -threaded -rtsopts -with-rtsopts=-N -main-is Espi -Wall + build-depends: + Latte + , array >=0.5 && <0.6 + , base >=4.7 && <5 + , containers >=0.6 && <0.7 + , directory >=1.3 && <1.4 + , filepath >=1.4 && <1.5 + , hspec >=2.7 && <2.8 + , mtl >=2.2 && <2.3 + , process >=1.6 && <1.7 + , regex >=1.1 && <1.2 + default-language: Haskell2010 + +executable latc_x86_64 + main-is: Latc_x86_64.hs + other-modules: + Espi + Paths_Latte + hs-source-dirs: + app + ghc-options: -threaded -rtsopts -with-rtsopts=-N -main-is Latc_x86_64 -Wall + build-depends: + Latte + , array >=0.5 && <0.6 + , base >=4.7 && <5 + , containers >=0.6 && <0.7 + , directory >=1.3 && <1.4 + , filepath >=1.4 && <1.5 + , hspec >=2.7 && <2.8 + , mtl >=2.2 && <2.3 + , process >=1.6 && <1.7 + , regex >=1.1 && <1.2 + default-language: Haskell2010 + +test-suite Latte-exec-test + type: exitcode-stdio-1.0 + main-is: X86_64Spec.hs + other-modules: + Paths_Latte + hs-source-dirs: + test/Exec + ghc-options: -threaded -rtsopts -with-rtsopts=-N -main-is X86_64Spec -Wall build-depends: Latte , array >=0.5 && <0.6 @@ -72,16 +147,18 @@ executable latc , hspec >=2.7 && <2.8 , mtl >=2.2 && <2.3 , process >=1.6 && <1.7 + , regex >=1.1 && <1.2 default-language: Haskell2010 test-suite Latte-test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: - SemanticAnalysis.AcceptanceSpec + Compiler.CompilerSpec + Espresso.InterpreterSpec Paths_Latte hs-source-dirs: - test + test/Discovery ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall build-depends: Latte @@ -93,4 +170,5 @@ test-suite Latte-test , hspec >=2.7 && <2.8 , mtl >=2.2 && <2.3 , process >=1.6 && <1.7 + , regex >=1.1 && <1.2 default-language: Haskell2010 diff --git a/Makefile b/Makefile index b573299..accde49 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,9 @@ all: + gcc -O2 -c ./lib/runtime.c -o ./lib/runtime.o stack build --copy-bins clean: stack clean - rm -f latc \ No newline at end of file + rm -f ./lib/runtime.o + rm -f latc_x86_64 + rm -f espi \ No newline at end of file diff --git a/README.md b/README.md index 0f873b3..c72c79e 100755 --- a/README.md +++ b/README.md @@ -1,23 +1,126 @@ -# Latte v0.8 +# Latte v0.9 Compiler of the [Latte programming language](https://www.mimuw.edu.pl/~ben/Zajecia/Mrj2020/Latte/description.html) written in Haskell. ## Compiling the project -Use `stack build` to compile the project. Use the `latc` executable to compile `.lat` source files. +Use `stack build` to compile the project. Used version of GHC is 8.8.4 (LTS 16.22). For the breakdown of used packages consult `package.yaml`. +## Running the project + +Use the `latc_x86_64` executable to compile `.lat` source files. Additionally, `espi` executable containing an IR interpreter is generated - this is not intended for end users but rather as a development tool. + +### Flags + +- `-v` - enable verbose mode +- `-g` - generate intermediate steps + +When running on a file `

.lat`, where `

= ` is some path: + +1. when the flag `-g` is not specified, two files are created: `

.s` containing generated x86_64 assembly and an executable `

`; + +2. when `-g` is specified the following intermediate representations are generated additionally: + +- `

.esp`, `

.cfg` - Espresso intermediate code and text representation of its Control Flow Graph. +- `

.1.opt.esp`, `

.1.opt.cfg` - Optimised Espresso code and its CFG. +- `

.2.phi.esp`, `

.2.phi.cfg` - Optimised Espresso code with unfolded phony `phi` function usage and its CFG. +- `

.3.liv.esp`, `

.3.liv.cfg` - Same code as above but with liveness annotations in form of comments on every instruction and the CFG with liveness annotations for the begin and end of each node. +- `

.noopt.s` - Generated assembly before peephole optimisation phase. + ## Testing the project -Use `stack test` to run all included tests. The `lattest` directory contains all tests provided on +Use `stack test` to run all included tests. The `lattests` directory contains all tests provided on the [assignment page](https://www.mimuw.edu.pl/~ben/Zajecia/Mrj2020/latte-en.html) (these are unchanged) -and additional custom tests. +and additional custom tests. The `esptests` directory contains a handful of tests for the IR language Espresso. + +There are two test suites, `Latte-test` and `Latte-test-exec`. + +- `Latte-test` tests parsing, semantic analysis and IR code generation using an interpreter for the generated IR. +These are quick to run but do not test anything related to x86_64 assembly generation. + +- `Latte-test-exec` tests the entire compiler by running the executable on all valid tests, asserting they compile and then running the generated executables. It creates a temporary work directory in `lattests` that gets cleaned up after the test. ## Features - Full lexer and parser for Latte with objects, virtual methods and arrays. - Full semantic analysis with type checks and reachability analysis. +- Internal IR language - Espresso - with a separate lexer/parser and a small interpreter. +- Compilation to Espresso and generation of additional annotations - Control Flow Graph and variable liveness analysis. +- x86_64 assembly code generation with register handling done locally via register/variable descriptions. +- Peephole optimisations of the generated assembly to fix common trivial inefficiencies. + +## Unimplemented extensions + +Objects, arrays and virtual methods are implemented in the static analysis phase, but not in Espresso or x86_64 codegen. These will be implemented in the next version of the compiler. + +## Known issues + +1. The way strings work is currently inconsistent with how objects will work in general. For example, the compiler assumes a default value for a string is `null`, but there is no way to express a string `null` literal in Latte code (the grammar does not allow `(string) null`). One can achieve it by declaring an uninitialised string variable, as the default value for such variables is `null`. It is planned to change in the final version where `strings` will most likely be defined as actual object types with special handling for string literals. + +2. The generated code is wasteful when it comes to string literals. For example the code: + +``` +string x = "foo"; +string y = "bar"; +string z = x + y; +printString(z); +``` + +causes three string allocations for each of the variables `x`, `y`, `z`. This is planned to change in the final version where constant propagation will be implemented. + +3. There is a slight issue with string allocation. Codegen for a string literal: +``` +// Espresso code +%v_0 := "literal"; +call void foo(string& %v_0); +``` + +looks like this: + +```as +__const_1: + .string "literal" + +... + +lea __const_1(%rip), %r10 +movq %r10, %rdi # moving %v_0 +movl $7, %esi +movq %r10, %r12 # moving %v_0 <--- +call lat_new_string +movq %rax, %rdi # moving %v_0 +call __cl_TopLevel.foo +``` +the indicated `mov` instruction is redundant. The compiler sees that %v_0 is alive after the `IStr` instruction (namely used in the call to `foo`) so it tries to preserve it through the call to `lat_new_string` (since `%r10` is caller-saved). This is wasteful, since the value inside `%r10` at that point is the address of the string literal constant, but the logical value of `%v_0` is the result of the call to `lat_new_string`. Fixing this is nontrivial, so it will be done if time permits for the next version. + +4. Conditional jumps where locals have to be persisted between blocks result in inefficient codegen. For example, the way a `<=` conditional is generated in Espresso is: + +``` +%v_cond := %v_0 <= %v_1; +jump if %v_cond then .L_then else .L_else; +``` +Assume only %v_0 is alive at the end of this block. These two instructions are independently translated. First, the boolean value is created (assume `%v_0` in `%eax` and `%v_1` in `%edx`): +``` +cmpl %eax, %edx +setle %dl +``` +Then the conditional jump: +``` +testb %dl, %dl +movl %eax, 8(%rbp) # save %v_0 on the stack +jz .L_else +jmp .L_then +``` +But clearly this can be more efficiently realised with: +``` +cmpl %eax, %edx +movl %eax, 8(%rbp) # save %v_0 on the stack +jg .L_else +jmp .L_then +``` +Some of these are fixed by peephole optimisations, but that approach fails when there are the save-on-stack `mov`s in between the `set`-`test`-`jz` sequence. This is non-trivial to fix, so it will be done in the next version of the compiler. ## Custom extensions @@ -26,6 +129,10 @@ their type to the compile-time type of the initialiser expression. It cannot be used in declarations without an initialiser. The motivation behind this is mainly so that `for` loop rewrite works correctly, but it is also useful as a language feature so it is exposed to the user. +## Runtime + +The runtime is small and contains the basic library functions `readInt`, `readString`, `printInt`, `printString` and `error` as well as internal core functions for string allocation and manipulation. It is written in C and included in `lib/runtime.c`. + ## Compilation process After lexing and parsing that is automated using BNFC the compilation proceeds in phases. @@ -68,16 +175,16 @@ Expressions that are computable at compile-time are rewritten during this phase This includes simple arithmetic expressions and relational operations that contain only constants as their atomic components. -### Phase two - toplevel metadata +### Phase two - top level metadata -The `SemanticAnalysis.Toplevel` module parses definitions of classes, methods and toplevel functions +The `SemanticAnalysis.TopLevel` module parses definitions of classes, methods and top level functions and converts them to metadata containing field and method tables of all classes and their inheritance hierarchies. The important jobs in this phase are: - resolving inheritance hierarchies and asserting they contain no cycles; - creating class method tables, taking method overriding into account; - analysing field, method and formal parameter names asserting there are no duplicates; -- wrapping all toplevel functions into the special `~cl_toplevel` class. +- wrapping all top level functions into the special `~cl_TopLevel` class. ### Phase three - sematic analysis @@ -104,12 +211,41 @@ The control flow rules currently concern themselves with function return stateme to have a `return` statement on each possible execution path. The Analyser tracks reachability of statements and combines branch reachability of `if` and `while` statements. An important optimisation is that if a condition of a conditional statement is trivially true (or false) the branch is considered to be always (or never) entered. Trivially true or false -means that it is either a true or false literal, but since this phase is performed after the Rewriter all constant boolean expressions -are already collapsed to a single literal. +means that it is either a true or false literal, but since this phase is performed after the Rewriter all constant boolean expressions are already collapsed to a single literal. + +### Phase four - Espresso codegen + +The modules in `Espresso.CodeGen` process the Latte code with annotations from semantic analysis and generates the intermediate representation in a quadruple code language Espresso. The grammar for the language can be found in `src/Espresso/Syntax/Espresso.cf`. + +A program in Espresso starts with a `.metadata` table that contains type information about all classes and functions defined in the Latte code, plus runtime functions. Then a sequence of `.method` definitions follows as a sequence of quadruples including labels, jumps and operations. For a detailed scription of the instruction set refer to the grammar file. + +The instruction set includes the phony function `phi` akin to LLVM's `phi`. It sets a value based on the label from which a jump was performed. The code generated by `Espresso.CodeGen` _is not_ in SSA form, but it uses `phi` for setting the return value of a method. + +Code generation ensures that there is no fall-through between labels, each basic block ends with a conditional or unconditional jump. Therefore, the blocks can be reordered arbitrarily. + +### Phase five - Espresso analysis + +The generated code needs additional annotations, mainly liveness information for all values and instructions. These are done by modules in `Espresso.ControlFlow`. First the code is divided into basic blocks and a Control Flow Graph is constructed. Then the phony function usage is unfolded, since it is untranslateable into assembly directly. Then liveness analysis is performed on the new CFG graph. + +This phase will also contain optimisation steps in the future version of the compiler. + +### Phase six - x86_64 assembly codegen + +Assembly generations proceeds by simulating the state of the target machine with register/value descriptions. Locals are persisted on the stack between basic blocks, while registers are greedily allocated within the block based on variable next use data computed in the previous phase. This phase leaves a lot of garbage code, like empty `addq $0, %rsp` instructions, but these are easily cleared in the next phase. + +### Phase seven - peephole optimisations + +The result code is analysed by matching a number of patterns of common unoptimal code and fixing them locally. The process is repeated until a fixpoint is reached, i.e. no more optimisations are applicable. + +### Phase eight - assembly and linking + +As the final phase, `gcc` is used to compile the generated assembly and link it with the runtime. ## Grammar conflicts -The grammar contains 3 shift/reduce conflicts. +### Latte + +The Latte grammar contains 3 shift/reduce conflicts. The first conflict is the standard issue with single-statement `if` statements that makes statements of the following form ambiguous: ``` @@ -125,9 +261,16 @@ and an instantiation of a type with immediate indexing into it. The conflict is The third conflict is between a parenthesised single expression and a casted `null` expression, which is correctly resolved in favour of the `null` expression. +### Espresso + +There is 1 shift/reduce conflict between `VNegInt` and `UnOpNeg`. `VNegInt` is a negative integer required to allow passing literal negative values as arguments without creating values for them, which would be tedious. Therefore the expression: +``` +%v_0 := -42; +``` +is ambiguous between `IUnOp` on `42` or `ISet` on `-42`. This is inconsequential and can be resolved either way without changing semantics. + ## Sources -A few parts of the code were directly copied or heavily inspired by my earlier work on the Harper language (https://github.com/V0ldek/Harper), -most notably the control flow analysis monoid based approach. +A few parts of the code were directly copied or heavily inspired by my earlier work on the Harper language (https://github.com/V0ldek/Harper), most notably the control flow analysis monoid based approach. The grammar rules for `null` literals are a slightly modified version of rules proposed by Krzysztof Małysa. \ No newline at end of file diff --git a/app/Espi.hs b/app/Espi.hs new file mode 100644 index 0000000..459280a --- /dev/null +++ b/app/Espi.hs @@ -0,0 +1,91 @@ +module Espi where + +import Control.Monad (when) +import System.Environment (getArgs) +import System.Exit (exitFailure) +import System.IO (hPutStr, hPutStrLn, stderr) + +import ErrM (toEither) +import Espresso.ControlFlow.CFG +import Espresso.Interpreter (interpret) +import Espresso.Syntax.Abs +import Espresso.Syntax.Lexer (Token) +import Espresso.Syntax.Parser (myLexer, pProgram) +import Espresso.Syntax.Printer (Print, printTree) + +type Err = Either String +type ParseResult = (Program (Maybe Pos)) + +type ParseFun a = [Token] -> Err a + +type Verbosity = Int + +putStrV :: Verbosity -> String -> IO () +putStrV v s = when (v > 1) $ putStrLn s + +putStrErrV :: Verbosity -> String -> IO () +putStrErrV v s = when (v > 1) $ hPutStrLn stderr s + +putStrErr :: String -> IO () +putStrErr = hPutStr stderr + +putStrErrLn :: String -> IO () +putStrErrLn = hPutStrLn stderr + +runFile :: Verbosity -> ParseFun ParseResult -> FilePath -> IO () +runFile v p f = readFile f >>= run v p + +run :: Verbosity -> ParseFun ParseResult -> String -> IO () +run v p s = case p ts of + Left err -> do + putStrErrLn "ERROR" + putStrErrV v "Tokens:" + putStrErrV v $ show ts + putStrErrLn err + exitFailure + Right tree -> do + let tree'@(Program a meta mthds) = unwrapPos tree + putStrErrLn "OK" + showTree v tree' + let cfgs = zip (map cfg mthds) mthds + showCfgs v cfgs + let mthds' = map (\(g, Mthd a' r i ps _) -> Mthd a' r i ps (linearize g)) cfgs + tree'' = Program a meta mthds' + showTree v tree'' + interpret tree'' + where + ts = myLexer s + +showTree :: (Show a, Print a) => Int -> a -> IO () +showTree v tree + = do + putStrV v $ "\n[Abstract Syntax]\n\n" ++ show tree + putStrV v $ "\n[Linearized tree]\n\n" ++ printTree tree + +showCfgs :: Int -> [(CFG a, Method a)] -> IO () +showCfgs v = mapM_ showCfg + where + showCfg (g, Mthd _ _ (QIdent _ (SymIdent i1) (SymIdent i2)) _ _) = do + putStrV v ("CFG for " ++ i1 ++ "." ++ i2 ++ ":") + putStrV v $ show g + +usage :: IO () +usage = do + putStrLn $ + unlines + [ "Espresso interpreter.", + "Usage: Call with one of the following argument combinations:", + " --help Display this help message.", + " (file) Interpret content of the file.", + " -v (file) Verbose mode. Interpret content of the file verbosely." + ] + exitFailure + +main :: IO () +main = do + args <- getArgs + case args of + ["--help"] -> usage + "-v" : [f] -> runFile 2 (toEither . pProgram) f + [f] -> runFile 0 (toEither . pProgram) f + _ -> usage diff --git a/app/Latc_x86_64.hs b/app/Latc_x86_64.hs new file mode 100755 index 0000000..8cf7072 --- /dev/null +++ b/app/Latc_x86_64.hs @@ -0,0 +1,53 @@ +module Latc_x86_64 where + +import Compiler (Options (Opt), Verbosity (..), + assemblyFile, run) +import Control.Monad +import System.Environment +import System.Exit +import System.FilePath +import System.Process + +usage :: IO () +usage = do + putStrLn $ + unlines + [ "Latte compiler.", + "Usage: Call with one of the following argument combinations:", + " --help Display this help message.", + " (file) Compile content of the file.", + " -v (file) Verbose mode. Compile content of the file verbosely." + ] + exitFailure + +main :: IO () +main = do + args <- getArgs + if args == ["--help"] then usage + else do + let verbosity = if "-v" `elem` args then Verbose else Quiet + generateIntermediate = "-g" `elem` args + inputFile = filter (\a -> head a /= '-') args + case inputFile of + [f] -> do + run (Opt f generateIntermediate verbosity) + let fileName = dropExtension $ takeFileName f + directory = takeDirectory f + outputPath = directory fileName + asmPath = assemblyFile directory fileName + when (verbosity == Verbose) $ putStrLn "Compiling with gcc..." + exitCode <- runCommand (gccCommand runtimePath asmPath outputPath) >>= waitForProcess + unless (exitCode == ExitSuccess) (failGcc exitCode) + when (verbosity == Verbose) $ putStrLn "Success." + exitSuccess + _ -> usage + +gccCommand :: FilePath -> FilePath -> FilePath -> String +gccCommand libPath assemblyPath outputPath = + "gcc " ++ show libPath ++ " " ++ assemblyPath ++ " -o " ++ outputPath + +runtimePath :: FilePath +runtimePath = "." "lib" "runtime.o" + +failGcc :: ExitCode -> IO () +failGcc c = putStr "GCC failed with exit code " >> print c >> exitFailure diff --git a/app/Main.hs b/app/Main.hs deleted file mode 100755 index f8f7327..0000000 --- a/app/Main.hs +++ /dev/null @@ -1,104 +0,0 @@ -module Main where - -import Control.Monad (unless, when) -import System.Environment (getArgs) -import System.Exit (exitFailure, exitSuccess) -import System.IO (hPutStr, hPutStrLn, stderr) - -import ErrM (toEither) -import SemanticAnalysis.Analyser (analyse) -import SemanticAnalysis.Toplevel (Metadata, programMetadata) -import Syntax.Abs (Pos, Program, unwrapPos) -import Syntax.Lexer (Token) -import Syntax.Parser (myLexer, pProgram) -import Syntax.Printer (Print, printTree) -import Syntax.Rewriter (rewrite) - -type Err = Either String -type ParseResult = (Program (Maybe Pos)) - -type ParseFun a = [Token] -> Err a - -type Verbosity = Int - -putStrV :: Verbosity -> String -> IO () -putStrV v s = when (v > 1) $ putStrLn s - -putStrErrV :: Verbosity -> String -> IO () -putStrErrV v s = when (v > 1) $ hPutStrLn stderr s - -putStrErr :: String -> IO () -putStrErr = hPutStr stderr - -putStrErrLn :: String -> IO () -putStrErrLn = hPutStrLn stderr - -unlessM :: Monad m => m Bool -> m () -> m () -unlessM p a = do - b <- p - unless b a - -runFile :: Verbosity -> ParseFun ParseResult -> FilePath -> IO () -runFile v p f = readFile f >>= run v p - -run :: Verbosity -> ParseFun ParseResult -> String -> IO () -run v p s = case p ts of - Left err -> do - putStrErrLn "ERROR" - putStrErrV v "Tokens:" - putStrErrV v $ show ts - putStrErrLn err - exitFailure - Right tree -> do - let tree' = unwrapPos tree - putStrErrLn "OK" - showTree v tree' - let rewritten = rewrite tree' - putStrErrV v "Rewritten:" - showTree v rewritten - () <- case programMetadata rewritten of - Left err -> do - putStrErrLn "ERROR" - putStrErrLn err - exitFailure - Right meta -> do - showMetadata v meta - case analyse meta of - Right _ -> exitSuccess - Left err -> do - putStrErrLn "ERROR" - putStrErrLn err - exitFailure - exitSuccess - where - ts = myLexer s - -showMetadata :: Verbosity -> Metadata a -> IO () -showMetadata v meta = putStrV v $ show meta - -showTree :: (Show a, Print a) => Int -> a -> IO () -showTree v tree - = do - putStrV v $ "\n[Abstract Syntax]\n\n" ++ show tree - putStrV v $ "\n[Linearized tree]\n\n" ++ printTree tree - -usage :: IO () -usage = do - putStrLn $ - unlines - [ "Latte compiler.", - "Usage: Call with one of the following argument combinations:", - " --help Display this help message.", - " (file) Compile content of the file.", - " -v (file) Verbose mode. Compile content of the file verbosely." - ] - exitFailure - -main :: IO () -main = do - args <- getArgs - case args of - ["--help"] -> usage - "-v" : [f] -> runFile 2 (toEither . pProgram) f - [f] -> runFile 0 (toEither . pProgram) f - _ -> usage diff --git a/lib/runtime.c b/lib/runtime.c new file mode 100644 index 0000000..ad3644b --- /dev/null +++ b/lib/runtime.c @@ -0,0 +1,124 @@ +#include +#include +#include +#include +#include +#include + +// Helper used to conditionally concatenate __VA_ARGS__ using a comma. +#define VA_FWD(...) , ##__VA_ARGS__ + +#define TERMINATE(fmt, ...) \ + fprintf(stdout, fmt VA_FWD(__VA_ARGS__)), \ + exit(1) + +// Prints info about a system error (set in errno) and terminates the process. +#define SYSERR(fmt, ...) \ + TERMINATE("ERROR: " fmt " (%d, %s)\n" VA_FWD(__VA_ARGS__), errno, strerror(errno)) + +// Checks if a call to the passed system function resulted in value `val`, and terminates with SYSERR if yes. +#define CHK_SYSERR_VAL(x, val, name) \ + if ((x) == (val)) \ + { \ + SYSERR("Error in: %s, file: %s, function: %s, line: %d: ", (name), __FILE__, __PRETTY_FUNCTION__, __LINE__); \ + } + +// Checks if a call to the passed system function resulted in value `val`, and terminates with SYSERR if no. +#define CHK_SYSERR_NVAL(x, val, name) \ + if ((x) != (val)) \ + { \ + SYSERR("Error in: %s, file: %s, function: %s, line: %d: ", (name), __FILE__, __PRETTY_FUNCTION__, __LINE__); \ + } + +// Default version of CHK_SYSERR_VAL that tests against a -1 value. +#define CHK_SYSERR(x, name) CHK_SYSERR_VAL(x, -1, name) + +#define NOTNULL(x) \ + if ((x) == NULL) \ + { \ + TERMINATE("internal error. null reference.\n"); \ + } + +typedef struct lat_string +{ + size_t length; + const char *contents; +} lat_string; + +void lat_print_int(int32_t x) +{ + CHK_SYSERR(printf("%d\n", x), "printf") +} + +void lat_print_string(const lat_string *str) +{ + CHK_SYSERR(printf("%s", str->contents), "printf"); + CHK_SYSERR(printf("\n"), "printf") +} + +int32_t lat_read_int() +{ + char *line = NULL; + size_t len = 0; + CHK_SYSERR(getline(&line, &len, stdin), "getline"); + + return strtol(line, NULL, 10); +} + +const lat_string *lat_new_string(const char *str, size_t len) +{ + NOTNULL(str) + + lat_string *result = malloc(sizeof(lat_string)); + CHK_SYSERR_VAL(result, NULL, "malloc") + result->length = len; + result->contents = str; + + return result; +} + +const lat_string *lat_read_string() +{ + char *line = NULL; + size_t line_size; + ssize_t len = getline(&line, &line_size, stdin); + + CHK_SYSERR(len, "getline"); + + if (line[len - 1] == '\n') + { + line[len - 1] = '\0'; + len -= 1; + } + + return lat_new_string(line, len); +} + +void lat_error() +{ + TERMINATE("runtime error\n"); +} + +void lat_nullchk(const void *ptr) +{ + if (ptr == NULL) + { + TERMINATE("runtime error. attempt to dereference a null.\n"); + } +} + +const lat_string *lat_cat_strings(const lat_string *str1, const lat_string *str2) +{ + lat_nullchk(str1); + lat_nullchk(str2); + + size_t new_length = str1->length + str2->length; + char *result = malloc((new_length + 1) * sizeof(char)); + CHK_SYSERR_VAL(result, NULL, "malloc") + + strcpy(result, str1->contents); + strcat(result, str2->contents); + result[new_length] = '\0'; + + return lat_new_string(result, new_length); +} \ No newline at end of file diff --git a/package.yaml b/package.yaml index 0daf56a..2159300 100755 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: Latte -version: 0.8.0.0 +version: 0.9.0.0 github: "githubuser/Latte" license: MIT author: "Mateusz Gienieczko" @@ -28,18 +28,34 @@ dependencies: - filepath >= 1.4 && < 1.5 - process >= 1.6 && < 1.7 - hspec >= 2.7 && < 2.8 +- regex >= 1.1 && < 1.2 library: source-dirs: src + ghc-options: + - -Wall + - -fno-warn-type-defaults executables: - latc: - main: Main.hs + latc_x86_64: + main: Latc_x86_64.hs source-dirs: app ghc-options: - -threaded - -rtsopts - -with-rtsopts=-N + - -main-is Latc_x86_64 + - -Wall + dependencies: + - Latte + espi: + main: Espi.hs + source-dirs: app + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + - -main-is Espi - -Wall dependencies: - Latte @@ -47,7 +63,7 @@ executables: tests: Latte-test: main: Spec.hs - source-dirs: test + source-dirs: test/Discovery ghc-options: - -threaded - -rtsopts @@ -55,3 +71,14 @@ tests: - -Wall dependencies: - Latte + Latte-exec-test: + main: X86_64Spec.hs + source-dirs: test/Exec + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + - -main-is X86_64Spec + - -Wall + dependencies: + - Latte \ No newline at end of file diff --git a/src/Compiler.hs b/src/Compiler.hs new file mode 100644 index 0000000..75424e5 --- /dev/null +++ b/src/Compiler.hs @@ -0,0 +1,200 @@ +module Compiler where + +import Control.Monad (when) +import Data.Bifunctor (Bifunctor (first)) +import qualified Data.Map as Map +import ErrM (toEither) +import Espresso.CodeGen.Generator (generateEspresso) +import Espresso.ControlFlow.CFG +import Espresso.ControlFlow.Liveness (Liveness, analyseLiveness, + emptyLiveness) +import Espresso.ControlFlow.Phi (unfoldPhi) +import qualified Espresso.Syntax.Abs as Esp +import Espresso.Syntax.Printer as PrintEsp (Print, printTree, + printTreeWithInstrComments) +import Identifiers (ToString (toStr)) +import LatteIO +import SemanticAnalysis.Analyser (SemData, analyse) +import SemanticAnalysis.TopLevel (Metadata, programMetadata) +import Syntax.Abs as Latte (Pos, Program, + unwrapPos) +import Syntax.Lexer (Token) +import Syntax.Parser (myLexer, pProgram) +import Syntax.Printer as PrintLatte (Print, printTree) +import Syntax.Rewriter (rewrite) +import System.FilePath (dropExtension, takeDirectory, + takeFileName, (<.>), ()) +import Utilities (unlessM) +import X86_64.CodeGen.Generator (generate) +import qualified X86_64.Optimisation.Peephole as Peephole + +data Verbosity = Quiet | Verbose deriving (Eq, Ord, Show) + +data Options = Opt { + inputFile :: String, + generateIntermediate :: Bool, + verbosity :: Verbosity +} + +type Err = Either String +type ParseResult = (Program (Maybe Pos)) +type ParseFun a = [Token] -> Err a + +printStringV :: (Monad m, LatteIO m) => Verbosity -> String -> m () +printStringV v s = when (v == Verbose) $ printString s + +printErrorStringV :: (Monad m, LatteIO m) => Verbosity -> String -> m () +printErrorStringV v s = when (v == Verbose) $ printErrorString s + +run :: (Monad m, LatteIO m) => Options -> m () +run opt = do + let f = inputFile opt + v = verbosity opt + fileName = dropExtension $ takeFileName f + directory = takeDirectory f + unlessM (doesDirectoryExist directory) (failNoDirectory directory) + unlessM (doesFileExist f) (failNoFile f) + latSrc <- LatteIO.readFile $ inputFile opt + printStringV v "Analysing Latte..." + latte <- analysePhase opt latSrc + printStringV v "Brewing Esp..." + let espresso@(Esp.Program a meta mthds) = generateEspresso latte + genStep opt (espressoFile directory fileName) (PrintEsp.printTree espresso) + printStringV v "Building CFGs..." + let cfgs = zip (map cfg mthds) mthds + espressoOpt = PrintEsp.printTree $ Esp.Program a meta (cfgsToMthds () cfgs) + genStep opt (espressoCfgFile directory fileName) (showCfgs cfgs) + genStep opt (espressoOptFile directory fileName) espressoOpt + printStringV v "Unfolding phis..." + let cfgsWithUnfoldedPhi = zip (map unfoldPhi cfgs) mthds + espressoWithUnfoldedPhi = PrintEsp.printTree $ Esp.Program () meta (cfgsToMthds () cfgsWithUnfoldedPhi) + genStep opt (espressoCfgWithUnfoldedPhiFile directory fileName) (showCfgs cfgsWithUnfoldedPhi) + genStep opt (espressoWithUnfoldedPhiFile directory fileName) espressoWithUnfoldedPhi + printStringV v "Analysing liveness..." + let cfgsWithLiveness = map (first analyseLiveness) cfgsWithUnfoldedPhi + espressoWithLiveness = showEspWithLiveness meta (cfgsToMthds emptyLiveness cfgsWithLiveness) + genStep opt (espressoCfgWithLivenessFile directory fileName) (showCfgsWithLiveness cfgsWithLiveness) + genStep opt (espressoWithLivenessFile directory fileName) espressoWithLiveness + printStringV v "Generating x86_64 assembly..." + let assembly = generate cfgsWithLiveness + genOutput opt (unoptAssemblyFile directory fileName) assembly + let optAssembly = unlines $ Peephole.optimise (lines assembly) + genOutput opt (assemblyFile directory fileName) optAssembly + +analysePhase :: (Monad m, LatteIO m) => Options -> String -> m (Metadata SemData) +analysePhase opt latSrc = do + let v = verbosity opt + tokens = myLexer latSrc + tree <- case toEither $ pProgram tokens of + Left err -> do + printErrorString "ERROR" + printErrorStringV v "Tokens:" + printErrorStringV v $ show tokens + printErrorString err + exitFailure + Right tree -> return tree + let tree' = unwrapPos tree + rewritten = rewrite tree' + meta <- case programMetadata rewritten of + Left err -> do + printErrorString "ERROR" + printErrorStringV v "Rewritten:" + showTree v rewritten + printErrorString err + exitFailure + Right meta -> return meta + meta' <- case analyse meta of + Left err -> do + printErrorString "ERROR" + printErrorStringV v "Metadata:" + showMetadata v meta + printErrorString err + exitFailure + Right meta' -> return meta' + printErrorString "OK" + return meta' + +genStep :: (Monad m, LatteIO m) => Options -> FilePath -> String -> m () +genStep opt fp contents = do + let v = verbosity opt + g = generateIntermediate opt + if not g then return () + else do + printStringV v $ "Writing " ++ show fp ++ "..." + LatteIO.writeFile fp contents + +genOutput :: (Monad m, LatteIO m) => Options -> FilePath -> String -> m () +genOutput opt fp contents = do + let v = verbosity opt + printStringV v $ "Writing " ++ show fp ++ "..." + LatteIO.writeFile fp contents + +failNoDirectory :: (Monad m, LatteIO m) => FilePath -> m () +failNoDirectory d = printErrorString ("Directory not found: " ++ show d) >> exitFailure + +failNoFile :: (Monad m, LatteIO m) => FilePath -> m () +failNoFile f = printErrorString ("File not found: " ++ show f) >> exitFailure + +showMetadata :: (Monad m, LatteIO m) => Verbosity -> Metadata a -> m () +showMetadata v meta = printStringV v $ show meta + +showTree :: (Monad m, LatteIO m, Show a, PrintLatte.Print a) => Verbosity -> a -> m () +showTree v tree + = do + printStringV v $ "\n[Abstract Syntax]\n\n" ++ show tree + printStringV v $ "\n[Linearized tree]\n\n" ++ PrintLatte.printTree tree + +showEspTree :: (Monad m, LatteIO m, Show a, PrintEsp.Print a) => Verbosity -> a -> m () +showEspTree v tree + = do + printStringV v $ "\n[Abstract Syntax]\n\n" ++ show tree + printStringV v $ "\n[Linearized tree]\n\n" ++ PrintEsp.printTree tree + +showCfgs :: [(CFG a, Esp.Method a)] -> String +showCfgs cfgs = unlines $ map showCfg cfgs + where + showCfg (g, Esp.Mthd _ _ (Esp.QIdent _ (Esp.SymIdent i1) (Esp.SymIdent i2)) _ _) = + "CFG for " ++ i1 ++ "." ++ i2 ++ ":\n" ++ show g + +cfgsToMthds :: a -> [(CFG a, Esp.Method b)] -> [Esp.Method a] +cfgsToMthds default_ = map (\(g, Esp.Mthd _ r i ps _) -> + Esp.Mthd default_ (default_ <$ r) (default_ <$ i) (map (default_ <$) ps) (linearize g)) + +showCfgsWithLiveness :: [(CFG Liveness, Esp.Method a)] -> String +showCfgsWithLiveness cfgs = unlines $ map showCfg cfgs + where + showCfg (CFG g, Esp.Mthd _ _ (Esp.QIdent _ (Esp.SymIdent i1) (Esp.SymIdent i2)) _ _) = + "CFG for " ++ i1 ++ "." ++ i2 ++ ":\n" ++ show (CFG g) ++ concatMap showLiveness (Map.elems g) + showLiveness node = + "Liveness at start of " ++ toStr (nodeLabel node) ++ ": " ++ show (nodeHead node) ++ "\n" ++ + "Liveness at end of " ++ toStr (nodeLabel node) ++ ": " ++ show (nodeTail node) ++ "\n" + +showEspWithLiveness :: Esp.Metadata a -> [Esp.Method Liveness] -> String +showEspWithLiveness meta mthds = PrintEsp.printTreeWithInstrComments (Esp.Program emptyLiveness (emptyLiveness <$ meta) mthds) + +assemblyFile :: FilePath -> FilePath -> FilePath +assemblyFile dir file = dir file <.> "s" + +unoptAssemblyFile :: FilePath -> FilePath -> FilePath +unoptAssemblyFile dir file = dir file <.> "noopt" <.> "s" + +espressoFile :: FilePath -> FilePath -> FilePath +espressoFile dir file = dir file <.> "esp" + +espressoCfgFile :: FilePath -> FilePath -> FilePath +espressoCfgFile dir file = dir file <.> "cfg" + +espressoOptFile :: FilePath -> FilePath -> FilePath +espressoOptFile dir file = dir file <.> "1" <.> "opt" <.> "esp" + +espressoCfgWithUnfoldedPhiFile :: FilePath -> FilePath -> FilePath +espressoCfgWithUnfoldedPhiFile dir file = dir file <.> "2" <.> "phi" <.> "cfg" + +espressoWithUnfoldedPhiFile :: FilePath -> FilePath -> FilePath +espressoWithUnfoldedPhiFile dir file = dir file <.> "2" <.> "phi" <.> "esp" + +espressoCfgWithLivenessFile :: FilePath -> FilePath -> FilePath +espressoCfgWithLivenessFile dir file = dir file <.> "3" <.> "liv" <.> "cfg" + +espressoWithLivenessFile :: FilePath -> FilePath -> FilePath +espressoWithLivenessFile dir file = dir file <.> "3" <.> "liv" <.> "esp" diff --git a/src/Error.hs b/src/Error.hs index 6bc5a36..72010c6 100644 --- a/src/Error.hs +++ b/src/Error.hs @@ -28,6 +28,6 @@ errorCtxMsg :: (Positioned a, WithContext a, Unwrappable f) => String -> f a -> errorCtxMsg msg ctx = errorMsg msg (unwrap ctx) (getCtx $ unwrap ctx) lineInfo :: Maybe Pos -> String -lineInfo pos = case pos of +lineInfo a = case a of Nothing -> "" Just (ln, ch) -> "Line " ++ show ln ++ ", character " ++ show ch diff --git a/src/Espresso/CodeGen/GenM.hs b/src/Espresso/CodeGen/GenM.hs new file mode 100644 index 0000000..fb4722a --- /dev/null +++ b/src/Espresso/CodeGen/GenM.hs @@ -0,0 +1,108 @@ +-- Generator monad used in Espresso codegen. +module Espresso.CodeGen.GenM ( + askSym, + emit, + freshLabel, + freshLabelIdx, + freshVal, + getCode, + localSyms, + runGen, + valIdentFor, + GenM, + EspVal(..) +) where + +import Control.Monad.Identity +import Control.Monad.Reader +import Control.Monad.State +import qualified Data.Map as Map +import Espresso.Syntax.Abs +import Identifiers (indexedValIdent, labIdent, valIdent) +import qualified Syntax.Abs as Latte + +-- State of the generator. +data Store = St { + -- Supply for indexed label names. + stLabelCnt :: Integer, + -- Supply of names for temporary value names. + stValCnt :: Integer, + -- Supply for indexed names of variable-based values. + stSymCnt :: Map.Map Latte.Ident Integer, + -- Code generated thus far, reversed. + stCode :: [Instr ()] +} +-- Immutable environment mapping Latte variable names to generated values. +newtype Env = Env { + envSymbols :: Map.Map Latte.Ident EspVal +} + +-- Espresso value. +data EspVal = EspVal {valName :: ValIdent, valType :: SType ()} + +type GenM = StateT Store (Reader Env) + +-- Get the scoped Espresso value for a given Latte variable identifier. +askSym :: Latte.Ident -> GenM EspVal +askSym i = do + mbval <- asks (Map.lookup i . envSymbols) + case mbval of + Just val -> return val + Nothing -> error $ "internal error. symbol not found: " ++ Latte.showI i + +-- Emit an instruction. +emit :: Instr () -> GenM () +emit instr = modify (\s -> s {stCode = instr : stCode s}) + +-- Get a fresh, previously not generated label. +freshLabel :: GenM LabIdent +freshLabel = labIdent . show <$> freshLabelIdx + +-- Retrieve and increment the label counter. +freshLabelIdx :: GenM Integer +freshLabelIdx = do + n <- gets stLabelCnt + modify (\s -> s {stLabelCnt = n + 1}) + return n + +-- Get a fresh, temporary value not related to any particular symbol. +freshVal :: GenM ValIdent +freshVal = valIdent . show <$> freshValIdx + +-- Get all the code emitted thus far. +getCode :: GenM [Instr ()] +getCode = gets (reverse . stCode) + +-- Execute the given continuation with the supplied symbol-to-value declarations in scope. +localSyms :: [(Latte.Ident, EspVal)] -> GenM a -> GenM a +localSyms syms = local (\e -> e {envSymbols = Map.union (Map.fromList syms) (envSymbols e)}) + +-- Run the generator starting from an empty initial state. +runGen :: GenM a -> a +runGen gen = runIdentity $ runReaderT (evalStateT gen $ St 0 0 Map.empty []) (Env Map.empty) + +-- Get a fresh value with name signifying the identifier of the associated symbol. +valIdentFor :: Latte.Ident -> GenM ValIdent +valIdentFor i = do + idx <- cntSym i + return $ indexedValIdent (Latte.showI i) idx + +-- Retrieve and increment the counter for the given symbol. +-- Returns 0 and initialises the counter if the symbol was not counted before. +cntSym :: Latte.Ident -> GenM Integer +cntSym i = do + mbidx <- gets (Map.lookup i . stSymCnt) + case mbidx of + Just n -> do + modify (\s -> s { stSymCnt = Map.insert i (n + 1) (stSymCnt s)}) + return $ n + 1 + Nothing -> do + modify (\s -> s { stSymCnt = Map.insert i 0 (stSymCnt s)}) + return 0 + +-- Retrieve and increment the temporary value counter. +freshValIdx :: GenM Integer +freshValIdx = do + n <- gets stValCnt + modify (\s -> s {stValCnt = n + 1}) + return n diff --git a/src/Espresso/CodeGen/Generator.hs b/src/Espresso/CodeGen/Generator.hs new file mode 100644 index 0000000..8f2c757 --- /dev/null +++ b/src/Espresso/CodeGen/Generator.hs @@ -0,0 +1,408 @@ +module Espresso.CodeGen.Generator (generateEspresso) where + +import Control.Monad.Reader +import Data.List (foldl') +import qualified Data.Map as Map +import Data.Maybe (fromJust) +import Espresso.CodeGen.GenM +import Espresso.CodeGen.Labels +import Espresso.CodeGen.Operators +import Espresso.Syntax.Abs as Espresso +import Espresso.Types +import Espresso.Utilities +import Identifiers +import SemanticAnalysis.Analyser (SemData (..), Symbol (..), + SymbolTable (..), symTabLookup) +import SemanticAnalysis.Class as Class +import SemanticAnalysis.TopLevel as TopLevel (Metadata (..)) +import qualified Syntax.Abs as Latte +import Syntax.Code (Code) +import Utilities (dedupBy, single) + +-- Generate an Espresso program from a semantically analysed Latte program. +generateEspresso :: TopLevel.Metadata SemData -> Program () +generateEspresso (TopLevel.Meta meta) = + let cls = Map.elems meta + preamble = Espresso.Meta () $ map genClDef cls + code = map genMthd $ dedupBy mthdQIdent $ concatMap clMethods cls + in Program () preamble code + +-- Generate an Espresso .class definition for a semantically analysed Latte class. +genClDef :: Class.Class SemData -> Espresso.ClassDef () +genClDef cl = ClDef () (toSymIdent $ clName cl) + (map emitFldDef $ clFields cl) + (map emitMthdDef $ clMethods cl) + where + emitFldDef fld = FldDef () (toSType $ fldType fld) (toSymIdent $ fldName fld) + emitMthdDef mthd = MthdDef () (toFType $ mthdType mthd) (mthdQIdent mthd) + +-- Generate an Espresso method definition for .methods in a .class metadata segment +-- from a semantically analysed Latte class. +genMthd :: Class.Method SemData -> Espresso.Method () +genMthd mthd = + let code = runGen go + params = map (\(Latte.Arg _ t (Latte.Ident i)) -> + Param () (toSType $ () <$ t) (argValIdent i)) (mthdArgs mthd) + in Espresso.Mthd () (toSType $ () <$ mthdRet mthd) (mthdQIdent mthd) params code + where + go = do + let Latte.Block _ stmts = mthdBlk mthd + decls = declArgs $ mthdArgs mthd + emit $ mbAnnLabel entryLabel (codeLines (mthdBlk mthd)) + localSyms decls (genStmts stmts) + code <- getCode + if mthdRet mthd == Latte.Void () + then return $ unifyVRet code + else unifyRet (mthdRet mthd) code + +-- Generate Espresso code for a block of Latte statements. +genStmts :: [Latte.Stmt SemData] -> GenM () +genStmts [] = return () +genStmts (stmt : stmts) = case stmt of + Latte.Empty _ -> return () + Latte.BStmt _ (Latte.Block _ stmts') -> do + -- Scoping: save the environment, generate the block, + -- restore the environment to before-the-block. + env <- ask + genStmts stmts' + local (const env) (genStmts stmts) + Latte.Decl _ _ items -> do + let syms = semSymbols $ single stmt + decls <- genItems syms items + localSyms decls (genStmts stmts) + Latte.Ass _ e1 e2 -> do + (lvalue, type_) <- genLValue e1 + rvalue <- genExpr e2 + case type_ of + VLocal -> emit $ ISet () (valName lvalue) rvalue + -- Future-proof for fields and arrays. + VIndirect -> emit $ IStore () rvalue (toVVal lvalue) + genStmts stmts + Latte.Incr _ i -> do + val <- askSym i + emit $ IOp () (valName val) (toVVal val) (OpAdd ()) (VInt () 1) + genStmts stmts + Latte.Decr _ i -> do + val <- askSym i + emit $ IOp () (valName val) (toVVal val) (OpSub ()) (VInt () 1) + genStmts stmts + Latte.Ret _ e -> do + val <- genExpr e + emit $ IRet () val + genStmts stmts + Latte.VRet _ -> do + emit $ IVRet () + genStmts stmts + {- + ```lat + if (cond) { } + + ``` + ```esp + + .L_then: + + jump .L_after; // Redundant jump for easier CFG generation. + .L_after: + + -} + Latte.Cond _ cond stmtTrue -> do + (lthen, lafter) <- condLabels + genCond cond lthen lafter + emit $ mbAnnLabel lthen (codeLines stmtTrue) + genStmts [stmtTrue] + emit $ IJmp () lafter + emit $ ILabel () lafter + genStmts stmts + {- + ```lat + if (cond) { } + else { } + + ``` + ```esp + + .L_then: + + jump .L_after; + .L_else: + + jump .L_after; // Redundant jump for easier CFG generation. + .L_after: + + -} + Latte.CondElse _ cond stmtTrue stmtFalse -> do + (lthen, lelse, lafter) <- condElseLabels + genCond cond lthen lelse + emit $ mbAnnLabel lthen (codeLines stmtTrue) + genStmts [stmtTrue] + emit $ IJmp () lafter + emit $ mbAnnLabel lelse (codeLines stmtFalse) + genStmts [stmtFalse] + emit $ IJmp () lafter + emit $ ILabel () lafter + genStmts stmts + {- + ```lat + while (cond) { } + + ``` + ```esp + jump .L_cond; + .L_body + ; + jump .L_cond; // Redundant jump for easier CFG generation. + .L_cond + // Jump .L_body if true, .L_after if not. + .L_after: + + -} + Latte.While _ cond body -> do + (lcond, lbody, lafter) <- whileLabels + emit $ IJmp () lcond + emit $ mbAnnLabel lbody (codeLines body) + genStmts [body] + emit $ IJmp () lcond + emit $ mbAnnLabel lcond (codeLines cond) + genCond cond lbody lafter + emit $ ILabel () lafter + genStmts stmts + Latte.For {} -> error "for should be rewritten before Espresso codegen" + Latte.SExp _ e -> do + _ <- genExpr e + genStmts stmts + +-- Generate code for item declarations, evaluating initialisers based on a symbol table. +-- For declarations without initialisers emits a declaration to the type's default value. +genItems :: SymbolTable -> [Latte.Item SemData] -> GenM [(Latte.Ident, EspVal)] +genItems syms = mapM genItem + where genItem item = do + (i, val) <- genVal item + let t = single val + vi <- valIdentFor i + emit $ ISet () vi (() <$ val) + return (i, EspVal vi t) + genVal :: Latte.Item SemData -> GenM (Latte.Ident, Val (SType ())) + genVal item = case item of + Latte.NoInit _ i -> do + let sym = fromJust $ symTabLookup i syms + t = toSType $ symType sym + val = defaultVal t + return (i, t <$ val) + Latte.Init _ i e -> do + let sem = single e + t = toSType $ semType sem + val <- genExpr e + return (i, t <$ val) + +-- Turn method's arguments into Espresso values +declArgs :: [Latte.Arg Code] -> [(Latte.Ident, EspVal)] +declArgs = map declArg + where + declArg (Latte.Arg _ t i) = (i, EspVal (argValIdent $ toStr i) (toSType $ () <$ t)) + +-- Generate Espresso code for a Latte expression. +genExpr :: Latte.Expr SemData -> GenM (Val ()) +genExpr expr = case expr of + Latte.EVar _ i -> do + val <- askSym i + return (toVVal val) + Latte.ELitInt _ n -> return $ VInt () n + -- String literals are special and emit a separate instruction + -- so that assembly codegen can emit an allocation from a string constant. + Latte.EString _ s -> do + newval <- freshVal + emit $ IStr () newval s + return $ VVal () (Ref () (Str ())) newval + Latte.ELitTrue _ -> return $ VTrue () + Latte.ELitFalse _ -> return $ VFalse () + Latte.ENullI {} -> error "ENullI should be converted to ENull before Espresso codegen" + Latte.ENullArr {} -> error "ENullArr should be converted to ENull before Espresso codegen" + Latte.ENull _ _ -> return $ VNull () + Latte.ENew {} -> error "objects unimplemented" + Latte.ENewArr {} -> error "arrays unimplemented" + Latte.EApp sem e args -> do + let t = semType sem + vals <- mapM genExpr args + fun <- genFun e + newval <- freshVal + emit $ ICall () newval (Call () (toSType t) fun vals) + return (VVal () (toSType t) newval) + Latte.EIdx {} -> error "arrays unimplemented" + Latte.EAcc {} -> error "objects unimplemented" + Latte.ENeg _ e -> genUnOp e (UnOpNeg ()) + Latte.ENot _ e -> genUnOp e (UnOpNot ()) + Latte.EMul _ e1 op e2 -> genOp e1 e2 (toEspressoMulOp op) + Latte.EAdd _ e1 op e2 -> genOp e1 e2 (toEspressoAddOp op) + Latte.ERel _ e1 op e2 -> genOp e1 e2 (toEspressoRelOp op) + {- + ```lat + a && b + ``` + ```esp + %v_r := false; + // Jump to .L_true if true, .L_false if false. + .L_true: + %v_r := true; + jump .L_false; // Redundant jump for easier CFG generation. + .L_false: + + ``` + -} + Latte.EAnd {} -> do + (ltrue, lfalse) <- andLabels + newval <- freshVal + emit $ ISet () newval (VFalse ()) + genCond expr ltrue lfalse + emit $ ILabel () ltrue + emit $ ISet () newval (VTrue ()) + emit $ IJmp () lfalse + emit $ ILabel () lfalse + return $ VVal () (Bool ()) newval + {- + ```lat + a || b + ``` + ```esp + %v_r := true; + // Jump to .L_true if true, .L_false if false. + .L_false: + %v_r := false; + jump .L_true; // Redundant jump for easier CFG generation. + .L_true: + + ``` + -} + Latte.EOr {} -> do + (ltrue, lfalse) <- orLabels + newval <- freshVal + emit $ ISet () newval (VTrue ()) + genCond expr ltrue lfalse + emit $ ILabel () lfalse + emit $ ISet () newval (VFalse ()) + emit $ IJmp () ltrue -- Redundant jump for easier CFG generation. + emit $ ILabel () ltrue + return $ VVal () (Bool ()) newval + +-- Generate code for a Latte expression interpreted as a boolean condition. +-- Equivalent to a conditional jump to the first label if the condition is true +-- or to the second if it is false. +genCond :: Latte.Expr SemData -> LabIdent -> LabIdent -> GenM () +genCond e ltrue lfalse = case e of + {- + Short-circuting AND. + ```lat + a && b + ``` + ```esp + // Jump to .L_mid if true, .L_false if false. + .L_mid: + // Jump to .L_true if true, .L_false if false. + ``` + -} + Latte.EAnd _ e1 e2 -> do + lmid <- freshLabel + genCond e1 lmid lfalse + emit $ ILabel () lmid + genCond e2 ltrue lfalse + {- + Short-circuting OR. + ```lat + a || b + ``` + ```esp + // Jump to .L_true if true, .L_mid if false. + .L_mid: + // Jump to .L_true if true, .L_false if false. + ``` + -} + Latte.EOr _ e1 e2 -> do + lmid <- freshLabel + genCond e1 ltrue lmid + emit $ ILabel () lmid + genCond e2 ltrue lfalse + _ -> do + val <- genExpr e + emit $ ICondJmp () val ltrue lfalse + +-- Generate code for the given unary operator applied to an expression. +genUnOp :: Latte.Expr SemData -> UnOp () -> GenM (Val ()) +genUnOp e op = do + let t = semType $ single e + val <- genExpr e + newval <- freshVal + emit $ IUnOp () newval op val + return $ VVal () (toSType t) newval + +-- Generate code for the given binary operator applied to given expressions. +genOp :: Latte.Expr SemData -> Latte.Expr SemData -> Op () -> GenM (Val ()) +genOp e1 e2 op = do + let t = semType $ single e1 + val1 <- genExpr e1 + val2 <- genExpr e2 + newval <- freshVal + emit $ IOp () newval val1 op val2 + return $ VVal () (toSType t) newval + +-- Create a special .L_exit label signifying the end of the method +-- and turn all void returns to jumps to that label. +-- Additionally add a jump at end of the initial instruction sequence +-- in case the return was implicit. This may result in two consecutive jump +-- instructions if there was an explicit return, but this will be removed +-- as dead code in later phases. +unifyVRet :: [Instr ()] -> [Instr ()] +unifyVRet instrs = + let instr' = map retToJmp instrs + in instr' ++ [IJmp () exitLabel, ILabel () exitLabel, IVRet ()] + where + retToJmp (IVRet ()) = IJmp () exitLabel + retToJmp instr = instr + +-- Create a special .L_exit label signifying the end of the method +-- and turn all returns to jumps to that label. The return value +-- is propagated to a phi instruction at the start of .L_exit. +-- Additionally add a jump at the end of the initial instruction sequence. +-- There are no implicit returns in this case, but there might be an empty, +-- unreachable label. For example, when we had an if-else instruction in +-- which both branches return, there will be an empty .L_after label created +-- for that condition. Since the label is unreachable it will be removed as +-- dead code, but to maintain the property that each basic block ends with a jump +-- we need this artificial jump. +unifyRet :: Latte.Type () -> [Instr ()] -> GenM [Instr ()] +unifyRet t instrs = do + let (phi, _) = foldl' (flip goPhis) ([], entryLabel) instrs + instrs' = map retToJmp instrs + val <- valIdentFor (Latte.Ident "ret") + return $ instrs' ++ [ + IJmp () exitLabel, + ILabel () exitLabel, + IPhi () val phi, + IRet () (VVal () (toSType t) val) + ] + where + goPhis (ILabel _ l) (phi, _) = (phi, l) + goPhis (ILabelAnn _ l _ _) (phi, _) = (phi, l) + goPhis (IRet _ v) (phi, l) = (PhiVar () l v:phi, l) + goPhis _ x = x + retToJmp IRet {} = IJmp () exitLabel + retToJmp i = i + +data ValType = VLocal | VIndirect + +genLValue :: Latte.Expr SemData -> GenM (EspVal, ValType) +genLValue e = case e of + Latte.EVar _ i -> do + val <- askSym i + return (val, VLocal) + Latte.EIdx {} -> error "arrays unimplemented" + Latte.EAcc {} -> error "objects unimplemented" + _ -> error $ "internal error, invalid lvalue " ++ show (() <$ e) + +genFun :: Latte.Expr SemData -> GenM (QIdent ()) +genFun e = case e of + Latte.EVar _ i -> return $ QIdent () (SymIdent $ toStr topLevelClassIdent) (SymIdent $ toStr i) + Latte.EAcc {} -> error "objects unimplemented" + _ -> error $ "internal error, invalid function " ++ show (() <$ e) + +toVVal :: EspVal -> Val () +toVVal (EspVal i t) = VVal () t i diff --git a/src/Espresso/CodeGen/Labels.hs b/src/Espresso/CodeGen/Labels.hs new file mode 100644 index 0000000..133494f --- /dev/null +++ b/src/Espresso/CodeGen/Labels.hs @@ -0,0 +1,47 @@ +module Espresso.CodeGen.Labels ( + andLabels, + condLabels, + condElseLabels, + mbAnnLabel, + orLabels, + whileLabels +) where + +import Espresso.CodeGen.GenM (GenM, freshLabelIdx) +import Espresso.Syntax.Abs +import Identifiers (labIdent) + +-- Create a LabIdent from a root string and an index. +idxLabel :: String -> Integer -> LabIdent +idxLabel s n = labIdent (s ++ show n) + +-- Create an annotated label if the line interval is Just. +-- Otherwise, a regular label without annotations. +mbAnnLabel :: LabIdent -> Maybe (Int, Int) -> Instr () +mbAnnLabel l Nothing = ILabel () l +mbAnnLabel l (Just (lf, lt)) = ILabelAnn () l (toInteger lf) (toInteger lt) + +andLabels :: GenM (LabIdent, LabIdent) +andLabels = twoLabels "true" "false" + +condLabels :: GenM (LabIdent, LabIdent) +condLabels = twoLabels "then" "after" + +condElseLabels :: GenM (LabIdent, LabIdent, LabIdent) +condElseLabels = threeLabels "then" "else" "after" + +orLabels :: GenM (LabIdent, LabIdent) +orLabels = twoLabels "true" "false" + +whileLabels :: GenM (LabIdent, LabIdent, LabIdent) +whileLabels = threeLabels "cond" "body" "after" + +twoLabels :: String -> String -> GenM (LabIdent, LabIdent) +twoLabels l1 l2 = do + lidx <- freshLabelIdx + return (idxLabel l1 lidx, idxLabel l2 lidx) + +threeLabels :: String -> String -> String -> GenM (LabIdent, LabIdent, LabIdent) +threeLabels l1 l2 l3 = do + lidx <- freshLabelIdx + return (idxLabel l1 lidx, idxLabel l2 lidx, idxLabel l3 lidx) diff --git a/src/Espresso/CodeGen/Operators.hs b/src/Espresso/CodeGen/Operators.hs new file mode 100644 index 0000000..58335f0 --- /dev/null +++ b/src/Espresso/CodeGen/Operators.hs @@ -0,0 +1,24 @@ +module Espresso.CodeGen.Operators where + +import Espresso.Syntax.Abs +import qualified Syntax.Abs as Latte + +toEspressoMulOp :: Latte.MulOp a -> Op () +toEspressoMulOp op = case op of + Latte.Times _ -> OpMul () + Latte.Div _ -> OpDiv () + Latte.Mod _ -> OpMod () + +toEspressoAddOp :: Latte.AddOp a -> Op () +toEspressoAddOp op = case op of + Latte.Plus _ -> OpAdd () + Latte.Minus _ -> OpSub () + +toEspressoRelOp :: Latte.RelOp a -> Op () +toEspressoRelOp op = case op of + Latte.EQU _ -> OpEQU () + Latte.NE _ -> OpNE () + Latte.GE _ -> OpGE () + Latte.GTH _ -> OpGTH () + Latte.LE _ -> OpLE () + Latte.LTH _ -> OpLTH () diff --git a/src/Espresso/ControlFlow/CFG.hs b/src/Espresso/ControlFlow/CFG.hs new file mode 100644 index 0000000..5fbdf64 --- /dev/null +++ b/src/Espresso/ControlFlow/CFG.hs @@ -0,0 +1,130 @@ +-- Generation of Control Flow Graphs for methods. +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleContexts #-} +module Espresso.ControlFlow.CFG ( + CFG(..), + Node(..), + cfg, + linearize, + nodeHead, + nodeTail +) where + +import Control.Monad.State +import qualified Data.Map as Map +import qualified Data.Set as Set +import Espresso.Syntax.Abs +import Identifiers (ToString (toStr), entryLabel) +import Utilities (single) + +-- A CFG is a set of nodes representing basic blocks, identified by their starting labels. +newtype CFG a = CFG (Map.Map LabIdent (Node a)) deriving (Eq, Functor, Foldable) + +data Node a = Node { + -- Starting label of this basic block. + nodeLabel :: LabIdent, + -- All code in this basic block. + nodeCode :: [Instr a], + -- All basic blocks reachable from this block. + nodeOut :: Set.Set LabIdent, + -- All basic blocks that can reach this block. + nodeIn :: Set.Set LabIdent +} deriving (Eq, Functor, Foldable) + +-- Convert an Espresso method to a CFG. Code that is unreachable within a basic block, +-- that is instructions occuring after a jump, are removed. +cfg :: Method a -> CFG a +cfg (Mthd _ _ _ _ instrs) = + let basicBlocks = splitBasicBlocks instrs + initial = Map.fromList $ map (\(l, is) -> (l, Node l is Set.empty Set.empty)) basicBlocks + in execState (construct basicBlocks) (CFG initial) + +-- Convert a CFG to a sequence of instructions. It is guaranteed to start with the +-- .L_entry block. Blocks that are unreachable from the entry block will be ignored. +linearize :: CFG a -> [Instr a] +linearize (CFG g) = + case Map.lookup entryLabel g of + Just entry -> evalState (go entry) Set.empty + Nothing -> error "internal error. malformed graph, no entry label" + where + go node = do + rest <- mapM expand (Set.elems $ nodeOut node) + return $ nodeCode node ++ concat rest + expand l = do + case Map.lookup l g of + Just node -> do + wasVisited <- gets (Set.member l) + if wasVisited then return [] else do + modify (Set.insert l) + go node + Nothing -> error $ "internal error. malformed graph, no " ++ toStr l ++ " node" + +-- Extract the element from the first instruction in the block. +nodeHead :: Node a -> a +nodeHead node = let firstInstr = head $ nodeCode node + in single firstInstr + +-- Extract the element from the last instruction in the block. +nodeTail :: Node a -> a +nodeTail node = let lastInstr = last $ nodeCode node + in single lastInstr + +-- Split the instruction sequence into basic blocks. A basic block spans from a label +-- to the first consecutive jump instruction. All instructions after a jump are dead +-- code and are ignored. +splitBasicBlocks :: [Instr a] -> [(LabIdent, [Instr a])] +splitBasicBlocks = go [] + where + go bbs [] = map finalizeBlock bbs + go bbs (i@(ILabel _ l):is) = go ((l, [i]):bbs) is + go bbs (i@(ILabelAnn _ l _ _):is) = go ((l, [i]):bbs) is + go ((l, x):bbs) (j:is) | isJump j = go ((l, j:x):bbs) (dropWhile (not . isLabel) is) + go ((l, x):bbs) (i:is) = go ((l, i:x):bbs) is + go [] _ = error "first instruction is not a label" + finalizeBlock (l, []) = error ("empty basic block: " ++ toStr l) + finalizeBlock (l, is@(i:_)) | isJump i = (l, reverse is) + finalizeBlock (l, _) = error ("basic block not ending with a jump: " ++ toStr l) + +-- Constructs a CFG from basic blocks. +construct :: [(LabIdent, [Instr a])] -> State (CFG a) () +construct = mapM_ fromJumps + where fromJumps (_, []) = return () + fromJumps (from, i:is) = fromInstr from i >> fromJumps (from, is) + fromInstr from i = case i of + IJmp _ to -> addEdge from to + ICondJmp _ _ to1 to2 -> addEdge from to1 >> addEdge from to2 + _ -> return () + +-- Add an edge between two blocks to the current CFG. +addEdge :: LabIdent -> LabIdent -> State (CFG a) () +addEdge from to = do + mbfromNode <- gets (\(CFG g) -> Map.lookup from g) + mbtoNode <- gets (\(CFG g) -> Map.lookup to g) + let fromNode' = case mbfromNode of + Just fromNode -> fromNode {nodeOut = Set.insert to (nodeOut fromNode)} + Nothing -> error $ "internal error. no src label " ++ toStr from + toNode' = case mbtoNode of + Just toNode -> toNode {nodeIn = Set.insert from (nodeOut toNode)} + Nothing -> error $ "internal error. no dest label " ++ toStr to + modify (\(CFG g) -> CFG $ Map.insert from fromNode' g) + modify (\(CFG g) -> CFG $ Map.insert to toNode' g) + +instance Show (CFG a) where + show (CFG g) = unlines (nodes:map edges (Map.elems g)) + where nodes = show (map toStr $ Map.keys g) + edges node = show (toStr $ nodeLabel node) ++ " -> " ++ show (nodeOut node) + +isLabel :: Instr a -> Bool +isLabel instr = case instr of + ILabel {} -> True + ILabelAnn {} -> True + _ -> False + +isJump :: Instr a -> Bool +isJump instr = case instr of + IJmp {} -> True + ICondJmp {} -> True + IVRet {} -> True + IRet {} -> True + _ -> False diff --git a/src/Espresso/ControlFlow/Liveness.hs b/src/Espresso/ControlFlow/Liveness.hs new file mode 100644 index 0000000..ac5b21f --- /dev/null +++ b/src/Espresso/ControlFlow/Liveness.hs @@ -0,0 +1,129 @@ +-- Annotations of variable liveness for CFGs. +module Espresso.ControlFlow.Liveness where + +import qualified Data.Map as Map +import qualified Data.Set as Set +import Espresso.ControlFlow.CFG (CFG (..), Node (..)) +import Espresso.Syntax.Abs +import Utilities + +type VarSet = Set.Set String +-- A map between variables and the shortest distance +-- (in number of instructions) to its next use +type NextUse = Map.Map String Int + +-- Liveness annotations for a single instruction. +data Liveness = Liveness { + -- Variables alive at the start of the instruction and their next uses. + liveIn :: NextUse, + -- Variables alive at the end of the instruction and their next uses. + liveOut :: NextUse, + -- Variables used in this instruction. + liveUse :: VarSet, + -- Variables killed in this instruction. + liveKill :: VarSet +} deriving Eq + +-- Neutral element with no variables alive or used. +emptyLiveness :: Liveness +emptyLiveness = Liveness Map.empty Map.empty Set.empty Set.empty + +-- Annotate a CFG with liveness data for every instruction in every node. +-- This is done by iterating the liveness data until reaching a fixpoint, +-- in each step propagating the liveness data locally within a basic block. +analyseLiveness :: CFG a -> CFG Liveness +analyseLiveness g = let start = initialLiveness g + in fixpoint iterateLiveness start + +-- Starting point for the algorithm containing use and kill data for each instruction. +initialLiveness :: CFG a -> CFG Liveness +initialLiveness (CFG g) = CFG (Map.map nodeInitLive g) + where nodeInitLive node = node { nodeCode = map instrInitLive (nodeCode node) } + instrInitLive instr = + let (use, kill) = case instr of + IRet _ v -> (valSet v, Set.empty) + IOp _ vi v1 _ v2 -> (valsSet [v1, v2], valISet vi) + ISet _ vi v -> (valSet v, valISet vi) + IUnOp _ vi _ v -> (valSet v, valISet vi) + IVCall _ call -> (callUseSet call, Set.empty) + ICall _ vi call -> (callUseSet call, valISet vi) + ICondJmp _ v _ _ -> (valSet v, Set.empty) + ILoad _ vi v -> (valSet v, valISet vi) + IStore _ v1 v2 -> (valsSet [v1, v2], Set.empty) + IFld _ vi v _ -> (valSet v, valISet vi) + IArr _ vi v1 v2 -> (valsSet [v1, v2], valISet vi) + IPhi _ vi phis -> (phiUseSet phis, valISet vi) + _ -> (Set.empty, Set.empty) + in emptyLiveness { liveUse = use, liveKill = kill } <$ instr + +-- Propagate current liveness data locally within basic blocks +-- and then propagate once through edges in the graph. +iterateLiveness :: CFG Liveness -> CFG Liveness +iterateLiveness (CFG g) = globalLiveness $ CFG $ Map.map localLiveness g + +-- For each edge (v, u) in the graph mark the variables alive at the beginning of u +-- as alive at the end of v. +globalLiveness :: CFG Liveness -> CFG Liveness +globalLiveness (CFG g) = CFG $ Map.map go g + where + go node = + let -- Look at each outgoing edge and get the next uses of all live variables, + -- taking the minimum if a variable is used in more than one block. + out = foldr (Map.unionWith min . liveIn . nodeLiveness . (g Map.!)) Map.empty (Set.elems $ nodeOut node) + (lastInstr, instrs) = splitLast $ nodeCode node + -- Put the data from the target nodes in the last instruction to be propagated + -- during localLiveness step. + lastInstr' = (\l -> l {liveOut = Map.map (+1) out}) <$> lastInstr + in node {nodeCode = instrs ++ [lastInstr']} + +-- Propagate variable usage down-to-top through a node. +localLiveness :: Node Liveness -> Node Liveness +localLiveness node = node {nodeCode = go (nodeCode node)} + where + go :: [Instr Liveness] -> [Instr Liveness] + go [] = [] + go (instr:instrs) = + let xs = go instrs + instr' = (\live -> + let -- If this is the last instruction the liveOut + -- set will be unchanged in this step. + out = case xs of + [] -> liveOut live + x:_ -> liveIn $ single x + -- in = (out - kill) \cup use + fromOut = (Map.map (+1) out `Map.withoutKeys` liveKill live) + fromThis = Map.fromSet (const 0) (liveUse live) + in_ = fromThis `Map.union` fromOut + in live {liveOut = out, liveIn = in_}) + <$> instr + in instr':xs + +valISet :: ValIdent -> VarSet +valISet (ValIdent s) = Set.singleton s + +valSet :: Val a -> VarSet +valSet v = case v of + VVal _ _ vi -> valISet vi + _ -> Set.empty + +valsSet :: [Val a] -> VarSet +valsSet = foldr (Set.union . valSet) Set.empty + +callUseSet :: Call a -> VarSet +callUseSet call = case call of + Call _ _ _ vs -> valsSet vs + CallVirt _ _ _ vs -> valsSet vs + +phiUseSet :: [PhiVariant a] -> VarSet +phiUseSet phis = valsSet $ map (\(PhiVar _ _ v) -> v) phis + +nodeLiveness :: Node Liveness -> Liveness +nodeLiveness node = single $ head $ nodeCode node + +instance Show Liveness where + show l = "in = " ++ showMap (liveIn l) ++ + ", out = " ++ showMap (liveOut l) ++ + ", use = " ++ showSet (liveUse l) ++ + ", kill = " ++ showSet (liveKill l) + where showSet = show . Set.elems + showMap = show . Map.toList diff --git a/src/Espresso/ControlFlow/Phi.hs b/src/Espresso/ControlFlow/Phi.hs new file mode 100644 index 0000000..9817ca8 --- /dev/null +++ b/src/Espresso/ControlFlow/Phi.hs @@ -0,0 +1,127 @@ +-- Unfolding of the phony phi function to make code viable for assembly codegen. +module Espresso.ControlFlow.Phi (unfoldPhi) where + +import Data.List +import qualified Data.Map as Map +import qualified Data.Set as Set +import Espresso.ControlFlow.CFG +import Espresso.Syntax.Abs +import Identifiers + +data JumpRoute = JmpRt LabIdent LabIdent deriving (Eq, Ord) + +-- For a given method and its CFG, turn the code into an equivalent +-- version without any IPhi instructions and return the new CFG. +unfoldPhi :: (CFG (), Method ()) -> CFG () +unfoldPhi (CFG g, Mthd () t qi ps _) = + let (unfolded, jmpRoutes) = unzip $ Map.elems $ Map.map go g + rewritten = rerouteJumps (concat jmpRoutes) (concat unfolded) + in cfg $ Mthd () t qi ps rewritten + where + go node = let l = nodeLabel node + code = nodeCode node + nontrivial = map unfoldTrivialPhi code + in createJumpDests l nontrivial + +unfoldTrivialPhi :: Instr () -> Instr () +unfoldTrivialPhi instr = case instr of + IPhi a i [PhiVar _ _ val] -> ISet a i val + _ -> instr + +-- Unwrap sequences of phi instructions by creating a special block for each incoming +-- label that sets the values specified in the variants for that label and then jumps +-- to the start of the original block. The phi instructions must immediatelly +-- succeed the starting label of the block, or this function will fail. +-- For example, the code: +{- + .L_label: + %v_a := phi(.L_source1: int %v_0, .L_source2: int %v_1); + %v_b := phi(.L_source1: 42, .L_source2: int %v_2); + +-} +-- gets rewritten into: +{- + .L_label__from_source1: + %v_a := int %v_0; + %v_b := 42; + jump .L_label; + .L_label__from_source2: + %v_a := int %v_1; + %v_b := int %v_2; + jump .L_label; + .L_label: + +-} +createJumpDests :: LabIdent -> [Instr ()] -> ([Instr ()], [JumpRoute]) +createJumpDests _ [] = error "internal error. empty node" +createJumpDests l (labelInstr:instrs) = + let (phiInstrs, rest) = span isPhi instrs + (rewrittenPhis, jmpRoutes) = unfoldToJumpDests (map (\(IPhi _ vi pvs) -> (vi, pvs)) phiInstrs) + in if any isPhi rest + then error "internal error. phi not immediately succeeding a label" + else if not $ isLabel labelInstr + then error "internal error. label not first instruction in node" + else (rewrittenPhis ++ [labelInstr] ++ rest, jmpRoutes) + where + unfoldToJumpDests values = + let sourceToValuePairs = Map.toList $ foldr accVars Map.empty values + (code, ls) = unzip $ map createSingleDest sourceToValuePairs + in (concat code, ls) + accVars (vi, phiVars) acc = + foldr (\(PhiVar _ src v) -> Map.insertWith (++) src [(vi, v)]) acc phiVars + createSingleDest (lSrc, setVals) = + (ILabel () (phiUnfoldJumpFromToLabel lSrc l) : + map (uncurry (ISet ())) setVals + ++ [IJmp () l], JmpRt lSrc l) + +-- For the routes created by unfolding phi reroute each direct jump from +-- a block to an affected block so that it targets the newly created special +-- labels. So, assuming the same example .L_label as in createJumpDests, the following +-- code: +{- + .L_source1: + + jump .L_label; + .L_source2: + + jump if %v_cond then .L_label else .L_some_other_label; +-} +-- gets rewritten into: +{- + .L_source1: + + jump .L_label__from_source1; + .L_source2: + + jump if %v_cond then .L_label__from_source2 else .L_some_other_label; +-} +rerouteJumps :: [JumpRoute] -> [Instr ()] -> [Instr ()] +rerouteJumps jmpRoutes instrs = reverse $ fst $ foldl' go ([], entryLabel) instrs + where + jumpSet = Set.fromList jmpRoutes + go (is, lSrc) instr = case instr of + ILabel _ lSrc' -> + (instr:is, lSrc') + ILabelAnn _ lSrc' _ _ -> + (instr:is, lSrc') + IJmp _ lDest -> + (IJmp () (reroute lSrc lDest):is, lSrc) + ICondJmp _ v lDest1 lDest2 -> + (ICondJmp () v (reroute lSrc lDest1) (reroute lSrc lDest2):is, lSrc) + _ -> + (instr:is, lSrc) + reroute lSrc lDest = + if JmpRt lSrc lDest `Set.member` jumpSet + then phiUnfoldJumpFromToLabel lSrc lDest + else lDest + +isPhi :: Instr a -> Bool +isPhi instr = case instr of + IPhi {} -> True + _ -> False + +isLabel :: Instr a -> Bool +isLabel instr = case instr of + ILabel {} -> True + ILabelAnn {} -> True + _ -> False diff --git a/src/Espresso/Interpreter.hs b/src/Espresso/Interpreter.hs new file mode 100644 index 0000000..9e7d317 --- /dev/null +++ b/src/Espresso/Interpreter.hs @@ -0,0 +1,348 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} +{-# OPTIONS_GHC -fno-warn-unused-binds #-} +{-# OPTIONS_GHC -fno-warn-type-defaults #-} +module Espresso.Interpreter (interpret) where + +import Control.Monad.Reader +import Control.Monad.State +import Data.List +import qualified Data.Map as Map +import Data.Maybe +import Espresso.Syntax.Abs +import Identifiers +import LatteIO +import System.Exit (ExitCode (..)) + +type Loc = Int +type OEnv = Map.Map String Loc +type CEnv = Map.Map String Class +type LEnv = Map.Map String [Instr Pos] +type Store = Map.Map Loc Object + +data Env = Env { objEnv :: OEnv, clEnv :: CEnv, labelEnv :: LEnv } + +data Object = Inst { objType_ :: Class, objData_ :: OEnv } + | Array { arrType_ :: Class, arrData_ :: [Object]} + | Ptr { ref :: Loc } + | PInt Int + | PBool Bool + | PStr String + | PNull + +data Class = Class { clName :: String, clFlds :: Map.Map String Field, clMthds :: Map.Map String Function } + +data Field = Fld { fldName :: String, fldType :: SType () } +data Function = Fun { funName :: String, funRet :: SType (), funParams :: [Param ()], funCode :: [Instr Pos] } + +type InterpreterM m = StateT Store (ReaderT Env m) + +interpret :: (LatteIO m, Monad m) => Program Pos -> m () +interpret (Program _ (Meta _ clDefs) methods) = do + obj <- runReaderT (evalStateT go Map.empty) (Env Map.empty env Map.empty) + let PInt n = obj + if n == 0 then exitSuccess else exitWith $ ExitFailure n + where + env = let cls = map clDefToCl clDefs + in Map.fromList (zip (map clName cls) cls) + clDefToCl (ClDef _ i fldDefs mthdDefs) = let flds = map fldDefToFld fldDefs + mthds = mapMaybe mthdDefToFun mthdDefs + fldMap = Map.fromList $ zip (map fldName flds) flds + mthdMap = Map.fromList $ zip (map funName mthds) mthds + in Class (toStr i) fldMap mthdMap + fldDefToFld (FldDef _ t i) = Fld (toStr i) (() <$ t) + mthdDefToFun (MthdDef _ (FType _ r _) qi) = + let QIdent _ cli i = qi + in if isNativeFun (toStr cli) (toStr i) + then Nothing + else let Mthd _ _ _ ps code = case Map.lookup (cli, i) methodMap of + Nothing -> Prelude.error $ "internal error, method " ++ toStr cli ++ "." ++ toStr i ++ " not found" + Just m -> m + in Just $ Fun (toStr i) (() <$ r) (map (() <$) ps) code + methodMap = Map.fromList $ zip (map (\(Mthd _ _ (QIdent _ cli i) _ _) -> (cli, i)) methods) methods + go = do + main <- askFun (toStr topLevelClassIdent) (toStr mainSymIdent) + call main [] return + +call :: (LatteIO m, Monad m) => Function -> [Object] -> (Object -> InterpreterM m a) -> InterpreterM m a +call (Fun _ _ ps code) objs ret = do + argEnv <- allocs args + let labels = getLabels code + ret' <- saveEnv2 ret + localObjs argEnv $ localLabels labels $ execute (toStr entryLabel) (toStr entryLabel) code ret' + where + args = zipWith (\(Param _ _ vi) p -> (toStr vi, p)) ps objs + +getLabels :: [Instr Pos] -> [(String, [Instr Pos])] +getLabels [] = [] +getLabels (i : is) = case i of + ILabel _ l -> (toStr l, is) : getLabels is + ILabelAnn _ l _ _ -> (toStr l, is) : getLabels is + _ -> getLabels is + +callFromCallsite :: (LatteIO m, Monad m) => Call Pos -> (Object -> InterpreterM m a) -> InterpreterM m a +callFromCallsite callsite ret = case callsite of + Call _ _ (QIdent _ i1 i2) vals -> do + args <- mapM getVal vals + if isNativeFun (toStr i1) (toStr i2) then runNative (toStr i2) vals ret else (do + f <- askFun (toStr i1) (toStr i2) + call f args ret) + CallVirt {} -> LatteIO.error "callvirt unimplemented" + +execute :: (LatteIO m, Monad m) => String -> String -> [Instr Pos] -> (Object -> InterpreterM m a) -> InterpreterM m a +execute _ _ [] ret = ret PNull +execute prevLabel currLabel (instr : is) ret = case instr of + ILabel _ i -> execute currLabel (toStr i) is ret + ILabelAnn _ i _ _ -> execute currLabel (toStr i) is ret + IVRet {} -> ret PNull + IRet _ v -> do + x <- getVal v + ret x + IOp _ i v1 op v2 -> do + x1 <- getVal v1 + x2 <- getVal v2 + let res = performOp x1 x2 op + newval <- store (toStr i) res + localObj newval $ execute prevLabel currLabel is ret + ISet _ i v -> do + x <- getVal v + newval <- store (toStr i) x + localObj newval $ execute prevLabel currLabel is ret + IStr _ i str -> do + newval <- store (toStr i) (PStr str) + localObj newval $ execute prevLabel currLabel is ret + IUnOp _ i op v -> do + x <- getVal v + let res = performUnOp x op + newval <- store (toStr i) res + localObj newval $ execute prevLabel currLabel is ret + IVCall _ callsite -> callFromCallsite callsite (\_ -> execute prevLabel currLabel is ret) + ICall _ i callsite -> callFromCallsite callsite (\res -> do + newval <- store (toStr i) res + localObj newval $ execute prevLabel currLabel is ret) + IJmp _ i -> do + is' <- askLabel (toStr i) + execute currLabel (toStr i) is' ret + ICondJmp _ v i1 i2 -> do + x1 <- getVal v + is1 <- askLabel (toStr i1) + is2 <- askLabel (toStr i2) + b <- isTrue x1 + let (label, is') = if b + then (toStr i1, is1) + else (toStr i2, is2) + execute currLabel label is' ret + ILoad _ i v -> do + x <- getVal v + x' <- deref x + newval <- store (toStr i) x' + localObj newval $ execute prevLabel currLabel is ret + IStore _ v1 v2 -> do + x1 <- getVal v1 + x2 <- getVal v2 + storeInto x1 x2 + execute prevLabel currLabel is ret + IFld {} -> LatteIO.error "fields unimplemented" + IArr {} -> LatteIO.error "arrays unimplemented" + IPhi _ i variants -> do + let Just (PhiVar _ _ val) = find (\(PhiVar _ l _) -> toStr l == prevLabel) variants + obj <- getVal val + newval <- store (toStr i) obj + localObj newval $ execute prevLabel currLabel is ret + +askFun :: (LatteIO m, Monad m) => String -> String -> InterpreterM m Function +askFun clI mthdI = do + cl <- askCl clI + case Map.lookup mthdI (clMthds cl) of + Nothing -> LatteIO.error ("internal error, method " ++ clI ++ "." ++ mthdI ++ " not found") + Just mthd -> return mthd + +askCl :: (LatteIO m, Monad m) => String -> InterpreterM m Class +askCl clI = do + mbcl <- asks (Map.lookup clI . clEnv) + case mbcl of + Nothing -> LatteIO.error ("internal error, class " ++ clI ++ " not found") + Just cl -> return cl + +askLabel :: (LatteIO m, Monad m) => String -> InterpreterM m [Instr Pos] +askLabel label = do + mbl <- asks (Map.lookup label . labelEnv) + case mbl of + Nothing -> LatteIO.error ("internal error, label " ++ label ++ " not found") + Just l -> return l + +askObj :: (LatteIO m, Monad m) => String -> InterpreterM m Loc +askObj i = do + mbobj <- asks (Map.lookup i . objEnv) + case mbobj of + Nothing -> LatteIO.error ("internal error, object " ++ i ++ " not found") + Just l -> return l + +allocs :: (LatteIO m, Monad m) => [(String, Object)] -> InterpreterM m [(String, Loc)] +allocs = mapM (uncurry alloc) + +alloc :: (LatteIO m, Monad m) => String -> Object -> InterpreterM m (String, Loc) +alloc i obj = do + loc <- newloc + storeObj loc obj + return (i, loc) + +store :: (LatteIO m, Monad m) => String -> Object -> InterpreterM m (String, Loc) +store i obj = do + mbloc <- asks (Map.lookup i . objEnv) + loc <- maybe newloc return mbloc + storeObj loc obj + return (i, loc) + +storeObj :: (LatteIO m, Monad m) => Loc -> Object -> InterpreterM m () +storeObj loc obj = modify $ Map.insert loc obj + +storeInto :: (LatteIO m, Monad m) => Object -> Object -> InterpreterM m () +storeInto to obj = case to of + Ptr loc -> modify $ Map.insert loc obj + _ -> Prelude.error "internal error, invalid store" + +getVal :: (LatteIO m, Monad m) => Val a -> InterpreterM m Object +getVal val = case val of + VInt _ n -> return $ PInt (fromInteger n) + VNegInt _ n -> return $ PInt (fromInteger (-n)) + VTrue _ -> return $ PBool True + VFalse _ -> return $ PBool False + VNull _ -> return PNull + VVal _ _ i -> getObj (toStr i) + +getObj :: (LatteIO m, Monad m) => String -> InterpreterM m Object +getObj i = do + ptr <- askObj i + deref (Ptr ptr) + +newloc :: (LatteIO m, Monad m) => InterpreterM m Int +newloc = do + objs <- get + if Map.null objs then return 0 + else let (k, _) = Map.findMax objs in return $ k + 1 + +localObjs :: (LatteIO m, Monad m) => [(String, Loc)] -> InterpreterM m a -> InterpreterM m a +localObjs objs = local (\e -> e { objEnv = Map.fromList objs }) + +localObj :: (LatteIO m, Monad m) => (String, Loc) -> InterpreterM m a -> InterpreterM m a +localObj (i, ptr) = local (\e -> e { objEnv = Map.insert i ptr $ objEnv e }) + +localLabels :: (LatteIO m, Monad m) => [(String, [Instr Pos])] -> InterpreterM m a -> InterpreterM m a +localLabels labels = local (\e -> e { labelEnv = Map.union (Map.fromList labels) $ labelEnv e }) + +saveEnv2 :: (LatteIO m, Monad m) => (a -> InterpreterM m b) -> InterpreterM m (a -> InterpreterM m b) +saveEnv2 m = do + env <- ask + return (local (const env) . m) + +deref :: (LatteIO m, Monad m) => Object -> InterpreterM m Object +deref x = case x of + Ptr loc -> do + mbobj <- gets (Map.lookup loc) + case mbobj of + Nothing -> LatteIO.error ("internal error, pointer " ++ show loc ++ " not found") + Just obj -> return obj + _ -> Prelude.error "internal error, invalid deref" + +isTrue :: (LatteIO m, Monad m) => Object -> InterpreterM m Bool +isTrue x = case x of + PBool True -> return True + _ -> return False + +performOp :: Object -> Object -> Op Pos -> Object +performOp x1 x2 op = case (x1, x2, op) of + (PInt n1, PInt n2, OpAdd {}) -> PInt $ n1 + n2 + (PStr s1, PStr s2, OpAdd {}) -> PStr $ s1 ++ s2 + (PInt n1, PInt n2, OpSub {}) -> PInt $ n1 - n2 + (PInt n1, PInt n2, OpMul {}) -> PInt $ n1 * n2 + (PInt n1, PInt n2, OpDiv {}) -> PInt $ n1 `div` n2 + (PInt n1, PInt n2, OpMod {}) -> PInt $ n1 `mod` n2 + (_, _, OpEQU {}) -> PBool $ areEq x1 x2 + (_, _, OpNE {}) -> PBool $ not $ areEq x1 x2 + (_, _, OpGE {}) -> PBool $ getOrd x1 x2 op + (_, _, OpGTH {}) -> PBool $ getOrd x1 x2 op + (_, _, OpLE {}) -> PBool $ getOrd x1 x2 op + (_, _, OpLTH {}) -> PBool $ getOrd x1 x2 op + _ -> Prelude.error (show op) + +performUnOp :: Object -> UnOp Pos -> Object +performUnOp x op = case (x, op) of + (PInt n, UnOpNeg {}) -> PInt $ -n + (PBool b, UnOpNot {}) -> PBool $ not b + _ -> Prelude.error (show op) + +areEq :: Object -> Object -> Bool +areEq x1 x2 = case (x1, x2) of + (PInt n1, PInt n2) -> n1 == n2 + (PStr s1, PStr s2) -> s1 == s2 + (PBool b1, PBool b2) -> b1 == b2 + (PNull, PNull) -> True + (Ptr p1, Ptr p2) -> p1 == p2 + _ -> False + +getOrd :: Object -> Object -> Op Pos -> Bool +getOrd x1 x2 op = case (x1, x2) of + (PInt n1, PInt n2) -> ordWithOp n1 n2 + (PStr s1, PStr s2) -> ordWithOp s1 s2 + (PBool b1, PBool b2) -> ordWithOp b1 b2 + _ -> Prelude.error $ "invalid ord of " ++ show x1 ++ ", " ++ show x2 + where + ordWithOp x1' x2' = case op of + OpGTH {} -> x1' > x2' + OpGE {} -> x1' >= x2' + OpLTH {} -> x1' < x2' + OpLE {} -> x1' <= x2' + _ -> Prelude.error $ "internal error, invalid relop " ++ show op + +isNativeFun :: String -> String -> Bool +isNativeFun i1 i2 = i1 == toStr topLevelClassIdent && + case i2 of + "printInt" -> True + "printString" -> True + "error" -> True + "readInt" -> True + "readString" -> True + _ -> False + +runNative :: (LatteIO m, Monad m) => String -> [Val Pos] -> (Object -> InterpreterM m a) -> InterpreterM m a +runNative i vals ret = case i of + "printInt" -> do + x <- getVal (head vals) + let PInt n = x + printInt n + ret PNull + "printString" -> do + x <- getVal (head vals) + let PStr s = x + printString s + ret PNull + "error" -> LatteIO.error "" + "readInt" -> readInt >>= ret . PInt + "readString" -> readString >>= ret . PStr + _ -> Prelude.error $ "internal error, invalid native fun " ++ i + +instance Show Object where + show o = case o of + Inst t _ -> clName t + Array t d -> clName t ++ "[" ++ show (length d) ++ "]" + Ptr t -> show t ++ "&" + PInt _ -> "int" + PBool _ -> "bool" + PStr _ -> "string" + PNull -> "null" + +instance (Monad m, LatteIO m) => LatteIO (InterpreterM m) where + readInt = lift $ lift readInt + readString = lift $ lift readString + error s = lift $ lift $ LatteIO.error s + printInt n = lift $ lift $ printInt n + printString s = lift $ lift $ printString s + printErrorString s = lift $ lift $ printErrorString s + doesDirectoryExist d = lift $ lift $ doesDirectoryExist d + doesFileExist f = lift $ lift $ doesFileExist f + readFile f = lift $ lift $ LatteIO.readFile f + writeFile f c = lift $ lift $ LatteIO.writeFile f c + exitWith c = lift $ lift $ exitWith c + exitSuccess = lift $ lift exitSuccess + exitFailure = lift $ lift exitFailure diff --git a/src/Espresso/Syntax/Abs.hs b/src/Espresso/Syntax/Abs.hs new file mode 100644 index 0000000..3b0628e --- /dev/null +++ b/src/Espresso/Syntax/Abs.hs @@ -0,0 +1,195 @@ +{-# LANGUAGE DeriveFoldable #-} +module Espresso.Syntax.Abs where + +import Data.Maybe (fromJust) + +-- Haskell module generated by the BNF converter + +class Positioned a where + pos :: a -> Maybe Pos + +unwrapPos :: Program (Maybe Pos) -> Program Pos +unwrapPos p = fromJust <$> p + +type Pos = (Int, Int) +newtype SymIdent = SymIdent String deriving (Eq, Ord, Show, Read) +newtype LabIdent = LabIdent String deriving (Eq, Ord, Show, Read) +newtype ValIdent = ValIdent String deriving (Eq, Ord, Show, Read) +data QIdent a = QIdent a SymIdent SymIdent + deriving (Eq, Ord, Show, Read, Foldable) + +instance Functor QIdent where + fmap f x = case x of + QIdent a symident1 symident2 -> QIdent (f a) symident1 symident2 +data Program a = Program a (Metadata a) [Method a] + deriving (Eq, Ord, Show, Read, Foldable) + +instance Functor Program where + fmap f x = case x of + Program a metadata methods -> Program (f a) (fmap f metadata) (map (fmap f) methods) +data Metadata a = Meta a [ClassDef a] + deriving (Eq, Ord, Show, Read, Foldable) + +instance Functor Metadata where + fmap f x = case x of + Meta a classdefs -> Meta (f a) (map (fmap f) classdefs) +data ClassDef a = ClDef a SymIdent [FieldDef a] [MethodDef a] + deriving (Eq, Ord, Show, Read, Foldable) + +instance Functor ClassDef where + fmap f x = case x of + ClDef a symident fielddefs methoddefs -> ClDef (f a) symident (map (fmap f) fielddefs) (map (fmap f) methoddefs) +data FieldDef a = FldDef a (SType a) SymIdent + deriving (Eq, Ord, Show, Read, Foldable) + +instance Functor FieldDef where + fmap f x = case x of + FldDef a stype symident -> FldDef (f a) (fmap f stype) symident +data MethodDef a = MthdDef a (FType a) (QIdent a) + deriving (Eq, Ord, Show, Read, Foldable) + +instance Functor MethodDef where + fmap f x = case x of + MthdDef a ftype qident -> MthdDef (f a) (fmap f ftype) (fmap f qident) +data FType a = FType a (SType a) [SType a] + deriving (Eq, Ord, Show, Read, Foldable) + +instance Functor FType where + fmap f x = case x of + FType a stype stypes -> FType (f a) (fmap f stype) (map (fmap f) stypes) +data SType a + = Int a + | Str a + | Bool a + | Void a + | Arr a (SType a) + | Cl a SymIdent + | Ref a (SType a) + deriving (Eq, Ord, Show, Read, Foldable) + +instance Functor SType where + fmap f x = case x of + Int a -> Int (f a) + Str a -> Str (f a) + Bool a -> Bool (f a) + Void a -> Void (f a) + Arr a stype -> Arr (f a) (fmap f stype) + Cl a symident -> Cl (f a) symident + Ref a stype -> Ref (f a) (fmap f stype) +data Method a = Mthd a (SType a) (QIdent a) [Param a] [Instr a] + deriving (Eq, Ord, Show, Read, Foldable) + +instance Functor Method where + fmap f x = case x of + Mthd a stype qident params instrs -> Mthd (f a) (fmap f stype) (fmap f qident) (map (fmap f) params) (map (fmap f) instrs) +data Param a = Param a (SType a) ValIdent + deriving (Eq, Ord, Show, Read, Foldable) + +instance Functor Param where + fmap f x = case x of + Param a stype valident -> Param (f a) (fmap f stype) valident +data Instr a + = ILabel a LabIdent + | ILabelAnn a LabIdent Integer Integer + | IVRet a + | IRet a (Val a) + | IOp a ValIdent (Val a) (Op a) (Val a) + | ISet a ValIdent (Val a) + | IStr a ValIdent String + | IUnOp a ValIdent (UnOp a) (Val a) + | IVCall a (Call a) + | ICall a ValIdent (Call a) + | IJmp a LabIdent + | ICondJmp a (Val a) LabIdent LabIdent + | ILoad a ValIdent (Val a) + | IStore a (Val a) (Val a) + | IFld a ValIdent (Val a) (QIdent a) + | IArr a ValIdent (Val a) (Val a) + | IPhi a ValIdent [PhiVariant a] + deriving (Eq, Ord, Show, Read, Foldable) + +instance Functor Instr where + fmap f x = case x of + ILabel a labident -> ILabel (f a) labident + ILabelAnn a labident integer1 integer2 -> ILabelAnn (f a) labident integer1 integer2 + IVRet a -> IVRet (f a) + IRet a val -> IRet (f a) (fmap f val) + IOp a valident val1 op val2 -> IOp (f a) valident (fmap f val1) (fmap f op) (fmap f val2) + ISet a valident val -> ISet (f a) valident (fmap f val) + IStr a valident string -> IStr (f a) valident string + IUnOp a valident unop val -> IUnOp (f a) valident (fmap f unop) (fmap f val) + IVCall a call -> IVCall (f a) (fmap f call) + ICall a valident call -> ICall (f a) valident (fmap f call) + IJmp a labident -> IJmp (f a) labident + ICondJmp a val labident1 labident2 -> ICondJmp (f a) (fmap f val) labident1 labident2 + ILoad a valident val -> ILoad (f a) valident (fmap f val) + IStore a val1 val2 -> IStore (f a) (fmap f val1) (fmap f val2) + IFld a valident val qident -> IFld (f a) valident (fmap f val) (fmap f qident) + IArr a valident val1 val2 -> IArr (f a) valident (fmap f val1) (fmap f val2) + IPhi a valident phivariants -> IPhi (f a) valident (map (fmap f) phivariants) +data PhiVariant a = PhiVar a LabIdent (Val a) + deriving (Eq, Ord, Show, Read, Foldable) + +instance Functor PhiVariant where + fmap f x = case x of + PhiVar a labident val -> PhiVar (f a) labident (fmap f val) +data Call a + = Call a (SType a) (QIdent a) [Val a] + | CallVirt a (SType a) (QIdent a) [Val a] + deriving (Eq, Ord, Show, Read, Foldable) + +instance Functor Call where + fmap f x = case x of + Call a stype qident vals -> Call (f a) (fmap f stype) (fmap f qident) (map (fmap f) vals) + CallVirt a stype qident vals -> CallVirt (f a) (fmap f stype) (fmap f qident) (map (fmap f) vals) +data Val a + = VInt a Integer + | VNegInt a Integer + | VTrue a + | VFalse a + | VNull a + | VVal a (SType a) ValIdent + deriving (Eq, Ord, Show, Read, Foldable) + +instance Functor Val where + fmap f x = case x of + VInt a integer -> VInt (f a) integer + VNegInt a integer -> VNegInt (f a) integer + VTrue a -> VTrue (f a) + VFalse a -> VFalse (f a) + VNull a -> VNull (f a) + VVal a stype valident -> VVal (f a) (fmap f stype) valident +data Op a + = OpAdd a + | OpSub a + | OpMul a + | OpDiv a + | OpMod a + | OpLTH a + | OpLE a + | OpGTH a + | OpGE a + | OpEQU a + | OpNE a + deriving (Eq, Ord, Show, Read, Foldable) + +instance Functor Op where + fmap f x = case x of + OpAdd a -> OpAdd (f a) + OpSub a -> OpSub (f a) + OpMul a -> OpMul (f a) + OpDiv a -> OpDiv (f a) + OpMod a -> OpMod (f a) + OpLTH a -> OpLTH (f a) + OpLE a -> OpLE (f a) + OpGTH a -> OpGTH (f a) + OpGE a -> OpGE (f a) + OpEQU a -> OpEQU (f a) + OpNE a -> OpNE (f a) +data UnOp a = UnOpNeg a | UnOpNot a + deriving (Eq, Ord, Show, Read, Foldable) + +instance Functor UnOp where + fmap f x = case x of + UnOpNeg a -> UnOpNeg (f a) + UnOpNot a -> UnOpNot (f a) diff --git a/src/Espresso/Syntax/Espresso.cf b/src/Espresso/Syntax/Espresso.cf new file mode 100644 index 0000000..30365c7 --- /dev/null +++ b/src/Espresso/Syntax/Espresso.cf @@ -0,0 +1,96 @@ +entrypoints Program ; + +-- Override Ident definition to allow leading '~' for internal names. +token SymIdent (letter | '~') (letter | digit | '_' | '\'')* ; + +token LabIdent '.' 'L' '_' (letter | digit | '_' | '\'')* ; + +-- Values are %v_x, arguments are %a_x. +token ValIdent '%' ('v' | 'a') '_' (letter | digit | '_' | '\'')* ; + +QIdent. QIdent ::= SymIdent "." SymIdent ; + +Program. Program ::= Metadata [Method] ; + +Meta. Metadata ::= ".metadata" ":" "[" ".classes" ":" "[" [ClassDef] "]" "]"; + +ClDef. ClassDef ::= SymIdent ":" "[" ".fields" ":" "[" [FieldDef] "]" ".methods" ":" "[" [MethodDef] "]" "]" ; + +FldDef. FieldDef ::= SType SymIdent ; + +MthdDef. MethodDef ::= FType QIdent; + +terminator FieldDef ";" ; +terminator MethodDef ";" ; +separator ClassDef "" ; + +FType. FType ::= SType "(" [SType] ")" ; + +Int. SType ::= "int" ; +Str. SType ::= "string" ; +Bool. SType ::= "boolean" ; +Void. SType ::= "void" ; +Arr. SType ::= SType "[]" ; +Cl. SType ::= SymIdent ; +Ref. SType ::= SType "&" ; + +separator SType "," ; + +Mthd. Method ::= ".method " SType QIdent "(" [Param] ")" ":" "[" [Instr] "]" ; + +Param. Param ::= SType ValIdent ; +separator Param "," ; + +separator Method "" ; + +ILabel. Instr ::= LabIdent ":" ; +ILabelAnn. Instr ::= LabIdent ":" "(" "lines" Integer "to" Integer ")" ; +IVRet. Instr ::= "return" ";" ; +IRet. Instr ::= "return" Val ";" ; +IOp. Instr ::= ValIdent ":=" Val Op Val ";" ; +ISet. Instr ::= ValIdent ":=" Val ";" ; +IStr. Instr ::= ValIdent ":=" String ";" ; +IUnOp. Instr ::= ValIdent ":=" UnOp Val ";" ; +IVCall. Instr ::= Call ";" ; +ICall. Instr ::= ValIdent ":=" Call ";" ; +IJmp. Instr ::= "jump" LabIdent ";" ; +ICondJmp. Instr ::= "jump" "if" Val "then" LabIdent "else" LabIdent ";" ; +ILoad. Instr ::= ValIdent ":=" "load" Val ";" ; +IStore. Instr ::= "store" Val Val ";" ; +IFld. Instr ::= ValIdent ":=" "fldptr" Val QIdent ";" ; +IArr. Instr ::= ValIdent ":=" "elemptr" Val "[" Val "]" ";" ; +IPhi. Instr ::= ValIdent ":=" "phi" "(" [PhiVariant] ")" ";" ; + +PhiVar. PhiVariant ::= LabIdent ":" Val ; + +Call. Call ::= "call" SType QIdent "(" [Val] ")" ; +CallVirt. Call ::= "callvirt" SType QIdent "(" [Val] ")" ; + +separator Instr "" ; +separator Val "," ; +separator PhiVariant "," ; + +VInt. Val ::= Integer ; +VNegInt. Val ::= "-" Integer ; +VTrue. Val ::= "true" ; +VFalse. Val ::= "false" ; +VNull. Val ::= "null" ; +VVal. Val ::= SType ValIdent ; + +OpAdd. Op ::= "+" ; +OpSub. Op ::= "-" ; +OpMul. Op ::= "*" ; +OpDiv. Op ::= "/" ; +OpMod. Op ::= "%" ; +OpLTH. Op ::= "<" ; +OpLE. Op ::= "<=" ; +OpGTH. Op ::= ">" ; +OpGE. Op ::= ">=" ; +OpEQU. Op ::= "==" ; +OpNE. Op ::= "!=" ; + +UnOpNeg. UnOp ::= "-" ; +UnOpNot. UnOp ::= "!" ; + +comment "//" ; +comment "/*" "*/" ; \ No newline at end of file diff --git a/src/Espresso/Syntax/Lexer.hs b/src/Espresso/Syntax/Lexer.hs new file mode 100644 index 0000000..697bb8e --- /dev/null +++ b/src/Espresso/Syntax/Lexer.hs @@ -0,0 +1,520 @@ +{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-} +{-# LANGUAGE CPP,MagicHash #-} +{-# LINE 3 "LexEspresso.x" #-} + +{-# OPTIONS -fno-warn-incomplete-patterns #-} +{-# OPTIONS_GHC -w #-} +module Espresso.Syntax.Lexer where + +import qualified Data.Bits +import Data.Word (Word8) +import Data.Char (ord) + +#if __GLASGOW_HASKELL__ >= 603 +#include "ghcconfig.h" +#elif defined(__GLASGOW_HASKELL__) +#include "config.h" +#endif +#if __GLASGOW_HASKELL__ >= 503 +import Data.Array +import Data.Array.Base (unsafeAt) +#else +import Array +#endif +#if __GLASGOW_HASKELL__ >= 503 +import GHC.Exts +#else +import GlaExts +#endif +alex_tab_size :: Int +alex_tab_size = 8 +alex_base :: AlexAddr +alex_base = AlexA# + "\xf8\xff\xff\xff\x49\x00\x00\x00\xc9\xff\xff\xff\xa6\xff\xff\xff\x95\xff\xff\xff\xaa\xff\xff\xff\xab\xff\xff\xff\xc9\x00\x00\x00\x9c\xff\xff\xff\xa7\xff\xff\xff\x49\x01\x00\x00\xac\xff\xff\xff\x9b\xff\xff\xff\xad\xff\xff\xff\x9d\xff\xff\xff\xae\xff\xff\xff\xa8\xff\xff\xff\xb3\xff\xff\xff\xa3\xff\xff\xff\xa1\xff\xff\xff\xb2\xff\xff\xff\xaf\xff\xff\xff\x13\x00\x00\x00\x49\x02\x00\x00\x09\x02\x00\x00\x00\x00\x00\x00\x7a\x02\x00\x00\x7a\x03\x00\x00\x53\x00\x00\x00\x3a\x03\x00\x00\xb8\xff\xff\xff\xc3\xff\xff\xff\x10\x04\x00\x00\x00\x00\x00\x00\x7c\x03\x00\x00\x10\x05\x00\x00\x11\x05\x00\x00\x54\x05\x00\x00\x94\x05\x00\x00\xbb\xff\xff\xff\x54\x06\x00\x00\x14\x06\x00\x00\x00\x00\x00\x00\x0a\x07\x00\x00\x00\x00\x00\x00\x73\x00\x00\x00\x57\x00\x00\x00\xda\xff\xff\xff\xdb\xff\xff\xff\xe1\xff\xff\xff\x16\x00\x00\x00\x00\x00\x00\x00\x36\x00\x00\x00\xe3\x07\x00\x00\x46\x08\x00\x00\xa9\x08\x00\x00\x00\x00\x00\x00\x74\x00\x00\x00"# + +alex_table :: AlexAddr +alex_table = AlexA# + "\x00\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x33\x00\x33\x00\x33\x00\x36\x00\x37\x00\x27\x00\x04\x00\x1f\x00\x09\x00\x11\x00\x0c\x00\x0d\x00\x15\x00\x13\x00\x0e\x00\x16\x00\x0b\x00\x33\x00\x2d\x00\x2f\x00\x23\x00\x1e\x00\x04\x00\x32\x00\x33\x00\x31\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x34\x00\x2e\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x2f\x00\x33\x00\x2f\x00\x02\x00\x2f\x00\x03\x00\x33\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x30\x00\x33\x00\x33\x00\x00\x00\x00\x00\x00\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x01\x00\x14\x00\x23\x00\x35\x00\x06\x00\x2c\x00\x00\x00\x23\x00\x08\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x20\x00\x05\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0f\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x39\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x23\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x17\x00\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x07\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x29\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x17\x00\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x00\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x38\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x1c\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x00\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x00\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x00\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x00\x00\x1b\x00\x1d\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x00\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x00\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x00\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x00\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x28\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x29\x00\x07\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x22\x00\x0a\x00\x19\x00\x19\x00\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x00\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x36\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x00\x00\x00\x00\x00\x00\x00\x00\x36\x00\x26\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x25\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +alex_check :: AlexAddr +alex_check = AlexA# + "\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x3d\x00\x61\x00\x73\x00\x5f\x00\x5f\x00\x6f\x00\x65\x00\x61\x00\x73\x00\x6c\x00\x73\x00\x69\x00\x65\x00\x65\x00\x61\x00\x74\x00\x64\x00\x3d\x00\x20\x00\x21\x00\x22\x00\x6c\x00\x64\x00\x25\x00\x26\x00\x64\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x74\x00\x5d\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x73\x00\x5d\x00\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x2a\x00\x61\x00\x22\x00\x7e\x00\x61\x00\x2f\x00\xff\xff\x27\x00\x68\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x2a\x00\x4c\x00\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6d\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x2a\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xff\xff\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xff\xff\xc2\x00\xc3\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xff\xff\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xff\xff\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xc3\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +alex_deflt :: AlexAddr +alex_deflt = AlexA# + "\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x20\x00\x21\x00\x21\x00\x23\x00\xff\xff\x23\x00\xff\xff\xff\xff\x20\x00\x2a\x00\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x00\x2b\x00\x2b\x00\x2b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +alex_accept = listArray (0 :: Int, 57) + [ AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccSkip + , AlexAccSkip + , AlexAccSkip + , AlexAcc 11 + , AlexAcc 10 + , AlexAcc 9 + , AlexAcc 8 + , AlexAcc 7 + , AlexAcc 6 + , AlexAcc 5 + , AlexAcc 4 + , AlexAcc 3 + , AlexAcc 2 + , AlexAcc 1 + , AlexAcc 0 + ] + +alex_actions = array (0 :: Int, 12) + [ (11,alex_action_3) + , (10,alex_action_3) + , (9,alex_action_3) + , (8,alex_action_3) + , (7,alex_action_3) + , (6,alex_action_3) + , (5,alex_action_3) + , (4,alex_action_4) + , (3,alex_action_5) + , (2,alex_action_6) + , (1,alex_action_8) + , (0,alex_action_9) + ] + +{-# LINE 42 "LexEspresso.x" #-} + + +tok :: (Posn -> String -> Token) -> (Posn -> String -> Token) +tok f p s = f p s + +share :: String -> String +share = id + +data Tok = + TS !String !Int -- reserved words and symbols + | TL !String -- string literals + | TI !String -- integer literals + | TV !String -- identifiers + | TD !String -- double precision float literals + | TC !String -- character literals + | T_SymIdent !String + | T_LabIdent !String + | T_ValIdent !String + + deriving (Eq,Show,Ord) + +data Token = + PT Posn Tok + | Err Posn + deriving (Eq,Show,Ord) + +printPosn :: Posn -> String +printPosn (Pn _ l c) = "line " ++ show l ++ ", column " ++ show c + +tokenPos :: [Token] -> String +tokenPos (t:_) = printPosn (tokenPosn t) +tokenPos [] = "end of file" + +tokenPosn :: Token -> Posn +tokenPosn (PT p _) = p +tokenPosn (Err p) = p + +tokenLineCol :: Token -> (Int, Int) +tokenLineCol = posLineCol . tokenPosn + +posLineCol :: Posn -> (Int, Int) +posLineCol (Pn _ l c) = (l,c) + +mkPosToken :: Token -> ((Int, Int), String) +mkPosToken t@(PT p _) = (posLineCol p, prToken t) + +prToken :: Token -> String +prToken t = case t of + PT _ (TS s _) -> s + PT _ (TL s) -> show s + PT _ (TI s) -> s + PT _ (TV s) -> s + PT _ (TD s) -> s + PT _ (TC s) -> s + Err _ -> "#error" + PT _ (T_SymIdent s) -> s + PT _ (T_LabIdent s) -> s + PT _ (T_ValIdent s) -> s + + +data BTree = N | B String Tok BTree BTree deriving (Show) + +eitherResIdent :: (String -> Tok) -> String -> Tok +eitherResIdent tv s = treeFind resWords + where + treeFind N = tv s + treeFind (B a t left right) | s < a = treeFind left + | s > a = treeFind right + | s == a = t + +resWords :: BTree +resWords = b ">=" 25 (b ".fields" 13 (b "*" 7 (b "&" 4 (b "!=" 2 (b "!" 1 N N) (b "%" 3 N N)) (b ")" 6 (b "(" 5 N N) N)) (b "-" 10 (b "," 9 (b "+" 8 N N) N) (b ".classes" 12 (b "." 11 N N) N))) (b ":=" 19 (b ".methods" 16 (b ".method" 15 (b ".metadata" 14 N N) N) (b ":" 18 (b "/" 17 N N) N)) (b "<=" 22 (b "<" 21 (b ";" 20 N N) N) (b ">" 24 (b "==" 23 N N) N)))) (b "jump" 38 (b "elemptr" 32 (b "boolean" 29 (b "[]" 27 (b "[" 26 N N) (b "]" 28 N N)) (b "callvirt" 31 (b "call" 30 N N) N)) (b "fldptr" 35 (b "false" 34 (b "else" 33 N N) N) (b "int" 37 (b "if" 36 N N) N))) (b "store" 44 (b "null" 41 (b "load" 40 (b "lines" 39 N N) N) (b "return" 43 (b "phi" 42 N N) N)) (b "to" 47 (b "then" 46 (b "string" 45 N N) N) (b "void" 49 (b "true" 48 N N) N)))) + where b s n = let bs = id s + in B bs (TS bs n) + +unescapeInitTail :: String -> String +unescapeInitTail = id . unesc . tail . id where + unesc s = case s of + '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs + '\\':'n':cs -> '\n' : unesc cs + '\\':'t':cs -> '\t' : unesc cs + '"':[] -> [] + c:cs -> c : unesc cs + _ -> [] + +------------------------------------------------------------------- +-- Alex wrapper code. +-- A modified "posn" wrapper. +------------------------------------------------------------------- + +data Posn = Pn !Int !Int !Int + deriving (Eq, Show,Ord) + +alexStartPos :: Posn +alexStartPos = Pn 0 1 1 + +alexMove :: Posn -> Char -> Posn +alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1) +alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1 +alexMove (Pn a l c) _ = Pn (a+1) l (c+1) + +type Byte = Word8 + +type AlexInput = (Posn, -- current position, + Char, -- previous char + [Byte], -- pending bytes on the current char + String) -- current input string + +tokens :: String -> [Token] +tokens str = go (alexStartPos, '\n', [], str) + where + go :: AlexInput -> [Token] + go inp@(pos, _, _, str) = + case alexScan inp 0 of + AlexEOF -> [] + AlexError (pos, _, _, _) -> [Err pos] + AlexSkip inp' len -> go inp' + AlexToken inp' len act -> act pos (take len str) : (go inp') + +alexGetByte :: AlexInput -> Maybe (Byte,AlexInput) +alexGetByte (p, c, (b:bs), s) = Just (b, (p, c, bs, s)) +alexGetByte (p, _, [], s) = + case s of + [] -> Nothing + (c:s) -> + let p' = alexMove p c + (b:bs) = utf8Encode c + in p' `seq` Just (b, (p', c, bs, s)) + +alexInputPrevChar :: AlexInput -> Char +alexInputPrevChar (p, c, bs, s) = c + +-- | Encode a Haskell String to a list of Word8 values, in UTF8 format. +utf8Encode :: Char -> [Word8] +utf8Encode = map fromIntegral . go . ord + where + go oc + | oc <= 0x7f = [oc] + + | oc <= 0x7ff = [ 0xc0 + (oc `Data.Bits.shiftR` 6) + , 0x80 + oc Data.Bits..&. 0x3f + ] + + | oc <= 0xffff = [ 0xe0 + (oc `Data.Bits.shiftR` 12) + , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f) + , 0x80 + oc Data.Bits..&. 0x3f + ] + | otherwise = [ 0xf0 + (oc `Data.Bits.shiftR` 18) + , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f) + , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f) + , 0x80 + oc Data.Bits..&. 0x3f + ] + +alex_action_3 = tok (\p s -> PT p (eitherResIdent (TV . share) s)) +alex_action_4 = tok (\p s -> PT p (eitherResIdent (T_SymIdent . share) s)) +alex_action_5 = tok (\p s -> PT p (eitherResIdent (T_LabIdent . share) s)) +alex_action_6 = tok (\p s -> PT p (eitherResIdent (T_ValIdent . share) s)) +alex_action_7 = tok (\p s -> PT p (eitherResIdent (TV . share) s)) +alex_action_8 = tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) +alex_action_9 = tok (\p s -> PT p (TI $ share s)) +{-# LINE 1 "templates/GenericTemplate.hs" #-} +-- ----------------------------------------------------------------------------- +-- ALEX TEMPLATE +-- +-- This code is in the PUBLIC DOMAIN; you may copy it freely and use +-- it for any purpose whatsoever. + +-- ----------------------------------------------------------------------------- +-- INTERNALS and main scanner engine + + + + + + + + + + + + + + + + + +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. +#if __GLASGOW_HASKELL__ > 706 +#define GTE(n,m) (tagToEnum# (n >=# m)) +#define EQ(n,m) (tagToEnum# (n ==# m)) +#else +#define GTE(n,m) (n >=# m) +#define EQ(n,m) (n ==# m) +#endif + + + + + + + + + + + + + + + + + + + +data AlexAddr = AlexA# Addr# +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. +#if __GLASGOW_HASKELL__ < 503 +uncheckedShiftL# = shiftL# +#endif + +{-# INLINE alexIndexInt16OffAddr #-} +alexIndexInt16OffAddr (AlexA# arr) off = +#ifdef WORDS_BIGENDIAN + narrow16Int# i + where + i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) + high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) + low = int2Word# (ord# (indexCharOffAddr# arr off')) + off' = off *# 2# +#else + indexInt16OffAddr# arr off +#endif + + + + + +{-# INLINE alexIndexInt32OffAddr #-} +alexIndexInt32OffAddr (AlexA# arr) off = +#ifdef WORDS_BIGENDIAN + narrow32Int# i + where + i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#` + (b2 `uncheckedShiftL#` 16#) `or#` + (b1 `uncheckedShiftL#` 8#) `or#` b0) + b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#))) + b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#))) + b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) + b0 = int2Word# (ord# (indexCharOffAddr# arr off')) + off' = off *# 4# +#else + indexInt32OffAddr# arr off +#endif + + + + + + +#if __GLASGOW_HASKELL__ < 503 +quickIndex arr i = arr ! i +#else +-- GHC >= 503, unsafeAt is available from Data.Array.Base. +quickIndex = unsafeAt +#endif + + + + +-- ----------------------------------------------------------------------------- +-- Main lexing routines + +data AlexReturn a + = AlexEOF + | AlexError !AlexInput + | AlexSkip !AlexInput !Int + | AlexToken !AlexInput !Int a + +-- alexScan :: AlexInput -> StartCode -> AlexReturn a +alexScan input__ (I# (sc)) + = alexScanUser undefined input__ (I# (sc)) + +alexScanUser user__ input__ (I# (sc)) + = case alex_scan_tkn user__ input__ 0# input__ sc AlexNone of + (AlexNone, input__') -> + case alexGetByte input__ of + Nothing -> + + + + AlexEOF + Just _ -> + + + + AlexError input__' + + (AlexLastSkip input__'' len, _) -> + + + + AlexSkip input__'' len + + (AlexLastAcc k input__''' len, _) -> + + + + AlexToken input__''' len (alex_actions ! k) + + +-- Push the input through the DFA, remembering the most recent accepting +-- state it encountered. + +alex_scan_tkn user__ orig_input len input__ s last_acc = + input__ `seq` -- strict in the input + let + new_acc = (check_accs (alex_accept `quickIndex` (I# (s)))) + in + new_acc `seq` + case alexGetByte input__ of + Nothing -> (new_acc, input__) + Just (c, new_input) -> + + + + case fromIntegral c of { (I# (ord_c)) -> + let + base = alexIndexInt32OffAddr alex_base s + offset = (base +# ord_c) + check = alexIndexInt16OffAddr alex_check offset + + new_s = if GTE(offset,0#) && EQ(check,ord_c) + then alexIndexInt16OffAddr alex_table offset + else alexIndexInt16OffAddr alex_deflt s + in + case new_s of + -1# -> (new_acc, input__) + -- on an error, we want to keep the input *before* the + -- character that failed, not after. + _ -> alex_scan_tkn user__ orig_input (if c < 0x80 || c >= 0xC0 then (len +# 1#) else len) + -- note that the length is increased ONLY if this is the 1st byte in a char encoding) + new_input new_s new_acc + } + where + check_accs (AlexAccNone) = last_acc + check_accs (AlexAcc a ) = AlexLastAcc a input__ (I# (len)) + check_accs (AlexAccSkip) = AlexLastSkip input__ (I# (len)) + + + + + + + + + + + + + +data AlexLastAcc + = AlexNone + | AlexLastAcc !Int !AlexInput !Int + | AlexLastSkip !AlexInput !Int + +data AlexAcc user + = AlexAccNone + | AlexAcc Int + | AlexAccSkip + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/src/Espresso/Syntax/Parser.hs b/src/Espresso/Syntax/Parser.hs new file mode 100644 index 0000000..de858c5 --- /dev/null +++ b/src/Espresso/Syntax/Parser.hs @@ -0,0 +1,1777 @@ +{-# OPTIONS_GHC -w #-} +{-# OPTIONS -XMagicHash -XBangPatterns -XTypeSynonymInstances -XFlexibleInstances -cpp #-} +#if __GLASGOW_HASKELL__ >= 710 +{-# OPTIONS_GHC -XPartialTypeSignatures #-} +#endif +{-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-} +module Espresso.Syntax.Parser where +import Espresso.Syntax.Abs as Abs +import Espresso.Syntax.Lexer +import ErrM +import qualified Data.Array as Happy_Data_Array +import qualified Data.Bits as Bits +import qualified GHC.Exts as Happy_GHC_Exts +import Control.Applicative(Applicative(..)) +import Control.Monad (ap) + +-- parser produced by Happy Version 1.19.11 + +newtype HappyAbsSyn = HappyAbsSyn HappyAny +#if __GLASGOW_HASKELL__ >= 607 +type HappyAny = Happy_GHC_Exts.Any +#else +type HappyAny = forall a . a +#endif +newtype HappyWrap4 = HappyWrap4 ((Maybe (Int, Int), Integer)) +happyIn4 :: ((Maybe (Int, Int), Integer)) -> (HappyAbsSyn ) +happyIn4 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap4 x) +{-# INLINE happyIn4 #-} +happyOut4 :: (HappyAbsSyn ) -> HappyWrap4 +happyOut4 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut4 #-} +newtype HappyWrap5 = HappyWrap5 ((Maybe (Int, Int), String)) +happyIn5 :: ((Maybe (Int, Int), String)) -> (HappyAbsSyn ) +happyIn5 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap5 x) +{-# INLINE happyIn5 #-} +happyOut5 :: (HappyAbsSyn ) -> HappyWrap5 +happyOut5 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut5 #-} +newtype HappyWrap6 = HappyWrap6 ((Maybe (Int, Int), SymIdent)) +happyIn6 :: ((Maybe (Int, Int), SymIdent)) -> (HappyAbsSyn ) +happyIn6 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap6 x) +{-# INLINE happyIn6 #-} +happyOut6 :: (HappyAbsSyn ) -> HappyWrap6 +happyOut6 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut6 #-} +newtype HappyWrap7 = HappyWrap7 ((Maybe (Int, Int), LabIdent)) +happyIn7 :: ((Maybe (Int, Int), LabIdent)) -> (HappyAbsSyn ) +happyIn7 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap7 x) +{-# INLINE happyIn7 #-} +happyOut7 :: (HappyAbsSyn ) -> HappyWrap7 +happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut7 #-} +newtype HappyWrap8 = HappyWrap8 ((Maybe (Int, Int), ValIdent)) +happyIn8 :: ((Maybe (Int, Int), ValIdent)) -> (HappyAbsSyn ) +happyIn8 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap8 x) +{-# INLINE happyIn8 #-} +happyOut8 :: (HappyAbsSyn ) -> HappyWrap8 +happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut8 #-} +newtype HappyWrap9 = HappyWrap9 ((Maybe (Int, Int), QIdent (Maybe (Int, Int)))) +happyIn9 :: ((Maybe (Int, Int), QIdent (Maybe (Int, Int)))) -> (HappyAbsSyn ) +happyIn9 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap9 x) +{-# INLINE happyIn9 #-} +happyOut9 :: (HappyAbsSyn ) -> HappyWrap9 +happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut9 #-} +newtype HappyWrap10 = HappyWrap10 ((Maybe (Int, Int), Program (Maybe (Int, Int)))) +happyIn10 :: ((Maybe (Int, Int), Program (Maybe (Int, Int)))) -> (HappyAbsSyn ) +happyIn10 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap10 x) +{-# INLINE happyIn10 #-} +happyOut10 :: (HappyAbsSyn ) -> HappyWrap10 +happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut10 #-} +newtype HappyWrap11 = HappyWrap11 ((Maybe (Int, Int), Metadata (Maybe (Int, Int)))) +happyIn11 :: ((Maybe (Int, Int), Metadata (Maybe (Int, Int)))) -> (HappyAbsSyn ) +happyIn11 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap11 x) +{-# INLINE happyIn11 #-} +happyOut11 :: (HappyAbsSyn ) -> HappyWrap11 +happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut11 #-} +newtype HappyWrap12 = HappyWrap12 ((Maybe (Int, Int), ClassDef (Maybe (Int, Int)))) +happyIn12 :: ((Maybe (Int, Int), ClassDef (Maybe (Int, Int)))) -> (HappyAbsSyn ) +happyIn12 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap12 x) +{-# INLINE happyIn12 #-} +happyOut12 :: (HappyAbsSyn ) -> HappyWrap12 +happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut12 #-} +newtype HappyWrap13 = HappyWrap13 ((Maybe (Int, Int), FieldDef (Maybe (Int, Int)))) +happyIn13 :: ((Maybe (Int, Int), FieldDef (Maybe (Int, Int)))) -> (HappyAbsSyn ) +happyIn13 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap13 x) +{-# INLINE happyIn13 #-} +happyOut13 :: (HappyAbsSyn ) -> HappyWrap13 +happyOut13 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut13 #-} +newtype HappyWrap14 = HappyWrap14 ((Maybe (Int, Int), MethodDef (Maybe (Int, Int)))) +happyIn14 :: ((Maybe (Int, Int), MethodDef (Maybe (Int, Int)))) -> (HappyAbsSyn ) +happyIn14 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap14 x) +{-# INLINE happyIn14 #-} +happyOut14 :: (HappyAbsSyn ) -> HappyWrap14 +happyOut14 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut14 #-} +newtype HappyWrap15 = HappyWrap15 ((Maybe (Int, Int), [FieldDef (Maybe (Int, Int))])) +happyIn15 :: ((Maybe (Int, Int), [FieldDef (Maybe (Int, Int))])) -> (HappyAbsSyn ) +happyIn15 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap15 x) +{-# INLINE happyIn15 #-} +happyOut15 :: (HappyAbsSyn ) -> HappyWrap15 +happyOut15 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut15 #-} +newtype HappyWrap16 = HappyWrap16 ((Maybe (Int, Int), [MethodDef (Maybe (Int, Int))])) +happyIn16 :: ((Maybe (Int, Int), [MethodDef (Maybe (Int, Int))])) -> (HappyAbsSyn ) +happyIn16 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap16 x) +{-# INLINE happyIn16 #-} +happyOut16 :: (HappyAbsSyn ) -> HappyWrap16 +happyOut16 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut16 #-} +newtype HappyWrap17 = HappyWrap17 ((Maybe (Int, Int), [ClassDef (Maybe (Int, Int))])) +happyIn17 :: ((Maybe (Int, Int), [ClassDef (Maybe (Int, Int))])) -> (HappyAbsSyn ) +happyIn17 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap17 x) +{-# INLINE happyIn17 #-} +happyOut17 :: (HappyAbsSyn ) -> HappyWrap17 +happyOut17 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut17 #-} +newtype HappyWrap18 = HappyWrap18 ((Maybe (Int, Int), FType (Maybe (Int, Int)))) +happyIn18 :: ((Maybe (Int, Int), FType (Maybe (Int, Int)))) -> (HappyAbsSyn ) +happyIn18 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap18 x) +{-# INLINE happyIn18 #-} +happyOut18 :: (HappyAbsSyn ) -> HappyWrap18 +happyOut18 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut18 #-} +newtype HappyWrap19 = HappyWrap19 ((Maybe (Int, Int), SType (Maybe (Int, Int)))) +happyIn19 :: ((Maybe (Int, Int), SType (Maybe (Int, Int)))) -> (HappyAbsSyn ) +happyIn19 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap19 x) +{-# INLINE happyIn19 #-} +happyOut19 :: (HappyAbsSyn ) -> HappyWrap19 +happyOut19 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut19 #-} +newtype HappyWrap20 = HappyWrap20 ((Maybe (Int, Int), [SType (Maybe (Int, Int))])) +happyIn20 :: ((Maybe (Int, Int), [SType (Maybe (Int, Int))])) -> (HappyAbsSyn ) +happyIn20 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap20 x) +{-# INLINE happyIn20 #-} +happyOut20 :: (HappyAbsSyn ) -> HappyWrap20 +happyOut20 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut20 #-} +newtype HappyWrap21 = HappyWrap21 ((Maybe (Int, Int), Method (Maybe (Int, Int)))) +happyIn21 :: ((Maybe (Int, Int), Method (Maybe (Int, Int)))) -> (HappyAbsSyn ) +happyIn21 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap21 x) +{-# INLINE happyIn21 #-} +happyOut21 :: (HappyAbsSyn ) -> HappyWrap21 +happyOut21 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut21 #-} +newtype HappyWrap22 = HappyWrap22 ((Maybe (Int, Int), Param (Maybe (Int, Int)))) +happyIn22 :: ((Maybe (Int, Int), Param (Maybe (Int, Int)))) -> (HappyAbsSyn ) +happyIn22 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap22 x) +{-# INLINE happyIn22 #-} +happyOut22 :: (HappyAbsSyn ) -> HappyWrap22 +happyOut22 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut22 #-} +newtype HappyWrap23 = HappyWrap23 ((Maybe (Int, Int), [Param (Maybe (Int, Int))])) +happyIn23 :: ((Maybe (Int, Int), [Param (Maybe (Int, Int))])) -> (HappyAbsSyn ) +happyIn23 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap23 x) +{-# INLINE happyIn23 #-} +happyOut23 :: (HappyAbsSyn ) -> HappyWrap23 +happyOut23 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut23 #-} +newtype HappyWrap24 = HappyWrap24 ((Maybe (Int, Int), [Method (Maybe (Int, Int))])) +happyIn24 :: ((Maybe (Int, Int), [Method (Maybe (Int, Int))])) -> (HappyAbsSyn ) +happyIn24 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap24 x) +{-# INLINE happyIn24 #-} +happyOut24 :: (HappyAbsSyn ) -> HappyWrap24 +happyOut24 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut24 #-} +newtype HappyWrap25 = HappyWrap25 ((Maybe (Int, Int), Instr (Maybe (Int, Int)))) +happyIn25 :: ((Maybe (Int, Int), Instr (Maybe (Int, Int)))) -> (HappyAbsSyn ) +happyIn25 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap25 x) +{-# INLINE happyIn25 #-} +happyOut25 :: (HappyAbsSyn ) -> HappyWrap25 +happyOut25 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut25 #-} +newtype HappyWrap26 = HappyWrap26 ((Maybe (Int, Int), PhiVariant (Maybe (Int, Int)))) +happyIn26 :: ((Maybe (Int, Int), PhiVariant (Maybe (Int, Int)))) -> (HappyAbsSyn ) +happyIn26 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap26 x) +{-# INLINE happyIn26 #-} +happyOut26 :: (HappyAbsSyn ) -> HappyWrap26 +happyOut26 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut26 #-} +newtype HappyWrap27 = HappyWrap27 ((Maybe (Int, Int), Call (Maybe (Int, Int)))) +happyIn27 :: ((Maybe (Int, Int), Call (Maybe (Int, Int)))) -> (HappyAbsSyn ) +happyIn27 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap27 x) +{-# INLINE happyIn27 #-} +happyOut27 :: (HappyAbsSyn ) -> HappyWrap27 +happyOut27 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut27 #-} +newtype HappyWrap28 = HappyWrap28 ((Maybe (Int, Int), [Instr (Maybe (Int, Int))])) +happyIn28 :: ((Maybe (Int, Int), [Instr (Maybe (Int, Int))])) -> (HappyAbsSyn ) +happyIn28 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap28 x) +{-# INLINE happyIn28 #-} +happyOut28 :: (HappyAbsSyn ) -> HappyWrap28 +happyOut28 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut28 #-} +newtype HappyWrap29 = HappyWrap29 ((Maybe (Int, Int), [Val (Maybe (Int, Int))])) +happyIn29 :: ((Maybe (Int, Int), [Val (Maybe (Int, Int))])) -> (HappyAbsSyn ) +happyIn29 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap29 x) +{-# INLINE happyIn29 #-} +happyOut29 :: (HappyAbsSyn ) -> HappyWrap29 +happyOut29 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut29 #-} +newtype HappyWrap30 = HappyWrap30 ((Maybe (Int, Int), [PhiVariant (Maybe (Int, Int))])) +happyIn30 :: ((Maybe (Int, Int), [PhiVariant (Maybe (Int, Int))])) -> (HappyAbsSyn ) +happyIn30 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap30 x) +{-# INLINE happyIn30 #-} +happyOut30 :: (HappyAbsSyn ) -> HappyWrap30 +happyOut30 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut30 #-} +newtype HappyWrap31 = HappyWrap31 ((Maybe (Int, Int), Val (Maybe (Int, Int)))) +happyIn31 :: ((Maybe (Int, Int), Val (Maybe (Int, Int)))) -> (HappyAbsSyn ) +happyIn31 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap31 x) +{-# INLINE happyIn31 #-} +happyOut31 :: (HappyAbsSyn ) -> HappyWrap31 +happyOut31 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut31 #-} +newtype HappyWrap32 = HappyWrap32 ((Maybe (Int, Int), Op (Maybe (Int, Int)))) +happyIn32 :: ((Maybe (Int, Int), Op (Maybe (Int, Int)))) -> (HappyAbsSyn ) +happyIn32 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap32 x) +{-# INLINE happyIn32 #-} +happyOut32 :: (HappyAbsSyn ) -> HappyWrap32 +happyOut32 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut32 #-} +newtype HappyWrap33 = HappyWrap33 ((Maybe (Int, Int), UnOp (Maybe (Int, Int)))) +happyIn33 :: ((Maybe (Int, Int), UnOp (Maybe (Int, Int)))) -> (HappyAbsSyn ) +happyIn33 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap33 x) +{-# INLINE happyIn33 #-} +happyOut33 :: (HappyAbsSyn ) -> HappyWrap33 +happyOut33 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut33 #-} +happyInTok :: (Token) -> (HappyAbsSyn ) +happyInTok x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyInTok #-} +happyOutTok :: (HappyAbsSyn ) -> (Token) +happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOutTok #-} + + +happyExpList :: HappyAddr +happyExpList = HappyA# "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x20\x20\x12\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x08\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x20\x20\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x08\x00\x00\x40\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x10\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x20\x20\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd0\x40\x18\x60\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x20\x20\x12\x00\x00\x00\x00\x00\x00\x00\x20\x20\x20\x12\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x20\x00\x00\x00\x00\x00\x04\x10\x20\x24\x22\x17\x00\x00\x00\x00\x00\x04\x00\x20\x24\x22\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x08\x00\x00\x40\x00\x00\x00\x00\x00\x04\x00\x20\x24\x22\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x20\x24\x22\x17\x00\x00\x00\x00\x10\x00\x00\x08\x00\x00\x10\x00\x00\x00\x00\x10\x00\x00\x08\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x04\x00\xe0\x2d\x27\x1f\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x20\x20\x12\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x8c\x05\xf2\x03\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x20\x24\x22\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x20\x24\x22\x17\x00\x00\x00\x00\x00\x04\x00\x20\x24\x22\x17\x00\x00\x00\x00\x00\x04\x00\x20\x24\x22\x17\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x04\x00\x20\x24\x22\x17\x00\x00\x00\x00\x00\x04\x00\x20\x24\x22\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x20\x24\x22\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x08\x00\x00\x10\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x20\x24\x22\x17\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x20\x24\x22\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x04\x00\x20\x24\x22\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x20\x20\x12\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x30\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x20\x20\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x02\x00\x08\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x20\x20\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +{-# NOINLINE happyExpListPerState #-} +happyExpListPerState st = + token_strs_expected + where token_strs = ["error","%dummy","%start_pProgram_internal","Integer","String","SymIdent","LabIdent","ValIdent","QIdent","Program","Metadata","ClassDef","FieldDef","MethodDef","ListFieldDef","ListMethodDef","ListClassDef","FType","SType","ListSType","Method","Param","ListParam","ListMethod","Instr","PhiVariant","Call","ListInstr","ListVal","ListPhiVariant","Val","Op","UnOp","'!'","'!='","'%'","'&'","'('","')'","'*'","'+'","','","'-'","'.'","'.classes'","'.fields'","'.metadata'","'.method'","'.methods'","'/'","':'","':='","';'","'<'","'<='","'=='","'>'","'>='","'['","'[]'","']'","'boolean'","'call'","'callvirt'","'elemptr'","'else'","'false'","'fldptr'","'if'","'int'","'jump'","'lines'","'load'","'null'","'phi'","'return'","'store'","'string'","'then'","'to'","'true'","'void'","L_integ","L_quoted","L_SymIdent","L_LabIdent","L_ValIdent","%eof"] + bit_start = st * 88 + bit_end = (st + 1) * 88 + read_bit = readArrayBit happyExpList + bits = map read_bit [bit_start..bit_end - 1] + bits_indexed = zip bits [0..87] + token_strs_expected = concatMap f bits_indexed + f (False, _) = [] + f (True, nr) = [token_strs !! nr] + +happyActOffsets :: HappyAddr +happyActOffsets = HappyA# "\x29\x00\xe8\xff\x00\x00\xf9\xff\x00\x00\x2f\x00\x48\x00\x3e\x00\x00\x00\x7e\x00\x66\x00\x85\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x99\x00\x00\x00\x00\x00\x94\x00\x00\x00\x7e\x00\x6b\x00\x00\x00\x02\x00\xa7\x00\xaf\x00\xe5\xff\xa8\x00\x00\x00\xa3\x00\xc6\x00\x7e\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\xc9\x00\xd7\x00\x00\x00\x8b\x00\xd4\x00\xce\x00\xd5\x00\xd6\x00\x00\x00\xd8\x00\x00\x00\x7e\x00\x7e\x00\x17\x00\x22\x00\x33\x00\x00\x00\x00\x00\x02\x00\x33\x00\xb8\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\xda\x00\x33\x00\x0a\x00\x0a\x00\x00\x00\x01\x00\xe6\x00\x00\x00\xe7\xff\xc8\x00\xdd\x00\xde\x00\xb1\x00\x33\x00\x00\x00\xbe\x00\x33\x00\x33\x00\x33\x00\xee\x00\x00\x00\xef\x00\xf0\x00\xca\x00\x00\x00\x00\x00\x00\x00\xe2\x00\x00\x00\x00\x00\xc4\x00\x33\x00\x33\x00\xc4\x00\xe3\x00\xc7\x00\xe4\x00\xe8\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\xe9\x00\x0a\x00\xea\x00\xed\x00\x00\x00\x00\x00\xd3\x00\xec\x00\x00\x00\x33\x00\xf1\x00\x00\x00\xf2\x00\xfa\x00\x00\x01\x01\x01\xff\x00\x03\x01\xeb\x00\xdf\x00\x00\x00\x33\x00\x00\x00\xf6\x00\xe1\x00\x33\x00\x00\x00\xf3\x00\x00\x00\xe5\x00\xf4\x00\x00\x00\x05\x01\xf9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfc\x00\x00\x00\x00\x00\x00\x00\x1d\x00\xfd\x00\xe7\x00\x0c\x00\xf7\x00\x00\x00\x7e\x00\x00\x00\x00\x00\x3c\x00\x0c\x01\x00\x00\x7e\x00\x00\x00\x00\x00"# + +happyGotoOffsets :: HappyAddr +happyGotoOffsets = HappyA# "\x57\x00\x00\x00\x00\x00\x00\x00\x04\x01\x00\x00\x00\x00\x08\x01\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x01\x93\x00\x13\x01\x00\x00\x18\x01\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x01\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\xcb\x00\x1a\x01\x07\x00\x0d\x00\x00\x00\x00\x00\x1b\x01\x6d\x00\x20\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\xd1\x00\xdb\x00\x00\x00\x59\x00\x00\x00\x16\x01\xd0\x00\x00\x00\x00\x00\x00\x00\x07\x01\x75\x00\x00\x00\x22\x01\x7b\x00\x7f\x00\x89\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x21\x01\x2d\x00\x5f\x00\x68\x00\x00\x00\xdc\x00\x00\x00\x00\x00\x8d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x01\x00\x00\x24\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x91\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x26\x01\x00\x00\x6a\x00\x00\x00\x00\x00\x83\x00\x92\x00\x00\x00\x00\x00\x00\x00\x27\x01\x00\x00\x1c\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcd\x00\x00\x00\xe0\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x00\x00\x00\x00"# + +happyAdjustOffset :: Happy_GHC_Exts.Int# -> Happy_GHC_Exts.Int# +happyAdjustOffset off = off + +happyDefActions :: HappyAddr +happyDefActions = HappyA# "\x00\x00\x00\x00\xfe\xff\x00\x00\xdd\xff\x00\x00\x00\x00\xf8\xff\xdc\xff\x00\x00\x00\x00\x00\x00\xe7\xff\x00\x00\xea\xff\xec\xff\xeb\xff\xe9\xff\xfc\xff\x00\x00\x00\x00\xe6\xff\xe8\xff\x00\x00\xef\xff\xe0\xff\x00\x00\xf9\xff\x00\x00\xdf\xff\x00\x00\x00\x00\x00\x00\xee\xff\x00\x00\x00\x00\xe0\xff\xe1\xff\xfa\xff\xde\xff\x00\x00\xf7\xff\x00\x00\x00\x00\xc7\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc6\xff\x00\x00\xe2\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfb\xff\xbf\xff\x00\x00\x00\x00\x00\x00\xbc\xff\xbb\xff\xbd\xff\x00\x00\xd9\xff\x00\x00\x00\x00\x00\x00\x00\x00\xd3\xff\x00\x00\xdb\xff\xf3\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xad\xff\xae\xff\x00\x00\x00\x00\x00\x00\x00\x00\xfd\xff\x00\x00\x00\x00\x00\x00\xd1\xff\xd8\xff\xbe\xff\x00\x00\xba\xff\xce\xff\x00\x00\xc5\xff\xc5\xff\xc2\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xaf\xff\xb5\xff\xb7\xff\xb9\xff\xb8\xff\xb6\xff\xd6\xff\xb4\xff\xb3\xff\xb0\xff\xb2\xff\xb1\xff\xd2\xff\xd5\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf5\xff\xf2\xff\x00\x00\x00\x00\xd4\xff\x00\x00\x00\x00\xcf\xff\x00\x00\xc1\xff\x00\x00\x00\x00\xc4\xff\x00\x00\x00\x00\x00\x00\xc8\xff\xc5\xff\xc9\xff\x00\x00\xc2\xff\x00\x00\xcd\xff\x00\x00\xd7\xff\x00\x00\x00\x00\xf1\xff\x00\x00\x00\x00\xca\xff\xc0\xff\xcb\xff\xc3\xff\x00\x00\xd0\xff\xcc\xff\xda\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf6\xff\xe5\xff\xf4\xff\xf0\xff\xe4\xff\x00\x00\xed\xff\xe5\xff\xe3\xff"# + +happyCheck :: HappyAddr +happyCheck = HappyA# "\xff\xff\x1c\x00\x01\x00\x1c\x00\x1d\x00\x02\x00\x04\x00\x00\x00\x02\x00\x02\x00\x02\x00\x0a\x00\x25\x00\x00\x00\x04\x00\x02\x00\x04\x00\x05\x00\x0f\x00\x10\x00\x2d\x00\x0f\x00\x0f\x00\x0f\x00\x31\x00\x34\x00\x32\x00\x34\x00\x0f\x00\x1b\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x1b\x00\x22\x00\x23\x00\x1b\x00\x25\x00\x1b\x00\x1b\x00\x28\x00\x29\x00\x2a\x00\x0a\x00\x00\x00\x2d\x00\x02\x00\x37\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x14\x00\x0e\x00\x36\x00\x1c\x00\x1d\x00\x24\x00\x0f\x00\x0a\x00\x34\x00\x1d\x00\x04\x00\x12\x00\x25\x00\x02\x00\x22\x00\x09\x00\x19\x00\x25\x00\x1b\x00\x08\x00\x2d\x00\x29\x00\x35\x00\x0f\x00\x31\x00\x2d\x00\x1d\x00\x34\x00\x30\x00\x31\x00\x32\x00\x22\x00\x34\x00\x1b\x00\x25\x00\x00\x00\x01\x00\x02\x00\x29\x00\x06\x00\x07\x00\x00\x00\x2d\x00\x02\x00\x1a\x00\x30\x00\x31\x00\x32\x00\x02\x00\x34\x00\x0f\x00\x05\x00\x00\x00\x03\x00\x02\x00\x00\x00\x0f\x00\x02\x00\x17\x00\x00\x00\x0c\x00\x02\x00\x1b\x00\x00\x00\x1d\x00\x02\x00\x19\x00\x0f\x00\x1b\x00\x00\x00\x0f\x00\x02\x00\x16\x00\x00\x00\x0f\x00\x02\x00\x1a\x00\x19\x00\x0f\x00\x1b\x00\x03\x00\x0b\x00\x1b\x00\x00\x00\x0f\x00\x02\x00\x1b\x00\x00\x00\x0f\x00\x02\x00\x1b\x00\x00\x00\x00\x00\x02\x00\x02\x00\x02\x00\x1b\x00\x12\x00\x0f\x00\x16\x00\x1b\x00\x1d\x00\x0f\x00\x1a\x00\x05\x00\x34\x00\x0f\x00\x0f\x00\x0f\x00\x25\x00\x1b\x00\x12\x00\x13\x00\x1c\x00\x1b\x00\x1e\x00\x1f\x00\x2d\x00\x1b\x00\x1b\x00\x1a\x00\x31\x00\x09\x00\x26\x00\x34\x00\x02\x00\x03\x00\x06\x00\x2b\x00\x2c\x00\x07\x00\x08\x00\x12\x00\x0a\x00\x03\x00\x04\x00\x02\x00\x1c\x00\x35\x00\x36\x00\x11\x00\x1a\x00\x02\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x0f\x00\x10\x00\x02\x00\x15\x00\x02\x00\x17\x00\x0f\x00\x02\x00\x02\x00\x12\x00\x13\x00\x05\x00\x0a\x00\x12\x00\x09\x00\x0f\x00\x0e\x00\x0f\x00\x02\x00\x02\x00\x0f\x00\x05\x00\x05\x00\x02\x00\x1a\x00\x0d\x00\x05\x00\x12\x00\x12\x00\x1a\x00\x13\x00\x32\x00\x05\x00\x14\x00\x14\x00\x14\x00\x27\x00\x32\x00\x14\x00\x14\x00\x05\x00\x05\x00\x05\x00\x14\x00\x14\x00\x2e\x00\x35\x00\x10\x00\x34\x00\x14\x00\x14\x00\x1a\x00\x12\x00\x14\x00\x32\x00\x2f\x00\x09\x00\x12\x00\x14\x00\x06\x00\x06\x00\x09\x00\x06\x00\x14\x00\x06\x00\x21\x00\x14\x00\x1a\x00\x1c\x00\x14\x00\x14\x00\x06\x00\x1c\x00\x35\x00\x02\x00\x35\x00\x32\x00\x14\x00\x11\x00\x0d\x00\x34\x00\x04\x00\x03\x00\x18\x00\x04\x00\x00\x00\x0b\x00\x00\x00\x1c\x00\x03\x00\x00\x00\x02\x00\x00\x00\x0c\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +happyTable :: HappyAddr +happyTable = HappyA# "\x00\x00\x23\x00\x53\x00\x7d\x00\x0f\x00\x0c\x00\x16\x00\x3b\x00\x0c\x00\x0c\x00\x0c\x00\x54\x00\x10\x00\x3b\x00\x16\x00\x0c\x00\x16\x00\xab\x00\xad\x00\xae\x00\x11\x00\x0d\x00\x3c\x00\x47\x00\x12\x00\x13\x00\x03\x00\x13\x00\x3c\x00\x17\x00\x0f\x00\x36\x00\x37\x00\x55\x00\x42\x00\x40\x00\x56\x00\x17\x00\x10\x00\x17\x00\x3d\x00\x57\x00\x41\x00\x58\x00\x3f\x00\x3b\x00\x11\x00\x0c\x00\xff\xff\x42\x00\x12\x00\x03\x00\x59\x00\x13\x00\x44\x00\x06\x00\x27\x00\xa9\x00\x0f\x00\x46\x00\x3c\x00\x3f\x00\x13\x00\x0f\x00\x16\x00\x07\x00\x10\x00\x20\x00\x40\x00\xb1\x00\x8b\x00\x10\x00\x8a\x00\x21\x00\x11\x00\x41\x00\x3b\x00\x0a\x00\x12\x00\x11\x00\x0f\x00\x13\x00\x42\x00\x12\x00\x03\x00\x40\x00\x13\x00\x17\x00\x10\x00\x3b\x00\x4e\x00\x0c\x00\x41\x00\x03\x00\x04\x00\x3b\x00\x11\x00\x0c\x00\x0b\x00\x42\x00\x12\x00\x03\x00\x13\x00\x13\x00\x3c\x00\x14\x00\x3b\x00\x86\x00\x0c\x00\x3b\x00\x3c\x00\x0c\x00\x4f\x00\x3b\x00\x0c\x00\x0c\x00\x50\x00\x3b\x00\x51\x00\x0c\x00\x89\x00\x3c\x00\x8a\x00\x3b\x00\x3c\x00\x0c\x00\x87\x00\x3b\x00\x3c\x00\x0c\x00\x88\x00\x9f\x00\x3c\x00\x8a\x00\x86\x00\x1b\x00\x5f\x00\x3b\x00\x3c\x00\x0c\x00\x5b\x00\x3b\x00\x3c\x00\x0c\x00\x69\x00\x3b\x00\x3b\x00\x0c\x00\x0c\x00\x0c\x00\x68\x00\x18\x00\x3c\x00\x87\x00\x67\x00\x0f\x00\x3c\x00\x9d\x00\x1a\x00\x13\x00\x3c\x00\x3c\x00\x1c\x00\x10\x00\x66\x00\x1d\x00\x1e\x00\x35\x00\x81\x00\x36\x00\x37\x00\x11\x00\x95\x00\x9c\x00\x19\x00\x12\x00\x25\x00\x38\x00\x13\x00\x6c\x00\x6d\x00\x24\x00\x39\x00\x3a\x00\x6e\x00\x6f\x00\x2b\x00\x70\x00\x30\x00\x31\x00\x0c\x00\x2a\x00\x3b\x00\x27\x00\x71\x00\x2d\x00\x0c\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\xad\x00\xb1\x00\x0c\x00\x32\x00\x0c\x00\x33\x00\x1c\x00\x0c\x00\x13\x00\x1d\x00\x27\x00\x5a\x00\xa5\x00\x29\x00\x7a\x00\x46\x00\xa6\x00\xa7\x00\x13\x00\x13\x00\x7b\x00\x59\x00\x84\x00\x13\x00\x2c\x00\x2f\x00\xab\x00\x30\x00\x4b\x00\x4c\x00\x4a\x00\x03\x00\x4e\x00\x49\x00\x5e\x00\x5d\x00\x7a\x00\x03\x00\x79\x00\x78\x00\x66\x00\x65\x00\x64\x00\x62\x00\x86\x00\x63\x00\x3b\x00\x7e\x00\x13\x00\x83\x00\x80\x00\x84\x00\x99\x00\x97\x00\x03\x00\x98\x00\x93\x00\x94\x00\x95\x00\x92\x00\x91\x00\x90\x00\x8f\x00\x9f\x00\xa4\x00\x8e\x00\xa3\x00\x9a\x00\x9c\x00\xa2\x00\xad\x00\xb0\x00\xaa\x00\x3b\x00\x1b\x00\x3b\x00\x03\x00\x07\x00\x08\x00\x1f\x00\x13\x00\x25\x00\x44\x00\x2d\x00\x60\x00\x5e\x00\x4c\x00\x5e\x00\x6a\x00\x8c\x00\x80\x00\x7e\x00\x9a\x00\xa4\x00\xa0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyReduceArr = Happy_Data_Array.array (1, 82) [ + (1 , happyReduce_1), + (2 , happyReduce_2), + (3 , happyReduce_3), + (4 , happyReduce_4), + (5 , happyReduce_5), + (6 , happyReduce_6), + (7 , happyReduce_7), + (8 , happyReduce_8), + (9 , happyReduce_9), + (10 , happyReduce_10), + (11 , happyReduce_11), + (12 , happyReduce_12), + (13 , happyReduce_13), + (14 , happyReduce_14), + (15 , happyReduce_15), + (16 , happyReduce_16), + (17 , happyReduce_17), + (18 , happyReduce_18), + (19 , happyReduce_19), + (20 , happyReduce_20), + (21 , happyReduce_21), + (22 , happyReduce_22), + (23 , happyReduce_23), + (24 , happyReduce_24), + (25 , happyReduce_25), + (26 , happyReduce_26), + (27 , happyReduce_27), + (28 , happyReduce_28), + (29 , happyReduce_29), + (30 , happyReduce_30), + (31 , happyReduce_31), + (32 , happyReduce_32), + (33 , happyReduce_33), + (34 , happyReduce_34), + (35 , happyReduce_35), + (36 , happyReduce_36), + (37 , happyReduce_37), + (38 , happyReduce_38), + (39 , happyReduce_39), + (40 , happyReduce_40), + (41 , happyReduce_41), + (42 , happyReduce_42), + (43 , happyReduce_43), + (44 , happyReduce_44), + (45 , happyReduce_45), + (46 , happyReduce_46), + (47 , happyReduce_47), + (48 , happyReduce_48), + (49 , happyReduce_49), + (50 , happyReduce_50), + (51 , happyReduce_51), + (52 , happyReduce_52), + (53 , happyReduce_53), + (54 , happyReduce_54), + (55 , happyReduce_55), + (56 , happyReduce_56), + (57 , happyReduce_57), + (58 , happyReduce_58), + (59 , happyReduce_59), + (60 , happyReduce_60), + (61 , happyReduce_61), + (62 , happyReduce_62), + (63 , happyReduce_63), + (64 , happyReduce_64), + (65 , happyReduce_65), + (66 , happyReduce_66), + (67 , happyReduce_67), + (68 , happyReduce_68), + (69 , happyReduce_69), + (70 , happyReduce_70), + (71 , happyReduce_71), + (72 , happyReduce_72), + (73 , happyReduce_73), + (74 , happyReduce_74), + (75 , happyReduce_75), + (76 , happyReduce_76), + (77 , happyReduce_77), + (78 , happyReduce_78), + (79 , happyReduce_79), + (80 , happyReduce_80), + (81 , happyReduce_81), + (82 , happyReduce_82) + ] + +happy_n_terms = 56 :: Int +happy_n_nonterms = 30 :: Int + +happyReduce_1 = happySpecReduce_1 0# happyReduction_1 +happyReduction_1 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn4 + ((Just (tokenLineCol happy_var_1), read (prToken happy_var_1)) + )} + +happyReduce_2 = happySpecReduce_1 1# happyReduction_2 +happyReduction_2 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn5 + ((Just (tokenLineCol happy_var_1), prToken happy_var_1) + )} + +happyReduce_3 = happySpecReduce_1 2# happyReduction_3 +happyReduction_3 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn6 + ((Just (tokenLineCol happy_var_1), SymIdent (prToken happy_var_1)) + )} + +happyReduce_4 = happySpecReduce_1 3# happyReduction_4 +happyReduction_4 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn7 + ((Just (tokenLineCol happy_var_1), LabIdent (prToken happy_var_1)) + )} + +happyReduce_5 = happySpecReduce_1 4# happyReduction_5 +happyReduction_5 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn8 + ((Just (tokenLineCol happy_var_1), ValIdent (prToken happy_var_1)) + )} + +happyReduce_6 = happySpecReduce_3 5# happyReduction_6 +happyReduction_6 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut6 happy_x_1 of { (HappyWrap6 happy_var_1) -> + case happyOut6 happy_x_3 of { (HappyWrap6 happy_var_3) -> + happyIn9 + ((fst happy_var_1, Abs.QIdent (fst happy_var_1)(snd happy_var_1)(snd happy_var_3)) + )}} + +happyReduce_7 = happySpecReduce_2 6# happyReduction_7 +happyReduction_7 happy_x_2 + happy_x_1 + = case happyOut11 happy_x_1 of { (HappyWrap11 happy_var_1) -> + case happyOut24 happy_x_2 of { (HappyWrap24 happy_var_2) -> + happyIn10 + ((fst happy_var_1, Abs.Program (fst happy_var_1)(snd happy_var_1)(reverse (snd happy_var_2))) + )}} + +happyReduce_8 = happyReduce 9# 7# happyReduction_8 +happyReduction_8 (happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut17 happy_x_7 of { (HappyWrap17 happy_var_7) -> + happyIn11 + ((Just (tokenLineCol happy_var_1), Abs.Meta (Just (tokenLineCol happy_var_1)) (reverse (snd happy_var_7))) + ) `HappyStk` happyRest}} + +happyReduce_9 = happyReduce 14# 8# happyReduction_9 +happyReduction_9 (happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut6 happy_x_1 of { (HappyWrap6 happy_var_1) -> + case happyOut15 happy_x_7 of { (HappyWrap15 happy_var_7) -> + case happyOut16 happy_x_12 of { (HappyWrap16 happy_var_12) -> + happyIn12 + ((fst happy_var_1, Abs.ClDef (fst happy_var_1)(snd happy_var_1)(reverse (snd happy_var_7)) (reverse (snd happy_var_12))) + ) `HappyStk` happyRest}}} + +happyReduce_10 = happySpecReduce_2 9# happyReduction_10 +happyReduction_10 happy_x_2 + happy_x_1 + = case happyOut19 happy_x_1 of { (HappyWrap19 happy_var_1) -> + case happyOut6 happy_x_2 of { (HappyWrap6 happy_var_2) -> + happyIn13 + ((fst happy_var_1, Abs.FldDef (fst happy_var_1)(snd happy_var_1)(snd happy_var_2)) + )}} + +happyReduce_11 = happySpecReduce_2 10# happyReduction_11 +happyReduction_11 happy_x_2 + happy_x_1 + = case happyOut18 happy_x_1 of { (HappyWrap18 happy_var_1) -> + case happyOut9 happy_x_2 of { (HappyWrap9 happy_var_2) -> + happyIn14 + ((fst happy_var_1, Abs.MthdDef (fst happy_var_1)(snd happy_var_1)(snd happy_var_2)) + )}} + +happyReduce_12 = happySpecReduce_0 11# happyReduction_12 +happyReduction_12 = happyIn15 + ((Nothing, []) + ) + +happyReduce_13 = happySpecReduce_3 11# happyReduction_13 +happyReduction_13 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut15 happy_x_1 of { (HappyWrap15 happy_var_1) -> + case happyOut13 happy_x_2 of { (HappyWrap13 happy_var_2) -> + happyIn15 + ((fst happy_var_1, flip (:) (snd happy_var_1)(snd happy_var_2)) + )}} + +happyReduce_14 = happySpecReduce_0 12# happyReduction_14 +happyReduction_14 = happyIn16 + ((Nothing, []) + ) + +happyReduce_15 = happySpecReduce_3 12# happyReduction_15 +happyReduction_15 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut16 happy_x_1 of { (HappyWrap16 happy_var_1) -> + case happyOut14 happy_x_2 of { (HappyWrap14 happy_var_2) -> + happyIn16 + ((fst happy_var_1, flip (:) (snd happy_var_1)(snd happy_var_2)) + )}} + +happyReduce_16 = happySpecReduce_0 13# happyReduction_16 +happyReduction_16 = happyIn17 + ((Nothing, []) + ) + +happyReduce_17 = happySpecReduce_2 13# happyReduction_17 +happyReduction_17 happy_x_2 + happy_x_1 + = case happyOut17 happy_x_1 of { (HappyWrap17 happy_var_1) -> + case happyOut12 happy_x_2 of { (HappyWrap12 happy_var_2) -> + happyIn17 + ((fst happy_var_1, flip (:) (snd happy_var_1)(snd happy_var_2)) + )}} + +happyReduce_18 = happyReduce 4# 14# happyReduction_18 +happyReduction_18 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut19 happy_x_1 of { (HappyWrap19 happy_var_1) -> + case happyOut20 happy_x_3 of { (HappyWrap20 happy_var_3) -> + happyIn18 + ((fst happy_var_1, Abs.FType (fst happy_var_1)(snd happy_var_1)(snd happy_var_3)) + ) `HappyStk` happyRest}} + +happyReduce_19 = happySpecReduce_1 15# happyReduction_19 +happyReduction_19 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn19 + ((Just (tokenLineCol happy_var_1), Abs.Int (Just (tokenLineCol happy_var_1))) + )} + +happyReduce_20 = happySpecReduce_1 15# happyReduction_20 +happyReduction_20 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn19 + ((Just (tokenLineCol happy_var_1), Abs.Str (Just (tokenLineCol happy_var_1))) + )} + +happyReduce_21 = happySpecReduce_1 15# happyReduction_21 +happyReduction_21 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn19 + ((Just (tokenLineCol happy_var_1), Abs.Bool (Just (tokenLineCol happy_var_1))) + )} + +happyReduce_22 = happySpecReduce_1 15# happyReduction_22 +happyReduction_22 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn19 + ((Just (tokenLineCol happy_var_1), Abs.Void (Just (tokenLineCol happy_var_1))) + )} + +happyReduce_23 = happySpecReduce_2 15# happyReduction_23 +happyReduction_23 happy_x_2 + happy_x_1 + = case happyOut19 happy_x_1 of { (HappyWrap19 happy_var_1) -> + happyIn19 + ((fst happy_var_1, Abs.Arr (fst happy_var_1)(snd happy_var_1)) + )} + +happyReduce_24 = happySpecReduce_1 15# happyReduction_24 +happyReduction_24 happy_x_1 + = case happyOut6 happy_x_1 of { (HappyWrap6 happy_var_1) -> + happyIn19 + ((fst happy_var_1, Abs.Cl (fst happy_var_1)(snd happy_var_1)) + )} + +happyReduce_25 = happySpecReduce_2 15# happyReduction_25 +happyReduction_25 happy_x_2 + happy_x_1 + = case happyOut19 happy_x_1 of { (HappyWrap19 happy_var_1) -> + happyIn19 + ((fst happy_var_1, Abs.Ref (fst happy_var_1)(snd happy_var_1)) + )} + +happyReduce_26 = happySpecReduce_0 16# happyReduction_26 +happyReduction_26 = happyIn20 + ((Nothing, []) + ) + +happyReduce_27 = happySpecReduce_1 16# happyReduction_27 +happyReduction_27 happy_x_1 + = case happyOut19 happy_x_1 of { (HappyWrap19 happy_var_1) -> + happyIn20 + ((fst happy_var_1, (:[]) (snd happy_var_1)) + )} + +happyReduce_28 = happySpecReduce_3 16# happyReduction_28 +happyReduction_28 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut19 happy_x_1 of { (HappyWrap19 happy_var_1) -> + case happyOut20 happy_x_3 of { (HappyWrap20 happy_var_3) -> + happyIn20 + ((fst happy_var_1, (:) (snd happy_var_1)(snd happy_var_3)) + )}} + +happyReduce_29 = happyReduce 10# 17# happyReduction_29 +happyReduction_29 (happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut19 happy_x_2 of { (HappyWrap19 happy_var_2) -> + case happyOut9 happy_x_3 of { (HappyWrap9 happy_var_3) -> + case happyOut23 happy_x_5 of { (HappyWrap23 happy_var_5) -> + case happyOut28 happy_x_9 of { (HappyWrap28 happy_var_9) -> + happyIn21 + ((Just (tokenLineCol happy_var_1), Abs.Mthd (Just (tokenLineCol happy_var_1)) (snd happy_var_2)(snd happy_var_3)(snd happy_var_5)(reverse (snd happy_var_9))) + ) `HappyStk` happyRest}}}}} + +happyReduce_30 = happySpecReduce_2 18# happyReduction_30 +happyReduction_30 happy_x_2 + happy_x_1 + = case happyOut19 happy_x_1 of { (HappyWrap19 happy_var_1) -> + case happyOut8 happy_x_2 of { (HappyWrap8 happy_var_2) -> + happyIn22 + ((fst happy_var_1, Abs.Param (fst happy_var_1)(snd happy_var_1)(snd happy_var_2)) + )}} + +happyReduce_31 = happySpecReduce_0 19# happyReduction_31 +happyReduction_31 = happyIn23 + ((Nothing, []) + ) + +happyReduce_32 = happySpecReduce_1 19# happyReduction_32 +happyReduction_32 happy_x_1 + = case happyOut22 happy_x_1 of { (HappyWrap22 happy_var_1) -> + happyIn23 + ((fst happy_var_1, (:[]) (snd happy_var_1)) + )} + +happyReduce_33 = happySpecReduce_3 19# happyReduction_33 +happyReduction_33 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut22 happy_x_1 of { (HappyWrap22 happy_var_1) -> + case happyOut23 happy_x_3 of { (HappyWrap23 happy_var_3) -> + happyIn23 + ((fst happy_var_1, (:) (snd happy_var_1)(snd happy_var_3)) + )}} + +happyReduce_34 = happySpecReduce_0 20# happyReduction_34 +happyReduction_34 = happyIn24 + ((Nothing, []) + ) + +happyReduce_35 = happySpecReduce_2 20# happyReduction_35 +happyReduction_35 happy_x_2 + happy_x_1 + = case happyOut24 happy_x_1 of { (HappyWrap24 happy_var_1) -> + case happyOut21 happy_x_2 of { (HappyWrap21 happy_var_2) -> + happyIn24 + ((fst happy_var_1, flip (:) (snd happy_var_1)(snd happy_var_2)) + )}} + +happyReduce_36 = happySpecReduce_2 21# happyReduction_36 +happyReduction_36 happy_x_2 + happy_x_1 + = case happyOut7 happy_x_1 of { (HappyWrap7 happy_var_1) -> + happyIn25 + ((fst happy_var_1, Abs.ILabel (fst happy_var_1)(snd happy_var_1)) + )} + +happyReduce_37 = happyReduce 8# 21# happyReduction_37 +happyReduction_37 (happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut7 happy_x_1 of { (HappyWrap7 happy_var_1) -> + case happyOut4 happy_x_5 of { (HappyWrap4 happy_var_5) -> + case happyOut4 happy_x_7 of { (HappyWrap4 happy_var_7) -> + happyIn25 + ((fst happy_var_1, Abs.ILabelAnn (fst happy_var_1)(snd happy_var_1)(snd happy_var_5)(snd happy_var_7)) + ) `HappyStk` happyRest}}} + +happyReduce_38 = happySpecReduce_2 21# happyReduction_38 +happyReduction_38 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn25 + ((Just (tokenLineCol happy_var_1), Abs.IVRet (Just (tokenLineCol happy_var_1))) + )} + +happyReduce_39 = happySpecReduce_3 21# happyReduction_39 +happyReduction_39 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut31 happy_x_2 of { (HappyWrap31 happy_var_2) -> + happyIn25 + ((Just (tokenLineCol happy_var_1), Abs.IRet (Just (tokenLineCol happy_var_1)) (snd happy_var_2)) + )}} + +happyReduce_40 = happyReduce 6# 21# happyReduction_40 +happyReduction_40 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut8 happy_x_1 of { (HappyWrap8 happy_var_1) -> + case happyOut31 happy_x_3 of { (HappyWrap31 happy_var_3) -> + case happyOut32 happy_x_4 of { (HappyWrap32 happy_var_4) -> + case happyOut31 happy_x_5 of { (HappyWrap31 happy_var_5) -> + happyIn25 + ((fst happy_var_1, Abs.IOp (fst happy_var_1)(snd happy_var_1)(snd happy_var_3)(snd happy_var_4)(snd happy_var_5)) + ) `HappyStk` happyRest}}}} + +happyReduce_41 = happyReduce 4# 21# happyReduction_41 +happyReduction_41 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut8 happy_x_1 of { (HappyWrap8 happy_var_1) -> + case happyOut31 happy_x_3 of { (HappyWrap31 happy_var_3) -> + happyIn25 + ((fst happy_var_1, Abs.ISet (fst happy_var_1)(snd happy_var_1)(snd happy_var_3)) + ) `HappyStk` happyRest}} + +happyReduce_42 = happyReduce 4# 21# happyReduction_42 +happyReduction_42 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut8 happy_x_1 of { (HappyWrap8 happy_var_1) -> + case happyOut5 happy_x_3 of { (HappyWrap5 happy_var_3) -> + happyIn25 + ((fst happy_var_1, Abs.IStr (fst happy_var_1)(snd happy_var_1)(init $ tail $ snd happy_var_3)) + ) `HappyStk` happyRest}} + +happyReduce_43 = happyReduce 5# 21# happyReduction_43 +happyReduction_43 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut8 happy_x_1 of { (HappyWrap8 happy_var_1) -> + case happyOut33 happy_x_3 of { (HappyWrap33 happy_var_3) -> + case happyOut31 happy_x_4 of { (HappyWrap31 happy_var_4) -> + happyIn25 + ((fst happy_var_1, Abs.IUnOp (fst happy_var_1)(snd happy_var_1)(snd happy_var_3)(snd happy_var_4)) + ) `HappyStk` happyRest}}} + +happyReduce_44 = happySpecReduce_2 21# happyReduction_44 +happyReduction_44 happy_x_2 + happy_x_1 + = case happyOut27 happy_x_1 of { (HappyWrap27 happy_var_1) -> + happyIn25 + ((fst happy_var_1, Abs.IVCall (fst happy_var_1)(snd happy_var_1)) + )} + +happyReduce_45 = happyReduce 4# 21# happyReduction_45 +happyReduction_45 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut8 happy_x_1 of { (HappyWrap8 happy_var_1) -> + case happyOut27 happy_x_3 of { (HappyWrap27 happy_var_3) -> + happyIn25 + ((fst happy_var_1, Abs.ICall (fst happy_var_1)(snd happy_var_1)(snd happy_var_3)) + ) `HappyStk` happyRest}} + +happyReduce_46 = happySpecReduce_3 21# happyReduction_46 +happyReduction_46 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut7 happy_x_2 of { (HappyWrap7 happy_var_2) -> + happyIn25 + ((Just (tokenLineCol happy_var_1), Abs.IJmp (Just (tokenLineCol happy_var_1)) (snd happy_var_2)) + )}} + +happyReduce_47 = happyReduce 8# 21# happyReduction_47 +happyReduction_47 (happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut31 happy_x_3 of { (HappyWrap31 happy_var_3) -> + case happyOut7 happy_x_5 of { (HappyWrap7 happy_var_5) -> + case happyOut7 happy_x_7 of { (HappyWrap7 happy_var_7) -> + happyIn25 + ((Just (tokenLineCol happy_var_1), Abs.ICondJmp (Just (tokenLineCol happy_var_1)) (snd happy_var_3)(snd happy_var_5)(snd happy_var_7)) + ) `HappyStk` happyRest}}}} + +happyReduce_48 = happyReduce 5# 21# happyReduction_48 +happyReduction_48 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut8 happy_x_1 of { (HappyWrap8 happy_var_1) -> + case happyOut31 happy_x_4 of { (HappyWrap31 happy_var_4) -> + happyIn25 + ((fst happy_var_1, Abs.ILoad (fst happy_var_1)(snd happy_var_1)(snd happy_var_4)) + ) `HappyStk` happyRest}} + +happyReduce_49 = happyReduce 4# 21# happyReduction_49 +happyReduction_49 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut31 happy_x_2 of { (HappyWrap31 happy_var_2) -> + case happyOut31 happy_x_3 of { (HappyWrap31 happy_var_3) -> + happyIn25 + ((Just (tokenLineCol happy_var_1), Abs.IStore (Just (tokenLineCol happy_var_1)) (snd happy_var_2)(snd happy_var_3)) + ) `HappyStk` happyRest}}} + +happyReduce_50 = happyReduce 6# 21# happyReduction_50 +happyReduction_50 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut8 happy_x_1 of { (HappyWrap8 happy_var_1) -> + case happyOut31 happy_x_4 of { (HappyWrap31 happy_var_4) -> + case happyOut9 happy_x_5 of { (HappyWrap9 happy_var_5) -> + happyIn25 + ((fst happy_var_1, Abs.IFld (fst happy_var_1)(snd happy_var_1)(snd happy_var_4)(snd happy_var_5)) + ) `HappyStk` happyRest}}} + +happyReduce_51 = happyReduce 8# 21# happyReduction_51 +happyReduction_51 (happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut8 happy_x_1 of { (HappyWrap8 happy_var_1) -> + case happyOut31 happy_x_4 of { (HappyWrap31 happy_var_4) -> + case happyOut31 happy_x_6 of { (HappyWrap31 happy_var_6) -> + happyIn25 + ((fst happy_var_1, Abs.IArr (fst happy_var_1)(snd happy_var_1)(snd happy_var_4)(snd happy_var_6)) + ) `HappyStk` happyRest}}} + +happyReduce_52 = happyReduce 7# 21# happyReduction_52 +happyReduction_52 (happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut8 happy_x_1 of { (HappyWrap8 happy_var_1) -> + case happyOut30 happy_x_5 of { (HappyWrap30 happy_var_5) -> + happyIn25 + ((fst happy_var_1, Abs.IPhi (fst happy_var_1)(snd happy_var_1)(snd happy_var_5)) + ) `HappyStk` happyRest}} + +happyReduce_53 = happySpecReduce_3 22# happyReduction_53 +happyReduction_53 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut7 happy_x_1 of { (HappyWrap7 happy_var_1) -> + case happyOut31 happy_x_3 of { (HappyWrap31 happy_var_3) -> + happyIn26 + ((fst happy_var_1, Abs.PhiVar (fst happy_var_1)(snd happy_var_1)(snd happy_var_3)) + )}} + +happyReduce_54 = happyReduce 6# 23# happyReduction_54 +happyReduction_54 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut19 happy_x_2 of { (HappyWrap19 happy_var_2) -> + case happyOut9 happy_x_3 of { (HappyWrap9 happy_var_3) -> + case happyOut29 happy_x_5 of { (HappyWrap29 happy_var_5) -> + happyIn27 + ((Just (tokenLineCol happy_var_1), Abs.Call (Just (tokenLineCol happy_var_1)) (snd happy_var_2)(snd happy_var_3)(snd happy_var_5)) + ) `HappyStk` happyRest}}}} + +happyReduce_55 = happyReduce 6# 23# happyReduction_55 +happyReduction_55 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut19 happy_x_2 of { (HappyWrap19 happy_var_2) -> + case happyOut9 happy_x_3 of { (HappyWrap9 happy_var_3) -> + case happyOut29 happy_x_5 of { (HappyWrap29 happy_var_5) -> + happyIn27 + ((Just (tokenLineCol happy_var_1), Abs.CallVirt (Just (tokenLineCol happy_var_1)) (snd happy_var_2)(snd happy_var_3)(snd happy_var_5)) + ) `HappyStk` happyRest}}}} + +happyReduce_56 = happySpecReduce_0 24# happyReduction_56 +happyReduction_56 = happyIn28 + ((Nothing, []) + ) + +happyReduce_57 = happySpecReduce_2 24# happyReduction_57 +happyReduction_57 happy_x_2 + happy_x_1 + = case happyOut28 happy_x_1 of { (HappyWrap28 happy_var_1) -> + case happyOut25 happy_x_2 of { (HappyWrap25 happy_var_2) -> + happyIn28 + ((fst happy_var_1, flip (:) (snd happy_var_1)(snd happy_var_2)) + )}} + +happyReduce_58 = happySpecReduce_0 25# happyReduction_58 +happyReduction_58 = happyIn29 + ((Nothing, []) + ) + +happyReduce_59 = happySpecReduce_1 25# happyReduction_59 +happyReduction_59 happy_x_1 + = case happyOut31 happy_x_1 of { (HappyWrap31 happy_var_1) -> + happyIn29 + ((fst happy_var_1, (:[]) (snd happy_var_1)) + )} + +happyReduce_60 = happySpecReduce_3 25# happyReduction_60 +happyReduction_60 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut31 happy_x_1 of { (HappyWrap31 happy_var_1) -> + case happyOut29 happy_x_3 of { (HappyWrap29 happy_var_3) -> + happyIn29 + ((fst happy_var_1, (:) (snd happy_var_1)(snd happy_var_3)) + )}} + +happyReduce_61 = happySpecReduce_0 26# happyReduction_61 +happyReduction_61 = happyIn30 + ((Nothing, []) + ) + +happyReduce_62 = happySpecReduce_1 26# happyReduction_62 +happyReduction_62 happy_x_1 + = case happyOut26 happy_x_1 of { (HappyWrap26 happy_var_1) -> + happyIn30 + ((fst happy_var_1, (:[]) (snd happy_var_1)) + )} + +happyReduce_63 = happySpecReduce_3 26# happyReduction_63 +happyReduction_63 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut26 happy_x_1 of { (HappyWrap26 happy_var_1) -> + case happyOut30 happy_x_3 of { (HappyWrap30 happy_var_3) -> + happyIn30 + ((fst happy_var_1, (:) (snd happy_var_1)(snd happy_var_3)) + )}} + +happyReduce_64 = happySpecReduce_1 27# happyReduction_64 +happyReduction_64 happy_x_1 + = case happyOut4 happy_x_1 of { (HappyWrap4 happy_var_1) -> + happyIn31 + ((fst happy_var_1, Abs.VInt (fst happy_var_1)(snd happy_var_1)) + )} + +happyReduce_65 = happySpecReduce_2 27# happyReduction_65 +happyReduction_65 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut4 happy_x_2 of { (HappyWrap4 happy_var_2) -> + happyIn31 + ((Just (tokenLineCol happy_var_1), Abs.VNegInt (Just (tokenLineCol happy_var_1)) (snd happy_var_2)) + )}} + +happyReduce_66 = happySpecReduce_1 27# happyReduction_66 +happyReduction_66 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn31 + ((Just (tokenLineCol happy_var_1), Abs.VTrue (Just (tokenLineCol happy_var_1))) + )} + +happyReduce_67 = happySpecReduce_1 27# happyReduction_67 +happyReduction_67 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn31 + ((Just (tokenLineCol happy_var_1), Abs.VFalse (Just (tokenLineCol happy_var_1))) + )} + +happyReduce_68 = happySpecReduce_1 27# happyReduction_68 +happyReduction_68 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn31 + ((Just (tokenLineCol happy_var_1), Abs.VNull (Just (tokenLineCol happy_var_1))) + )} + +happyReduce_69 = happySpecReduce_2 27# happyReduction_69 +happyReduction_69 happy_x_2 + happy_x_1 + = case happyOut19 happy_x_1 of { (HappyWrap19 happy_var_1) -> + case happyOut8 happy_x_2 of { (HappyWrap8 happy_var_2) -> + happyIn31 + ((fst happy_var_1, Abs.VVal (fst happy_var_1)(snd happy_var_1)(snd happy_var_2)) + )}} + +happyReduce_70 = happySpecReduce_1 28# happyReduction_70 +happyReduction_70 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn32 + ((Just (tokenLineCol happy_var_1), Abs.OpAdd (Just (tokenLineCol happy_var_1))) + )} + +happyReduce_71 = happySpecReduce_1 28# happyReduction_71 +happyReduction_71 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn32 + ((Just (tokenLineCol happy_var_1), Abs.OpSub (Just (tokenLineCol happy_var_1))) + )} + +happyReduce_72 = happySpecReduce_1 28# happyReduction_72 +happyReduction_72 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn32 + ((Just (tokenLineCol happy_var_1), Abs.OpMul (Just (tokenLineCol happy_var_1))) + )} + +happyReduce_73 = happySpecReduce_1 28# happyReduction_73 +happyReduction_73 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn32 + ((Just (tokenLineCol happy_var_1), Abs.OpDiv (Just (tokenLineCol happy_var_1))) + )} + +happyReduce_74 = happySpecReduce_1 28# happyReduction_74 +happyReduction_74 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn32 + ((Just (tokenLineCol happy_var_1), Abs.OpMod (Just (tokenLineCol happy_var_1))) + )} + +happyReduce_75 = happySpecReduce_1 28# happyReduction_75 +happyReduction_75 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn32 + ((Just (tokenLineCol happy_var_1), Abs.OpLTH (Just (tokenLineCol happy_var_1))) + )} + +happyReduce_76 = happySpecReduce_1 28# happyReduction_76 +happyReduction_76 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn32 + ((Just (tokenLineCol happy_var_1), Abs.OpLE (Just (tokenLineCol happy_var_1))) + )} + +happyReduce_77 = happySpecReduce_1 28# happyReduction_77 +happyReduction_77 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn32 + ((Just (tokenLineCol happy_var_1), Abs.OpGTH (Just (tokenLineCol happy_var_1))) + )} + +happyReduce_78 = happySpecReduce_1 28# happyReduction_78 +happyReduction_78 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn32 + ((Just (tokenLineCol happy_var_1), Abs.OpGE (Just (tokenLineCol happy_var_1))) + )} + +happyReduce_79 = happySpecReduce_1 28# happyReduction_79 +happyReduction_79 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn32 + ((Just (tokenLineCol happy_var_1), Abs.OpEQU (Just (tokenLineCol happy_var_1))) + )} + +happyReduce_80 = happySpecReduce_1 28# happyReduction_80 +happyReduction_80 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn32 + ((Just (tokenLineCol happy_var_1), Abs.OpNE (Just (tokenLineCol happy_var_1))) + )} + +happyReduce_81 = happySpecReduce_1 29# happyReduction_81 +happyReduction_81 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn33 + ((Just (tokenLineCol happy_var_1), Abs.UnOpNeg (Just (tokenLineCol happy_var_1))) + )} + +happyReduce_82 = happySpecReduce_1 29# happyReduction_82 +happyReduction_82 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn33 + ((Just (tokenLineCol happy_var_1), Abs.UnOpNot (Just (tokenLineCol happy_var_1))) + )} + +happyNewToken action sts stk [] = + happyDoAction 55# notHappyAtAll action sts stk [] + +happyNewToken action sts stk (tk:tks) = + let cont i = happyDoAction i tk action sts stk tks in + case tk of { + PT _ (TS _ 1) -> cont 1#; + PT _ (TS _ 2) -> cont 2#; + PT _ (TS _ 3) -> cont 3#; + PT _ (TS _ 4) -> cont 4#; + PT _ (TS _ 5) -> cont 5#; + PT _ (TS _ 6) -> cont 6#; + PT _ (TS _ 7) -> cont 7#; + PT _ (TS _ 8) -> cont 8#; + PT _ (TS _ 9) -> cont 9#; + PT _ (TS _ 10) -> cont 10#; + PT _ (TS _ 11) -> cont 11#; + PT _ (TS _ 12) -> cont 12#; + PT _ (TS _ 13) -> cont 13#; + PT _ (TS _ 14) -> cont 14#; + PT _ (TS _ 15) -> cont 15#; + PT _ (TS _ 16) -> cont 16#; + PT _ (TS _ 17) -> cont 17#; + PT _ (TS _ 18) -> cont 18#; + PT _ (TS _ 19) -> cont 19#; + PT _ (TS _ 20) -> cont 20#; + PT _ (TS _ 21) -> cont 21#; + PT _ (TS _ 22) -> cont 22#; + PT _ (TS _ 23) -> cont 23#; + PT _ (TS _ 24) -> cont 24#; + PT _ (TS _ 25) -> cont 25#; + PT _ (TS _ 26) -> cont 26#; + PT _ (TS _ 27) -> cont 27#; + PT _ (TS _ 28) -> cont 28#; + PT _ (TS _ 29) -> cont 29#; + PT _ (TS _ 30) -> cont 30#; + PT _ (TS _ 31) -> cont 31#; + PT _ (TS _ 32) -> cont 32#; + PT _ (TS _ 33) -> cont 33#; + PT _ (TS _ 34) -> cont 34#; + PT _ (TS _ 35) -> cont 35#; + PT _ (TS _ 36) -> cont 36#; + PT _ (TS _ 37) -> cont 37#; + PT _ (TS _ 38) -> cont 38#; + PT _ (TS _ 39) -> cont 39#; + PT _ (TS _ 40) -> cont 40#; + PT _ (TS _ 41) -> cont 41#; + PT _ (TS _ 42) -> cont 42#; + PT _ (TS _ 43) -> cont 43#; + PT _ (TS _ 44) -> cont 44#; + PT _ (TS _ 45) -> cont 45#; + PT _ (TS _ 46) -> cont 46#; + PT _ (TS _ 47) -> cont 47#; + PT _ (TS _ 48) -> cont 48#; + PT _ (TS _ 49) -> cont 49#; + PT _ (TI _) -> cont 50#; + PT _ (TL _) -> cont 51#; + PT _ (T_SymIdent _) -> cont 52#; + PT _ (T_LabIdent _) -> cont 53#; + PT _ (T_ValIdent _) -> cont 54#; + _ -> happyError' ((tk:tks), []) + } + +happyError_ explist 55# tk tks = happyError' (tks, explist) +happyError_ explist _ tk tks = happyError' ((tk:tks), explist) + +happyThen :: () => Err a -> (a -> Err b) -> Err b +happyThen = (thenM) +happyReturn :: () => a -> Err a +happyReturn = (returnM) +happyThen1 m k tks = (thenM) m (\a -> k a tks) +happyReturn1 :: () => a -> b -> Err a +happyReturn1 = \a tks -> (returnM) a +happyError' :: () => ([(Token)], [String]) -> Err a +happyError' = (\(tokens, _) -> happyError tokens) +pProgram_internal tks = happySomeParser where + happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (let {(HappyWrap10 x') = happyOut10 x} in x')) + +happySeq = happyDontSeq + + +returnM :: a -> Err a +returnM = return + +thenM :: Err a -> (a -> Err b) -> Err b +thenM = (>>=) + +happyError :: [Token] -> Err a +happyError ts = + Bad $ "syntax error at " ++ tokenPos ts ++ + case ts of + [] -> [] + [Err _] -> " due to lexer error" + t:_ -> " before `" ++ id(prToken t) ++ "'" + +myLexer = tokens + +pProgram = (>>= return . snd) . pProgram_internal +{-# LINE 1 "templates/GenericTemplate.hs" #-} +{-# LINE 1 "templates/GenericTemplate.hs" #-} +{-# LINE 1 "" #-} +{-# LINE 1 "" #-} +{-# LINE 10 "" #-} +# 1 "/usr/include/stdc-predef.h" 1 3 4 + +# 17 "/usr/include/stdc-predef.h" 3 4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +{-# LINE 10 "" #-} +{-# LINE 1 "/usr/lib/ghc/include/ghcversion.h" #-} + + + + + + + + + + + + + + + +{-# LINE 10 "" #-} +{-# LINE 1 "/tmp/ghc8371_0/ghc_2.h" #-} + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +{-# LINE 10 "" #-} +{-# LINE 1 "templates/GenericTemplate.hs" #-} +-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp + + + + + + + + + + + + + +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. +#if __GLASGOW_HASKELL__ > 706 +#define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Bool) +#define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Bool) +#define EQ(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.==# m)) :: Bool) +#else +#define LT(n,m) (n Happy_GHC_Exts.<# m) +#define GTE(n,m) (n Happy_GHC_Exts.>=# m) +#define EQ(n,m) (n Happy_GHC_Exts.==# m) +#endif +{-# LINE 43 "templates/GenericTemplate.hs" #-} + +data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList + + + + + + + +{-# LINE 65 "templates/GenericTemplate.hs" #-} + +{-# LINE 75 "templates/GenericTemplate.hs" #-} + +{-# LINE 84 "templates/GenericTemplate.hs" #-} + +infixr 9 `HappyStk` +data HappyStk a = HappyStk a (HappyStk a) + +----------------------------------------------------------------------------- +-- starting the parse + +happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll + +----------------------------------------------------------------------------- +-- Accepting the parse + +-- If the current token is 0#, it means we've just accepted a partial +-- parse (a %partial parser). We must ignore the saved token on the top of +-- the stack in this case. +happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) = + happyReturn1 ans +happyAccept j tk st sts (HappyStk ans _) = + (happyTcHack j (happyTcHack st)) (happyReturn1 ans) + +----------------------------------------------------------------------------- +-- Arrays only: do the next action + + + +happyDoAction i tk st + = {- nothing -} + + + case action of + 0# -> {- nothing -} + happyFail (happyExpListPerState ((Happy_GHC_Exts.I# (st)) :: Int)) i tk st + -1# -> {- nothing -} + happyAccept i tk st + n | LT(n,(0# :: Happy_GHC_Exts.Int#)) -> {- nothing -} + + (happyReduceArr Happy_Data_Array.! rule) i tk st + where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#)))))) + n -> {- nothing -} + + + happyShift new_state i tk st + where new_state = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) + where off = happyAdjustOffset (indexShortOffAddr happyActOffsets st) + off_i = (off Happy_GHC_Exts.+# i) + check = if GTE(off_i,(0# :: Happy_GHC_Exts.Int#)) + then EQ(indexShortOffAddr happyCheck off_i, i) + else False + action + | check = indexShortOffAddr happyTable off_i + | otherwise = indexShortOffAddr happyDefActions st + + + + +indexShortOffAddr (HappyA# arr) off = + Happy_GHC_Exts.narrow16Int# i + where + i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low) + high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#))) + low = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off')) + off' = off Happy_GHC_Exts.*# 2# + + + + +{-# INLINE happyLt #-} +happyLt x y = LT(x,y) + + +readArrayBit arr bit = + Bits.testBit (Happy_GHC_Exts.I# (indexShortOffAddr arr ((unbox_int bit) `Happy_GHC_Exts.iShiftRA#` 4#))) (bit `mod` 16) + where unbox_int (Happy_GHC_Exts.I# x) = x + + + + + + +data HappyAddr = HappyA# Happy_GHC_Exts.Addr# + + +----------------------------------------------------------------------------- +-- HappyState data type (not arrays) + +{-# LINE 180 "templates/GenericTemplate.hs" #-} + +----------------------------------------------------------------------------- +-- Shifting a token + +happyShift new_state 0# tk st sts stk@(x `HappyStk` _) = + let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in +-- trace "shifting the error token" $ + happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) + +happyShift new_state i tk st sts stk = + happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk) + +-- happyReduce is specialised for the common cases. + +happySpecReduce_0 i fn 0# tk st sts stk + = happyFail [] 0# tk st sts stk +happySpecReduce_0 nt fn j tk st@((action)) sts stk + = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk) + +happySpecReduce_1 i fn 0# tk st sts stk + = happyFail [] 0# tk st sts stk +happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') + = let r = fn v1 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happySpecReduce_2 i fn 0# tk st sts stk + = happyFail [] 0# tk st sts stk +happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') + = let r = fn v1 v2 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happySpecReduce_3 i fn 0# tk st sts stk + = happyFail [] 0# tk st sts stk +happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') + = let r = fn v1 v2 v3 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happyReduce k i fn 0# tk st sts stk + = happyFail [] 0# tk st sts stk +happyReduce k nt fn j tk st sts stk + = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of + sts1@((HappyCons (st1@(action)) (_))) -> + let r = fn stk in -- it doesn't hurt to always seq here... + happyDoSeq r (happyGoto nt j tk st1 sts1 r) + +happyMonadReduce k nt fn 0# tk st sts stk + = happyFail [] 0# tk st sts stk +happyMonadReduce k nt fn j tk st sts stk = + case happyDrop k (HappyCons (st) (sts)) of + sts1@((HappyCons (st1@(action)) (_))) -> + let drop_stk = happyDropStk k stk in + happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) + +happyMonad2Reduce k nt fn 0# tk st sts stk + = happyFail [] 0# tk st sts stk +happyMonad2Reduce k nt fn j tk st sts stk = + case happyDrop k (HappyCons (st) (sts)) of + sts1@((HappyCons (st1@(action)) (_))) -> + let drop_stk = happyDropStk k stk + + off = happyAdjustOffset (indexShortOffAddr happyGotoOffsets st1) + off_i = (off Happy_GHC_Exts.+# nt) + new_state = indexShortOffAddr happyTable off_i + + + + + in + happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) + +happyDrop 0# l = l +happyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t + +happyDropStk 0# l = l +happyDropStk n (x `HappyStk` xs) = happyDropStk (n Happy_GHC_Exts.-# (1#::Happy_GHC_Exts.Int#)) xs + +----------------------------------------------------------------------------- +-- Moving to a new state after a reduction + + +happyGoto nt j tk st = + {- nothing -} + happyDoAction j tk new_state + where off = happyAdjustOffset (indexShortOffAddr happyGotoOffsets st) + off_i = (off Happy_GHC_Exts.+# nt) + new_state = indexShortOffAddr happyTable off_i + + + + +----------------------------------------------------------------------------- +-- Error recovery (0# is the error token) + +-- parse error if we are in recovery and we fail again +happyFail explist 0# tk old_st _ stk@(x `HappyStk` _) = + let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in +-- trace "failing" $ + happyError_ explist i tk + +{- We don't need state discarding for our restricted implementation of + "error". In fact, it can cause some bogus parses, so I've disabled it + for now --SDM + +-- discard a state +happyFail 0# tk old_st (HappyCons ((action)) (sts)) + (saved_tok `HappyStk` _ `HappyStk` stk) = +-- trace ("discarding state, depth " ++ show (length stk)) $ + happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk)) +-} + +-- Enter error recovery: generate an error token, +-- save the old token and carry on. +happyFail explist i tk (action) sts stk = +-- trace "entering error recovery" $ + happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk) + +-- Internal happy errors: + +notHappyAtAll :: a +notHappyAtAll = error "Internal Happy error\n" + +----------------------------------------------------------------------------- +-- Hack to get the typechecker to accept our action functions + + +happyTcHack :: Happy_GHC_Exts.Int# -> a -> a +happyTcHack x y = y +{-# INLINE happyTcHack #-} + + +----------------------------------------------------------------------------- +-- Seq-ing. If the --strict flag is given, then Happy emits +-- happySeq = happyDoSeq +-- otherwise it emits +-- happySeq = happyDontSeq + +happyDoSeq, happyDontSeq :: a -> b -> b +happyDoSeq a b = a `seq` b +happyDontSeq a b = b + +----------------------------------------------------------------------------- +-- Don't inline any functions from the template. GHC has a nasty habit +-- of deciding to inline happyGoto everywhere, which increases the size of +-- the generated parser quite a bit. + + +{-# NOINLINE happyDoAction #-} +{-# NOINLINE happyTable #-} +{-# NOINLINE happyCheck #-} +{-# NOINLINE happyActOffsets #-} +{-# NOINLINE happyGotoOffsets #-} +{-# NOINLINE happyDefActions #-} + +{-# NOINLINE happyShift #-} +{-# NOINLINE happySpecReduce_0 #-} +{-# NOINLINE happySpecReduce_1 #-} +{-# NOINLINE happySpecReduce_2 #-} +{-# NOINLINE happySpecReduce_3 #-} +{-# NOINLINE happyReduce #-} +{-# NOINLINE happyMonadReduce #-} +{-# NOINLINE happyGoto #-} +{-# NOINLINE happyFail #-} + +-- end of Happy Template. diff --git a/src/Espresso/Syntax/Printer.hs b/src/Espresso/Syntax/Printer.hs new file mode 100644 index 0000000..b3cbb79 --- /dev/null +++ b/src/Espresso/Syntax/Printer.hs @@ -0,0 +1,329 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} +{-# LANGUAGE PatternSynonyms #-} +module Espresso.Syntax.Printer where + +-- pretty-printer generated by the BNF converter + +import Espresso.Syntax.Abs +import Data.Char + +-- the top-level printing method +printTree :: Print a => a -> String +printTree = render . prt 0 + +type Doc = [ShowS] -> [ShowS] + +doc :: ShowS -> Doc +doc = (:) + +pattern Label :: [Char] -> [Char] +pattern Label l <- l@('.':'L':_) + +-- Custom edits for better printing. +render :: Doc -> String +render d = rend 0 (map ($ "") $ d []) "" where + rend i ss = case ss of + ".method":ts -> new i . space ".method" . rend i ts + "[":"]":"]":ts -> space "[" . showChar ']' . rend i ("]":ts) + "[" : "]":ts -> space "[" . showChar ']' . new i . rend i ts + "[":Label l:ts -> space "[" . new i . rend i (l:ts) + "[" :ts -> showChar '[' . new (i+1) . rend (i+1) ts + "(" :ts -> showChar '(' . rend i ts + "{" :ts -> showChar '{' . new (i+1) . rend (i+1) ts + "}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts + "}" :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts + t : ";":ts -> showString t . rend i (";":ts) + ";" : "]":ts -> showChar ';' . rend i ("]":ts) + ";":Label l:ts -> showChar ';' . new (i-1) . rend (i-1) (l:ts) + ";" :"/*":ts -> space ";" . space "/*" . rend i ts + ";" :ts -> showChar ';' . new i . rend i ts + ":" : "=":ts -> showChar ':' . showChar '=' . rend (i+1) ts + "*/": "]":ts -> showString "*/" . rend i ("]":ts) + "*/":Label l:ts -> showString "*/" . new (i-1) . rend (i-1) (l:ts) + "*/" :ts -> showString "*/" . new i . rend i ts + Label l1:":":Label l2:":":ts -> showString l1 . showChar ':' . new i . rend i (l2:":":ts) + Label l:":":"]":ts -> showString l . showChar ':' . rend (i+1) ("]":ts) + Label l:":":ts -> showString l . showChar ':' . new (i+1) . rend (i+1) ts + t:":":"[":ts -> showString t . space ":" . rend i ("[":ts) + t : ":":ts -> showString t . showChar ':' . new i . rend i ts + ":" :ts -> showChar ':' . new i . rend i ts + t : "," :ts -> showString t . space "," . rend i ts + t : ")" :ts -> showString t . showChar ')' . rend i ts + "]": "]" :ts -> new (i-1) . showChar ']' . rend (i-1) ("]":ts) + "]" :ts -> new (i-1) . showChar ']' . new (i-1) . rend (i-1) ts + t :ts -> space t . rend i ts + _ -> id + new i = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace + space t = showString t . (\s -> if null s then "" else ' ':s) + +parenth :: Doc -> Doc +parenth ss = doc (showChar '(') . ss . doc (showChar ')') + +concatS :: [ShowS] -> ShowS +concatS = foldr (.) id + +concatD :: [Doc] -> Doc +concatD = foldr (.) id + +replicateS :: Int -> ShowS -> ShowS +replicateS n f = concatS (replicate n f) + +-- the printer class does the job +class Print a where + prt :: Int -> a -> Doc + prtList :: Int -> [a] -> Doc + prtList i = concatD . map (prt i) + +instance Print a => Print [a] where + prt = prtList + +instance Print Char where + prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'') + prtList _ s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"') + +mkEsc :: Char -> Char -> ShowS +mkEsc q s = case s of + _ | s == q -> showChar '\\' . showChar s + '\\'-> showString "\\\\" + '\n' -> showString "\\n" + '\t' -> showString "\\t" + _ -> showChar s + +prPrec :: Int -> Int -> Doc -> Doc +prPrec i j = if j prPrec i 0 (doc (showString s1 . showString "." . showString s2)) + +instance Print (Program a) where + prt i e = case e of + Program _ metadata methods -> prPrec i 0 (concatD [prt 0 metadata, prt 0 methods]) + +instance Print (Metadata a) where + prt i e = case e of + Meta _ classdefs -> prPrec i 0 (concatD [doc (showString ".metadata"), doc (showString ":"), doc (showString "["), doc (showString ".classes"), doc (showString ":"), doc (showString "["), prt 0 classdefs, doc (showString "]"), doc (showString "]")]) + +instance Print (ClassDef a) where + prt i e = case e of + ClDef _ symident fielddefs methoddefs -> prPrec i 0 (concatD [prt 0 symident, doc (showString ":"), doc (showString "["), doc (showString ".fields"), doc (showString ":"), doc (showString "["), prt 0 fielddefs, doc (showString "]"), doc (showString ".methods"), doc (showString ":"), doc (showString "["), prt 0 methoddefs, doc (showString "]"), doc (showString "]")]) + prtList _ [] = (concatD []) + prtList _ (x:xs) = (concatD [prt 0 x, prt 0 xs]) +instance Print (FieldDef a) where + prt i e = case e of + FldDef _ stype symident -> prPrec i 0 (concatD [prt 0 stype, prt 0 symident]) + prtList _ [] = (concatD []) + prtList _ (x:xs) = (concatD [prt 0 x, doc (showString ";"), prt 0 xs]) +instance Print (MethodDef a) where + prt i e = case e of + MthdDef _ ftype qident -> prPrec i 0 (concatD [prt 0 ftype, prt 0 qident]) + prtList _ [] = (concatD []) + prtList _ (x:xs) = (concatD [prt 0 x, doc (showString ";"), prt 0 xs]) +instance Print (FType a) where + prt i e = case e of + FType _ stype stypes -> prPrec i 0 (concatD [prt 0 stype, doc (showString "("), prt 0 stypes, doc (showString ")")]) + +instance Print (SType a) where + prt i e = case e of + Int _ -> prPrec i 0 (concatD [doc (showString "int")]) + Str _ -> prPrec i 0 (concatD [doc (showString "string")]) + Bool _ -> prPrec i 0 (concatD [doc (showString "boolean")]) + Void _ -> prPrec i 0 (concatD [doc (showString "void")]) + Arr _ stype -> prPrec i 0 (concatD [prt 0 stype, doc (showString "[]")]) + Cl _ symident -> prPrec i 0 (concatD [prt 0 symident]) + Ref _ stype -> prPrec i 0 (concatD [prt 0 stype, doc (showString "&")]) + prtList _ [] = (concatD []) + prtList _ [x] = (concatD [prt 0 x]) + prtList _ (x:xs) = (concatD [prt 0 x, doc (showString ","), prt 0 xs]) +instance Print (Method a) where + prt i e = case e of + Mthd _ stype qident params instrs -> prPrec i 0 (concatD [doc (showString ".method"), prt 0 stype, prt 0 qident, doc (showString "("), prt 0 params, doc (showString ")"), doc (showString ":"), doc (showString "["), prt 0 instrs, doc (showString "]")]) + prtList _ [] = (concatD []) + prtList _ (x:xs) = (concatD [prt 0 x, prt 0 xs]) +instance Print (Param a) where + prt i e = case e of + Param _ stype valident -> prPrec i 0 (concatD [prt 0 stype, prt 0 valident]) + prtList _ [] = (concatD []) + prtList _ [x] = (concatD [prt 0 x]) + prtList _ (x:xs) = (concatD [prt 0 x, doc (showString ","), prt 0 xs]) +instance Print (Instr a) where + prt i e = case e of + ILabel _ labident -> prPrec i 0 (concatD [prt 0 labident, doc (showString ":")]) + ILabelAnn _ (LabIdent ident) n1 n2 -> prPrec i 0 (concatD [doc (showString ident), doc (showString ":"), doc (showString "/*"), doc (showString "lines"), prt 0 n1, doc (showString "to"), prt 0 n2, doc (showString "*/")]) + IVRet _ -> prPrec i 0 (concatD [doc (showString "return"), doc (showString ";")]) + IRet _ val -> prPrec i 0 (concatD [doc (showString "return"), prt 0 val, doc (showString ";")]) + IOp _ valident val1 op val2 -> prPrec i 0 (concatD [prt 0 valident, doc (showString ":="), prt 0 val1, prt 0 op, prt 0 val2, doc (showString ";")]) + ISet _ valident val -> prPrec i 0 (concatD [prt 0 valident, doc (showString ":="), prt 0 val, doc (showString ";")]) + IStr _ valident str -> prPrec i 0 (concatD [prt 0 valident, doc (showString ":="), prt 0 str, doc (showString ";")]) + IUnOp _ valident unop val -> prPrec i 0 (concatD [prt 0 valident, doc (showString ":="), prt 0 unop, prt 0 val, doc (showString ";")]) + IVCall _ call -> prPrec i 0 (concatD [prt 0 call, doc (showString ";")]) + ICall _ valident call -> prPrec i 0 (concatD [prt 0 valident, doc (showString ":="), prt 0 call, doc (showString ";")]) + IJmp _ labident -> prPrec i 0 (concatD [doc (showString "jump"), prt 0 labident, doc (showString ";")]) + ICondJmp _ val labident1 labident2 -> prPrec i 0 (concatD [doc (showString "jump"), doc (showString "if"), prt 0 val, doc (showString "then"), prt 0 labident1, doc (showString "else"), prt 0 labident2, doc (showString ";")]) + ILoad _ valident val -> prPrec i 0 (concatD [prt 0 valident, doc (showString ":="), doc (showString "load"), prt 0 val, doc (showString ";")]) + IStore _ val1 val2 -> prPrec i 0 (concatD [doc (showString "store"), prt 0 val1, prt 0 val2, doc (showString ";")]) + IFld _ valident val qident -> prPrec i 0 (concatD [prt 0 valident, doc (showString ":="), doc (showString "fldptr"), prt 0 val, prt 0 qident, doc (showString ";")]) + IArr _ valident val1 val2 -> prPrec i 0 (concatD [prt 0 valident, doc (showString ":="), doc (showString "elemptr"), prt 0 val1, doc (showString "["), prt 0 val2, doc (showString "]"), doc (showString ";")]) + IPhi _ valident phivariants -> prPrec i 0 (concatD [prt 0 valident, doc (showString ":="), doc (showString "phi"), doc (showString "("), prt 0 phivariants, doc (showString ")"), doc (showString ";")]) + prtList _ [] = (concatD []) + prtList _ (x:xs) = (concatD [prt 0 x, prt 0 xs]) +instance Print (PhiVariant a) where + prt i e = case e of + PhiVar _ (LabIdent l) val -> prPrec i 0 (concatD [doc (showString l . showChar ':'), prt 0 val]) + prtList _ [] = (concatD []) + prtList _ [x] = (concatD [prt 0 x]) + prtList _ (x:xs) = (concatD [prt 0 x, doc (showString ","), prt 0 xs]) +instance Print (Call a) where + prt i e = case e of + Call _ stype qident vals -> prPrec i 0 (concatD [doc (showString "call"), prt 0 stype, prt 0 qident, doc (showString "("), prt 0 vals, doc (showString ")")]) + CallVirt _ stype qident vals -> prPrec i 0 (concatD [doc (showString "callvirt"), prt 0 stype, prt 0 qident, doc (showString "("), prt 0 vals, doc (showString ")")]) + +instance Print (Val a) where + prt i e = case e of + VInt _ n -> prPrec i 0 (concatD [prt 0 n]) + VNegInt _ n -> prPrec i 0 (concatD [doc (showString "-"), prt 0 n]) + VTrue _ -> prPrec i 0 (concatD [doc (showString "true")]) + VFalse _ -> prPrec i 0 (concatD [doc (showString "false")]) + VNull _ -> prPrec i 0 (concatD [doc (showString "null")]) + VVal _ stype valident -> prPrec i 0 (concatD [prt 0 stype, prt 0 valident]) + prtList _ [] = (concatD []) + prtList _ [x] = (concatD [prt 0 x]) + prtList _ (x:xs) = (concatD [prt 0 x, doc (showString ","), prt 0 xs]) +instance Print (Op a) where + prt i e = case e of + OpAdd _ -> prPrec i 0 (concatD [doc (showString "+")]) + OpSub _ -> prPrec i 0 (concatD [doc (showString "-")]) + OpMul _ -> prPrec i 0 (concatD [doc (showString "*")]) + OpDiv _ -> prPrec i 0 (concatD [doc (showString "/")]) + OpMod _ -> prPrec i 0 (concatD [doc (showString "%")]) + OpLTH _ -> prPrec i 0 (concatD [doc (showString "<")]) + OpLE _ -> prPrec i 0 (concatD [doc (showString "<=")]) + OpGTH _ -> prPrec i 0 (concatD [doc (showString ">")]) + OpGE _ -> prPrec i 0 (concatD [doc (showString ">=")]) + OpEQU _ -> prPrec i 0 (concatD [doc (showString "==")]) + OpNE _ -> prPrec i 0 (concatD [doc (showString "!=")]) + +instance Print (UnOp a) where + prt i e = case e of + UnOpNeg _ -> prPrec i 0 (concatD [doc (showString "-")]) + UnOpNot _ -> prPrec i 0 (concatD [doc (showString "!")]) + +printTreeWithInstrComments :: (Show a) => Program a -> String +printTreeWithInstrComments = render . prtWComments 0 + +class PrintWithComments a where + prtWComments :: Int -> a -> Doc + prtListWComments :: Int -> [a] -> Doc + prtListWComments i = concatD . map (prtWComments i) + +instance PrintWithComments a => PrintWithComments [a] where + prtWComments = prtListWComments + +instance PrintWithComments Char where + prtWComments = prt + +instance PrintWithComments Integer where + prtWComments = prt + +instance PrintWithComments Double where + prtWComments = prt + +instance PrintWithComments SymIdent where + prtWComments = prt + +instance PrintWithComments LabIdent where + prtWComments = prt + +instance PrintWithComments ValIdent where + prtWComments = prt + +instance PrintWithComments (QIdent a) where + prtWComments = prt + +instance Show a => PrintWithComments (Program a) where + prtWComments i e = case e of + Program _ metadata methods -> prPrec i 0 (concatD [prtWComments 0 metadata, prtWComments 0 methods]) + +instance PrintWithComments (Metadata a) where + prtWComments = prt + +instance PrintWithComments (ClassDef a) where + prtWComments = prt + +instance PrintWithComments (FieldDef a) where + prtWComments = prt + +instance PrintWithComments (MethodDef a) where + prtWComments = prt + +instance PrintWithComments (FType a) where + prtWComments = prt + +instance PrintWithComments (SType a) where + prtWComments = prt + +instance Show a => PrintWithComments (Method a) where + prtWComments i e = case e of + Mthd _ stype qident params instrs -> prPrec i 0 (concatD [doc (showString ".method"), prt 0 stype, prt 0 qident, doc (showString "("), prt 0 params, doc (showString ")"), doc (showString ":"), doc (showString "["), prtWComments 0 instrs, doc (showString "]")]) + prtListWComments _ [] = (concatD []) + prtListWComments _ (x:xs) = (concatD [prtWComments 0 x, prtWComments 0 xs]) + +instance Show a => PrintWithComments (Instr a) where + prtWComments i e = case e of + ILabel a labident -> prPrec i 0 (concatD [prt 0 labident, doc (showString ":"), doc (showString "/*"), doc (shows a), doc (showString "*/")]) + ILabelAnn a (LabIdent ident) n1 n2 -> prPrec i 0 (concatD [doc (showString ident), doc (showString ":"), doc (showString "/*"), doc (showString "lines"), prt 0 n1, doc (showString "to"), prt 0 n2, doc (showString "*/"), doc (showString "/*"), doc (shows a), doc (showString "*/")]) + IVRet a -> prPrec i 0 (concatD [doc (showString "return"), doc (showString ";"), doc (showString "/*"), doc (shows a), doc (showString "*/")]) + IRet a val -> prPrec i 0 (concatD [doc (showString "return"), prt 0 val, doc (showString ";"), doc (showString "/*"), doc (shows a), doc (showString "*/")]) + IOp a valident val1 op val2 -> prPrec i 0 (concatD [prt 0 valident, doc (showString ":="), prt 0 val1, prt 0 op, prt 0 val2, doc (showString ";"), doc (showString "/*"), doc (shows a), doc (showString "*/")]) + ISet a valident val -> prPrec i 0 (concatD [prt 0 valident, doc (showString ":="), prt 0 val, doc (showString ";"), doc (showString "/*"), doc (shows a), doc (showString "*/")]) + IStr a valident str -> prPrec i 0 (concatD [prt 0 valident, doc (showString ":="), prt 0 str, doc (showString ";"), doc (showString "/*"), doc (shows a), doc (showString "*/")]) + IUnOp a valident unop val -> prPrec i 0 (concatD [prt 0 valident, doc (showString ":="), prt 0 unop, prt 0 val, doc (showString ";"), doc (showString "/*"), doc (shows a), doc (showString "*/")]) + IVCall a call -> prPrec i 0 (concatD [prt 0 call, doc (showString ";"), doc (showString "/*"), doc (shows a), doc (showString "*/")]) + ICall a valident call -> prPrec i 0 (concatD [prt 0 valident, doc (showString ":="), prt 0 call, doc (showString ";"), doc (showString "/*"), doc (shows a), doc (showString "*/")]) + IJmp a labident -> prPrec i 0 (concatD [doc (showString "jump"), prt 0 labident, doc (showString ";"), doc (showString "/*"), doc (shows a), doc (showString "*/")]) + ICondJmp a val labident1 labident2 -> prPrec i 0 (concatD [doc (showString "jump"), doc (showString "if"), prt 0 val, doc (showString "then"), prt 0 labident1, doc (showString "else"), prt 0 labident2, doc (showString ";"), doc (showString "/*"), doc (shows a), doc (showString "*/")]) + ILoad a valident val -> prPrec i 0 (concatD [prt 0 valident, doc (showString ":="), doc (showString "load"), prt 0 val, doc (showString ";"), doc (showString "/*"), doc (shows a), doc (showString "*/")]) + IStore a val1 val2 -> prPrec i 0 (concatD [doc (showString "store"), prt 0 val1, prt 0 val2, doc (showString ";"), doc (showString "/*"), doc (shows a), doc (showString "*/")]) + IFld a valident val qident -> prPrec i 0 (concatD [prt 0 valident, doc (showString ":="), doc (showString "fldptr"), prt 0 val, prt 0 qident, doc (showString ";"), doc (showString "/*"), doc (shows a), doc (showString "*/")]) + IArr a valident val1 val2 -> prPrec i 0 (concatD [prt 0 valident, doc (showString ":="), doc (showString "elemptr"), prt 0 val1, doc (showString "["), prt 0 val2, doc (showString "]"), doc (showString ";"), doc (showString "/*"), doc (shows a), doc (showString "*/")]) + IPhi a valident phivariants -> prPrec i 0 (concatD [prt 0 valident, doc (showString ":="), doc (showString "phi"), doc (showString "("), prt 0 phivariants, doc (showString ")"), doc (showString ";"), doc (showString "/*"), doc (shows a), doc (showString "*/")]) + prtListWComments _ [] = (concatD []) + prtListWComments _ (x:xs) = (concatD [prtWComments 0 x, prtWComments 0 xs]) + +instance PrintWithComments (PhiVariant a) where + prtWComments = prt + +instance PrintWithComments (Call a) where + prtWComments = prt + +instance PrintWithComments (Val a) where + prtWComments = prt + +instance PrintWithComments (Op a) where + prtWComments = prt + +instance PrintWithComments (UnOp a) where + prtWComments = prt \ No newline at end of file diff --git a/src/Espresso/Types.hs b/src/Espresso/Types.hs new file mode 100644 index 0000000..7926475 --- /dev/null +++ b/src/Espresso/Types.hs @@ -0,0 +1,57 @@ +module Espresso.Types where + +import Espresso.Syntax.Abs +import Espresso.Utilities (toSymIdent) +import qualified Syntax.Abs as Latte + +defaultVal :: SType a -> Val () +defaultVal t = case deref t of + Int _ -> VInt () 0 + Bool _ -> VFalse () + Str _ -> VNull () + Cl _ _ -> VNull () + Arr _ _ -> VNull () + _ -> error $ "defaultVal: invalid type " ++ show (() <$ t) + +deref :: SType a -> SType a +deref t = case t of + Ref _ t' -> t' + _ -> t + +isInt :: SType a -> Bool +isInt t = case deref t of + Int _ -> True + _ -> False + +isStr :: SType a -> Bool +isStr t = case deref t of + Str _ -> True + _ -> False + +toSType :: Latte.Type a -> SType a +toSType t = case t of + Latte.Int a -> Int a + Latte.Str a -> Ref a (Str a) + Latte.Bool a -> Bool a + Latte.Void a -> Void a + Latte.Var {} -> error "toSType: not a simple type 'var'" + Latte.Arr a t' -> Arr a (toSType t') + Latte.Cl a i -> Cl a (toSymIdent i) + Latte.Fun{} -> error "toSType: not a simple type Fun" + Latte.Ref _ (Latte.Int a) -> Int a + Latte.Ref _ (Latte.Bool a) -> Bool a + Latte.Ref a t' -> Ref a (deref $ toSType t') + +toFType :: Latte.Type a -> FType a +toFType t = case t of + Latte.Fun a r ps -> FType a (toSType r) (map toSType ps) + _ -> error "not a function type" + +valType :: Val a -> SType a +valType val = case val of + VInt a _ -> Int a + VNegInt a _ -> Int a + VTrue a -> Bool a + VFalse a -> Bool a + VNull {} -> error "objects unimplemented - requires grammar change to include type info with nulls" + VVal _ t _ -> t diff --git a/src/Espresso/Utilities.hs b/src/Espresso/Utilities.hs new file mode 100644 index 0000000..d1918d4 --- /dev/null +++ b/src/Espresso/Utilities.hs @@ -0,0 +1,30 @@ +module Espresso.Utilities where + +import Espresso.Syntax.Abs +import Identifiers (topLevelClassIdent) +import SemanticAnalysis.Analyser (SemData (semCode)) +import SemanticAnalysis.Class as Class (Method (mthdName, mthdSelf), + showType) +import qualified Syntax.Abs as Latte +import Syntax.Code (Code (codePos)) + +toSymIdent :: Latte.Ident -> SymIdent +toSymIdent (Latte.Ident s) = SymIdent s + +mthdQIdent :: Class.Method a -> QIdent () +mthdQIdent mthd = + let mName = (toSymIdent $ mthdName mthd) + in case mthdSelf mthd of + Just t -> QIdent () (SymIdent $ showType t) mName + Nothing -> QIdent () (toSymIdent topLevelClassIdent) mName + +-- Get the span in code lines of a semantically analysed piece of syntax. +codeLines :: (Functor f, Foldable f) => f SemData -> Maybe (Int, Int) +codeLines stmt = do + lMin <- foldr (lift_ min . semToLine) Nothing stmt + lMax <- foldr (lift_ max . semToLine) Nothing stmt + return (lMin, lMax) + where semToLine s = fst <$> (semCode s >>= codePos) + lift_ _ Nothing x = x + lift_ _ x Nothing = x + lift_ f (Just x) (Just y) = Just $ f x y diff --git a/src/Identifiers.hs b/src/Identifiers.hs index 56793fb..cfa7c47 100644 --- a/src/Identifiers.hs +++ b/src/Identifiers.hs @@ -3,29 +3,109 @@ -- by user code and unspeakable using lexical rules of the language. module Identifiers where +import Espresso.Syntax.Abs import Syntax.Abs --- Identifier of the class that wraps toplevel functions. -topLevelClassIdent :: Ident -topLevelClassIdent = Ident "~cl_TopLevel" +class ToString a where + toStr :: a -> String + +instance ToString Ident where + toStr (Ident s) = s + +instance ToString LabIdent where + toStr (LabIdent s) = s + +instance ToString SymIdent where + toStr (SymIdent s) = s + +instance ToString ValIdent where + toStr (ValIdent s) = s + +argValIdent :: String -> ValIdent +argValIdent s = ValIdent $ "%a_" ++ s + +arrayLengthIdent :: Ident +arrayLengthIdent = Ident "length" + +constIdent :: String -> String +constIdent = ("__const_" ++) -- Internal identifier of the method being currently compiled. currentMthdSymIdent :: Ident currentMthdSymIdent = Ident "~mthd_current" +entryLabel :: LabIdent +entryLabel = LabIdent ".L_entry" + +exitLabel :: LabIdent +exitLabel = LabIdent ".L_exit" + -- Identifiers used in for loop translation. forArrayIdent :: Ident -forArrayIdent = Ident "~l_arr" +forArrayIdent = Ident "~v_arr" forIndexIdent :: Ident -forIndexIdent = Ident "~l_idx" +forIndexIdent = Ident "~v_idx" +indexedValIdent :: String -> Integer -> ValIdent +indexedValIdent i idx = + let suf = if idx == 0 then "" else '_':show idx + in valIdent (i ++ suf) -selfSymIdent :: Ident -selfSymIdent = Ident "self" +labIdent :: String -> LabIdent +labIdent = LabIdent . (".L_" ++) -arrayLengthIdent :: Ident -arrayLengthIdent = Ident "length" +labelFor :: QIdent a -> LabIdent -> LabIdent +labelFor (QIdent _ (SymIdent i1) (SymIdent i2)) (LabIdent l1) = LabIdent $ i1 ++ "." ++ i2 ++ l1 + +mainSymIdent :: Ident +mainSymIdent = Ident "main" + +phiUnfoldJumpFromToLabel :: LabIdent -> LabIdent -> LabIdent +phiUnfoldJumpFromToLabel (LabIdent from) (LabIdent to) = LabIdent $ to ++ "__from_" ++ trim from + where + trim ('.':'L':'_':xs) = xs + trim xs = xs reservedNames :: [Ident] reservedNames = [selfSymIdent] + +sanitiseAssembly :: String -> String +sanitiseAssembly s = case s of + [] -> [] + '~':xs -> '_':'_':sanitiseAssembly xs + x:xs -> x:sanitiseAssembly xs + +selfSymIdent :: Ident +selfSymIdent = Ident "self" + +-- Identifier of the class that wraps top level functions. +topLevelClassIdent :: Ident +topLevelClassIdent = Ident "~cl_TopLevel" + +valIdent :: String -> ValIdent +valIdent = ValIdent . ("%v_" ++) + +runtimeSymbols :: [String] +runtimeSymbols = [ + "lat_print_int", + "lat_print_string", + "lat_read_int", + "lat_read_string", + "lat_error", + "lat_nullchk", + "lat_new_string", + "lat_cat_strings" + ] + +getCallTarget :: QIdent a -> String +getCallTarget (QIdent _ (SymIdent i1) (SymIdent i2)) = + if i1 == toStr topLevelClassIdent + then case i2 of + "readInt" -> "lat_read_int" + "readString" -> "lat_read_string" + "printInt" -> "lat_print_int" + "printString" -> "lat_print_string" + "error" -> "lat_error" + _ -> i1 ++ "." ++ i2 + else i1 ++ "." ++ i2 diff --git a/src/LatteIO.hs b/src/LatteIO.hs new file mode 100644 index 0000000..e91931e --- /dev/null +++ b/src/LatteIO.hs @@ -0,0 +1,156 @@ +module LatteIO where + +import Data.List +import Data.Maybe +import Prelude hiding (error) +import qualified System.Directory as Directory (doesDirectoryExist, + doesFileExist) +import qualified System.Exit as Exit (ExitCode (..), exitFailure, + exitSuccess, exitWith) +import System.IO (hPutStrLn, stderr) + +class LatteIO m where + readInt :: m Int + readString :: m String + error :: String -> m a + printInt :: Int -> m () + printString :: String -> m () + printErrorString :: String -> m () + doesDirectoryExist :: FilePath -> m Bool + doesFileExist :: FilePath -> m Bool + readFile :: FilePath -> m String + writeFile :: FilePath -> String -> m () + exitWith :: Exit.ExitCode -> m a + exitSuccess :: m a + exitFailure :: m a + + printInt = printString . show + exitSuccess = exitWith Exit.ExitSuccess + exitFailure = exitWith $ Exit.ExitFailure 1 + +instance LatteIO IO where + readInt = read <$> readString + readString = getLine + error = fail . ("runtime error\n" ++) + printString = putStrLn + printErrorString = hPutStrLn stderr + doesDirectoryExist = Directory.doesDirectoryExist + doesFileExist = Directory.doesFileExist + readFile = Prelude.readFile + writeFile = Prelude.writeFile + exitWith = Exit.exitWith + exitSuccess = Exit.exitSuccess + exitFailure = Exit.exitFailure + +newtype StaticFileSystem = StaticFS { + staticFiles :: [StaticFile] +} deriving Show + +data StaticFile = StaticF { + staticPath :: FilePath, + staticContents :: String +} deriving Show + +data StaticOutput a = StaticO { + staticCode :: Exit.ExitCode, + staticVal :: Maybe a, + staticOut :: [String], + staticErr :: [String], + staticRemIn :: [String], + staticFS :: StaticFileSystem +} + +emptyFileSystem :: StaticFileSystem +emptyFileSystem = StaticFS [] + +emptyOutput :: a -> [String] -> StaticFileSystem -> StaticOutput a +emptyOutput x = StaticO Exit.ExitSuccess (Just x) [] [] + +errorOutput :: String -> [String] -> StaticFileSystem -> StaticOutput a +errorOutput s = StaticO (Exit.ExitFailure 1) Nothing ["runtime error", s] [] + +newtype StaticIO a = StaticIO { + runStaticIO :: [String] -> StaticFileSystem -> StaticOutput a +} + +instance Functor StaticIO where + fmap f s = StaticIO (\in_ fs -> let x = runStaticIO s in_ fs in x {staticVal = f <$> staticVal x}) + +instance Applicative StaticIO where + pure x = StaticIO (emptyOutput x) + f <*> g = StaticIO (\in_ fs -> + let xf = runStaticIO f in_ fs + xg = runStaticIO g (staticRemIn xf) (staticFS xf) + in xg { + staticCode = if staticCode xf == Exit.ExitSuccess then staticCode xg else staticCode xf, + staticVal = staticVal xf <*> staticVal xg, + staticOut = staticOut xf ++ staticOut xg, + staticErr = staticErr xf ++ staticErr xg + }) + +instance Monad StaticIO where + return = pure + f >>= g = StaticIO (\in_ fs -> + let xf = runStaticIO f in_ fs + in if staticCode xf /= Exit.ExitSuccess || isNothing (staticVal xf) then xf {staticVal = Nothing} + else + let g' = g (fromJust $ staticVal xf) + xg = runStaticIO g' (staticRemIn xf) (staticFS xf) + in xg { + staticOut = staticOut xf ++ staticOut xg, + staticErr = staticErr xf ++ staticErr xg + }) + +instance MonadFail StaticIO where + fail s = StaticIO (\in_ fs -> (errorOutput s in_ fs) {staticOut = [], staticErr = [s]}) + +staticGetLine :: StaticIO String +staticGetLine = StaticIO (\in_ fs -> case in_ of + [] -> errorOutput "unexpected eof" in_ fs + (x : in_') -> emptyOutput x in_' fs) + +staticError :: String -> StaticIO a +staticError s = StaticIO (errorOutput s) + +staticPutStrLn :: String -> StaticIO () +staticPutStrLn out = StaticIO (\in_ fs -> (emptyOutput () in_ fs) {staticOut = [out]}) + +staticPutStrErrLn :: String -> StaticIO () +staticPutStrErrLn err = StaticIO (\in_ fs -> (emptyOutput () in_ fs) {staticErr = [err]}) + +staticExitWith :: Exit.ExitCode -> StaticIO a +staticExitWith ec = StaticIO (StaticO ec Nothing [] []) + +staticDoesDirectoryExist :: FilePath -> StaticIO Bool +staticDoesDirectoryExist _ = return True + +staticDoesFileExist :: FilePath -> StaticIO Bool +staticDoesFileExist fp = StaticIO (\in_ fs -> + let exists = any (\f -> staticPath f == fp) (staticFiles fs) + in emptyOutput exists in_ fs) + +staticReadFile :: FilePath -> StaticIO String +staticReadFile fp = do + exists <- staticDoesFileExist fp + if not exists then fail $ "file not found " ++ show fp else StaticIO (\in_ fs -> + let file = fromJust $ find (\f -> staticPath f == fp) (staticFiles fs) + in emptyOutput (staticContents file) in_ fs) + +staticWriteFile :: FilePath -> String -> StaticIO () +staticWriteFile fp contents = StaticIO (\in_ fs -> + let files = staticFiles fs + newFile = StaticF fp contents + newFiles = newFile:filter (\f -> staticPath f /= fp) files + in emptyOutput () in_ (fs {staticFiles = newFiles})) + +instance LatteIO StaticIO where + readInt = read <$> readString + readString = staticGetLine + error = staticError + printString = staticPutStrLn + printErrorString = staticPutStrErrLn + doesDirectoryExist = staticDoesDirectoryExist + doesFileExist = staticDoesFileExist + readFile = staticReadFile + writeFile = staticWriteFile + exitWith = staticExitWith diff --git a/src/SemanticAnalysis/Analyser.hs b/src/SemanticAnalysis/Analyser.hs index 448f534..078088c 100644 --- a/src/SemanticAnalysis/Analyser.hs +++ b/src/SemanticAnalysis/Analyser.hs @@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} -- Semantic static analysis rejecting incorrect programs and adding type annotations to the program tree. -module SemanticAnalysis.Analyser (analyse, SemData (..), Symbol (..), SymbolTable (..)) where +module SemanticAnalysis.Analyser (analyse, SemData (..), Symbol (..), SymbolTable (..), symTabLookup) where import Control.Monad.Reader import Control.Monad.State @@ -11,10 +11,11 @@ import qualified Error import Identifiers import SemanticAnalysis.Class import SemanticAnalysis.ControlFlow -import SemanticAnalysis.Toplevel (Metadata (..)) +import SemanticAnalysis.TopLevel (Metadata (..)) import Syntax.Abs import Syntax.Code import Syntax.Printer (Print, printTree) +import Utilities -- Tree of symbol tables representing the scoped declarations. data SymbolTable = SymTab {symTab :: Map.Map Ident Symbol, symParent :: Maybe SymbolTable} @@ -87,8 +88,8 @@ analyseCl cl = do -- analyseCl lifted with Nothing coalescing. mbAnalyseCl :: Maybe (Class Code) -> AnalyserM (Maybe (Class SemData)) mbAnalyseCl cl = case cl of - Nothing -> return Nothing - Just cl -> Just <$> analyseCl cl + Nothing -> return Nothing + Just cl' -> Just <$> analyseCl cl' -- Analyse a given method metadata. Assumes that its enclosing class was entered with enterCl. analyseMthd :: Method Code -> AnalyserM (Method SemData) @@ -234,14 +235,14 @@ analyseStmt stmt = do semData <- analyseVoid stmt unreachable -- Code after a return statement is always unreachable. return $ VRet semData - Cond _ expr stmt -> do + Cond _ expr stmt' -> do expr' <- analyseExpr expr let condType = semType $ unwrap expr' - unlessM (condType `typeMatch` Bool ()) (invTypeError stmt (Bool ()) condType) + unlessM (condType `typeMatch` Bool ()) (invTypeError stmt' (Bool ()) condType) triviallyTrue <- isTriviallyTrue expr' - stmt' <- (if triviallyTrue then mustEnter else mayEnter) (analyseStmt stmt) - semData <- analyseVoid stmt - return $ Cond semData expr' stmt' + stmt'' <- (if triviallyTrue then mustEnter else mayEnter) (analyseStmt stmt') + semData <- analyseVoid stmt' + return $ Cond semData expr' stmt'' CondElse _ expr stmt1 stmt2 -> do expr' <- analyseExpr expr let condType = semType $ unwrap expr' @@ -255,14 +256,14 @@ analyseStmt stmt = do (stmt1', stmt2') <- analyser (analyseStmt stmt1) (analyseStmt stmt2) semData <- analyseVoid stmt return $ CondElse semData expr' stmt1' stmt2' - While _ expr stmt -> do + While _ expr stmt' -> do expr' <- analyseExpr expr let condType = semType $ unwrap expr' - unlessM (condType `typeMatch` Bool ()) (invTypeError stmt (Bool ()) condType) + unlessM (condType `typeMatch` Bool ()) (invTypeError stmt' (Bool ()) condType) triviallyTrue <- isTriviallyTrue expr' - stmt' <- (if triviallyTrue then mustEnter else mayEnter) (analyseStmt stmt) - semData <- analyseVoid stmt - return $ While semData expr' stmt' + stmt'' <- (if triviallyTrue then mustEnter else mayEnter) (analyseStmt stmt') + semData <- analyseVoid stmt' + return $ While semData expr' stmt'' For {} -> error "For should be rewritten before analysis." SExp _ expr -> do expr' <- analyseExpr expr @@ -276,24 +277,24 @@ analyseItemDecl t item = do mbSym <- getsSym (symTabLocalScopeLookup i) case mbSym of Nothing -> case item of - NoInit _ i -> do + NoInit _ i' -> do when (isVar t) (varNoInitError item) - addSym (Sym i (Ref () t) (Just $ unwrap item)) + addSym (Sym i' (Ref () t) (Just $ unwrap item)) semData <- analyseVoid item - return $ NoInit semData i - Init _ i expr -> do + return $ NoInit semData i' + Init _ i' expr -> do expr' <- analyseExpr expr let exprType = semType $ unwrap expr' t' = if isVar t then exprType else t -- Infer type to the compile-time type of the expression. unlessM (exprType `typeMatch` t) (invTypeError expr' t exprType) - addSym (Sym i (Ref () t') (Just $ unwrap item)) + addSym (Sym i' (Ref () t') (Just $ unwrap item)) semData <- analyseVoid item - return $ Init semData i expr' + return $ Init semData i' expr' Just sym -> conflDeclError item sym where i = case item of - NoInit _ i -> i - Init _ i _ -> i + NoInit _ i' -> i' + Init _ i' _ -> i' analyseExpr :: Expr Code -> AnalyserM (Expr SemData) analyseExpr srcExpr = case srcExpr of @@ -459,9 +460,9 @@ analyseVoid x = analyseTyped x (Void ()) -- Annotate the piece of syntax with semantic data according to current state and the given type. analyseTyped :: Unwrappable f => f Code -> Type () -> AnalyserM SemData analyseTyped x t = do - symTab <- getSym + syms <- getSyms reach <- getReach - let semData = SemData symTab t (Just $ unwrap x) reach + let semData = SemData syms t (Just $ unwrap x) reach return semData getsCls :: (ClassStore -> a) -> AnalyserM a @@ -470,8 +471,8 @@ getsCls f = gets (f . stClasses) getsSym :: (SymbolTable -> a) -> AnalyserM a getsSym f = gets (f . stSymTab) -getSym :: AnalyserM SymbolTable -getSym = getsSym id +getSyms :: AnalyserM SymbolTable +getSyms = getsSym id -- Set reachability state to unreachable. unreachable :: AnalyserM () @@ -506,10 +507,6 @@ addSyms syms = modifySym (symTabUnion $ Map.fromList $ map (\s -> (symName s, s) addSym :: Symbol -> AnalyserM () addSym sym = modifySym (symTabInsert sym) --- Remove a symbol with the given identifier from the current symbol table. -removeSym :: Ident -> AnalyserM () -removeSym i = modifySym (symTabRemove i) - symTabUnion :: Map.Map Ident Symbol -> SymbolTable -> SymbolTable symTabUnion x s = let y = symTab s @@ -519,10 +516,6 @@ symTabUnion x s = symTabInsert :: Symbol -> SymbolTable -> SymbolTable symTabInsert sym s = s {symTab = Map.insert (symName sym) sym (symTab s)} --- Remove a symbol with the given identifier from the given symbol table. -symTabRemove :: Ident -> SymbolTable -> SymbolTable -symTabRemove i s = s {symTab = Map.delete i (symTab s)} - -- Get a given symbol from the symbol table stack, recursivelly. symTabGet :: Ident -> SymbolTable -> Symbol symTabGet i s = fromJust $ symTabLookup i s @@ -567,9 +560,9 @@ isVoid t = case deref t of isVar :: Type a -> Bool isVar t = case deref t of - Var _ -> True - Arr _ t -> isVar t - _ -> False + Var _ -> True + Arr _ t' -> isVar t' + _ -> False -- Can an expression of type t1 be used in a place where the type t2 is required. -- Both types are dereferenced, so Ref has no impact on the result. @@ -640,10 +633,10 @@ accessMember t i ctx = case t of Just cl -> let fld = find (\f -> fldName f == i) (clFields cl) mthd = find (\m -> mthdName m == i) (clMethods cl) in case (fld, mthd) of - (Just fld, _) -> return $ fldToSym fld - (_, Just mthd) -> return $ mthdToSym mthd + (Just fld', _) -> return $ fldToSym fld' + (_, Just mthd') -> return $ mthdToSym mthd' (Nothing, Nothing) -> invAccessError t i ctx - Ref _ t -> accessMember t i ctx + Ref _ t' -> accessMember t' i ctx _ -> invAccessError t i ctx isRef :: Type a -> Bool @@ -658,20 +651,15 @@ isRef t = case t of -- So, for example, a type `int&[]&` should be impossible. deref :: Type a -> Type a deref t = case t of - Ref _ t -> deref t - _ -> t - -unlessM :: Monad m => m Bool -> m () -> m () -unlessM p a = do - b <- p - unless b a + Ref _ t' -> deref t' + _ -> t -- Symbols that are linked from the native library. nativeTopLevelSymbols :: [Symbol] -nativeTopLevelSymbols = [printInt, printString, error, readInt, readString] +nativeTopLevelSymbols = [printInt, printString, error_, readInt, readString] where printInt = Sym (Ident "printInt") (Fun () (Void ()) [Int ()]) Nothing printString = Sym (Ident "printString") (Fun () (Void ()) [Str ()]) Nothing - error = Sym (Ident "error") (Fun () (Void ()) []) Nothing + error_ = Sym (Ident "error") (Fun () (Void ()) []) Nothing readInt = Sym (Ident "readInt") (Fun () (Int ()) []) Nothing readString = Sym (Ident "readString") (Fun () (Str ()) []) Nothing diff --git a/src/SemanticAnalysis/Class.hs b/src/SemanticAnalysis/Class.hs index 157ae2c..72f6a91 100644 --- a/src/SemanticAnalysis/Class.hs +++ b/src/SemanticAnalysis/Class.hs @@ -23,6 +23,7 @@ import Error (lineInfo) import Identifiers import Syntax.Abs import Syntax.Code +import Utilities data Class a = Class { clName :: Ident, clBase :: Maybe (Class a), clFields :: [Field], clMethods :: [Method a] } @@ -74,7 +75,7 @@ clCons name base flds mthds = do fldCons :: Type a -> Ident -> ClDef Code -> Field fldCons typ i = Fld i (() <$ typ) --- Construct a method representing a toplevel function from its constituents. +-- Construct a method representing a top level function from its constituents. -- Checks parameter naming rules. funCons :: Type a -> Ident -> [Arg Code] -> TopDef Code -> Either String (Method Code) funCons typ i args def = do @@ -90,10 +91,10 @@ mthdCons typ i selfTyp args def = do cons <- baseMethodCons typ i (Just selfTyp) args return $ cons blk (unwrap def) --- Common constructor for both toplevel functions and class methods. +-- Common constructor for both top level functions and class methods. baseMethodCons :: Type a -> Ident -> Maybe (Type b) -> [Arg Code] -> Either String (Block Code -> Code -> Method Code) baseMethodCons typ i selfTyp args = do - let dupArgs = fst $ findDupsBy (\(Arg _ _ i) -> showI i) args + let dupArgs = fst $ findDupsBy (\(Arg _ _ i') -> showI i') args unless (null dupArgs) (dupArgsError dupArgs) return $ Mthd i (() <$ typ) (fmap (() <$) selfTyp) args @@ -105,33 +106,36 @@ clExtend cl base = do flds <- combinedFlds mthds <- combinedMthds return $ Class (clName cl) (Just base) flds mthds - where combinedFlds = let flds = clFields base ++ clFields cl - (_, dups) = findDupsBy fldName flds - in if null dups then Right flds else redefFldsError dups - combinedMthds = let subMthds = Map.fromList $ map (\m -> (mthdName m, m)) (clMethods cl) - in run (clMethods base) subMthds - where - run :: [Method Code] -> Map.Map Ident (Method Code) -> Either String [Method Code] - run [] subMthds = return $ Map.elems subMthds - run (b:bs) subMthds = let key = mthdName b - in case Map.lookup key subMthds of - Nothing -> run bs subMthds >>= (\bs -> return $ b : bs) - Just m -> do - let bt = mthdTypeIgnSelf b - mt = mthdTypeIgnSelf m - if bt == mt then run bs (Map.delete key subMthds) >>= (\bs -> return $ m : bs) - else redefMthdError b m + where combinedFlds = + let flds = clFields base ++ clFields cl + (_, dups) = findDupsBy fldName flds + in if null dups then Right flds else redefFldsError dups + combinedMthds = + let subMthds = Map.fromList $ map (\m -> (mthdName m, m)) (clMethods cl) + in run (clMethods base) subMthds + where + run :: [Method Code] -> Map.Map Ident (Method Code) -> Either String [Method Code] + run [] subMthds = return $ Map.elems subMthds + run (b:bs) subMthds = + let key = mthdName b + in case Map.lookup key subMthds of + Nothing -> run bs subMthds >>= (\bs' -> return $ b : bs') + Just m -> do + let bt = mthdTypeIgnSelf b + mt = mthdTypeIgnSelf m + if bt == mt then run bs (Map.delete key subMthds) >>= (\bs' -> return $ m : bs') + else redefMthdError b m -- Mostly used for debugging purposes. instance Show (Class a) where - show (Class (Ident name) base clFields clMethods) = intercalate "\n" (header : map indent (fields ++ methods)) + show (Class (Ident name) base flds mthds) = intercalate "\n" (header : map indent (fields ++ methods)) where header = ".class " ++ name ++ extends ++ ":" extends = case base of Nothing -> "" Just clExt -> let Ident x = clName clExt in " extends " ++ x - fields = ".fields:" : map (indent . show) clFields - methods = ".methods:" : map (indent . show) clMethods + fields = ".fields:" : map (indent . show) flds + methods = ".methods:" : map (indent . show) mthds indent x = " " ++ x instance Show (Method a) where @@ -149,40 +153,9 @@ showType typ = case typ of Var _ -> "var" Arr _ t -> showType t ++ "[]" Cl _ (Ident name) -> name - Fun _ typ typs -> showType typ ++ "(" ++ intercalate ", " (map showType typs) ++ ")" + Fun _ t ts -> showType t ++ "(" ++ intercalate ", " (map showType ts) ++ ")" Ref _ t -> showType t --- Find duplicates in a given list based on a key selector. --- Returns a deduplicated list of duplicated keys and a list of values such that --- there exists a value with the same key. -findDupsBy :: Ord k => (a -> k) -> [a] -> ([k], [a]) -findDupsBy f ds = collect $ foldr checkForDup (Map.empty, []) ds - where - checkForDup a (m, dups) = - let k = f a - in if Map.member k m then (m, (k, a) : dups) else (Map.insert k a m, dups) - collect (m, dups) = - let (ks, as) = unzip dups in (ks, foldr (\k as' -> m Map.! k : as') as ks) - --- Inner join based on a key selector of two lists. --- Returns a deduplicated list of keys that participated in a join --- and the list of resulting products. -findConflictsBy :: Ord k => (a -> k) -> (b -> k) -> [a] -> [b] -> ([k], [(a, b)]) -findConflictsBy fa fb as bs = unzip $ foldr checkForConfl [] bs - where - m = Map.fromList $ zip (map fa as) as - checkForConfl b confls = - let k = fb b - in case Map.lookup k m of - Nothing -> confls - Just a -> (k, (a, b)) : confls - --- O(nlogn) deduplication. -dedup :: Ord a => [a] -> [a] -dedup xs = run (sort xs) - where run [] = [] - run (x:xs) = x : run (dropWhile (== x) xs ) - -- Errors redefFldsError :: [Field] -> Either String a diff --git a/src/SemanticAnalysis/Toplevel.hs b/src/SemanticAnalysis/Toplevel.hs index 623683a..7978615 100644 --- a/src/SemanticAnalysis/Toplevel.hs +++ b/src/SemanticAnalysis/Toplevel.hs @@ -1,21 +1,19 @@ -- Analyser of toplevel definitions generating class and function metadata. -module SemanticAnalysis.Toplevel (programMetadata, Metadata(..)) where +module SemanticAnalysis.TopLevel (programMetadata, Metadata(..)) where import Control.Monad.State - -import Data.Either (isRight) import Data.List (intercalate) import qualified Data.Map as Map -import Data.Maybe (fromJust) import Error (errorMsg, errorMsgMb) import Identifiers +import Prelude hiding (cycle) import SemanticAnalysis.Class import Syntax.Abs import Syntax.Code newtype Metadata a = Meta (Map.Map Ident (Class a)) --- Analyse the toplevel definitions in a program and produce its metadata. +-- Analyse the top level definitions in a program and produce its metadata. programMetadata :: Program Code -> Either String (Metadata Code) programMetadata x = case x of Program _ ts -> topDefsMetadata ts @@ -43,8 +41,10 @@ fnDefsMetadata :: [TopDef Code] -> Either String [Method Code] fnDefsMetadata = mapM fnDefMetadata where fnDefMetadata def@(FnDef a typ i args _) = let res = funCons typ i args def - in if isRight res then res else fnErr res - where fnErr (Left s) = Left $ errorMsg (s ++ "\n") a ("In definition of function `" ++ showI i ++ "`.") + in case res of + Right {} -> res + Left s -> Left $ errorMsg (s ++ "\n") a ("In definition of function `" ++ showI i ++ "`.") + fnDefMetadata _ = error "invalid def" -- Monad for traversal of the class inheritance hierarchy. -- The state keeps all already visited classes and marks which are already @@ -68,26 +68,27 @@ clDefsMetadata cls = do case mbEntry of -- We never visited this class before, start resolution. Nothing -> case tsByIdent Map.! i of - def@(ClDef _ i _) -> do + def@(ClDef _ i' _) -> do cl <- defToMetadata def - modify $ Map.insert i (Resolved cl) + modify $ Map.insert i' (Resolved cl) return cl - def@(ClExtDef a i ext _) -> do - unless (ext `Map.member` tsByIdent) (undefBaseError (codePos a) i ext) - modify $ Map.insert i Resolving + def@(ClExtDef a i' ext _) -> do + unless (ext `Map.member` tsByIdent) (undefBaseError (codePos a) i' ext) + modify $ Map.insert i' Resolving baseCl <- clMetadata ext nonExtCl <- defToMetadata def cl <- case nonExtCl `clExtend` baseCl of - Left s -> lift $ Left $ Error.errorMsg (s ++ "\n") a ("In definition of class `" ++ showI i ++ "`.") + Left s -> lift $ Left $ Error.errorMsg (s ++ "\n") a ("In definition of class `" ++ showI i' ++ "`.") Right cl -> return cl - modify $ Map.insert i (Resolved cl) + modify $ Map.insert i' (Resolved cl) return cl + _ -> error "invalid def" -- We already visited this class and were resolving its inheritance chain. -- We must have come from a subclass, which implies a cycle in the hierarchy. Just Resolving -> inhCycleError (codePos $ unwrap $ tsByIdent Map.! i) i (i : cycle ++ [i]) where cycle = takeWhile (/= i) (chain i) - chain i = let ClExtDef _ _ ext _ = tsByIdent Map.! i in ext : chain ext + chain i' = let ClExtDef _ _ ext _ = tsByIdent Map.! i' in ext : chain ext -- We already resolved this class before, either because it was earlier on the definition list -- or one of its subclasses was resolved earlier. Just (Resolved cl) -> return cl @@ -101,24 +102,28 @@ defToMetadata def = do let flds = map defToFld fldDefs mthds <- mapM defToMthd mthdDefs let res = clCons i Nothing flds mthds - lift $ if isRight res then res else clErr res + lift $ case res of + Right{} -> res + Left s -> Left $ errorMsg (s ++ "\n") a ("In definition of class `" ++ showI i ++ "`.") where (i, a, clDefs) = case def of - ClDef a i (ClBlock _ defs) -> (i, a, defs) - ClExtDef a i _ (ClBlock _ defs) -> (i, a, defs) + ClDef a' i' (ClBlock _ defs) -> (i', a', defs) + ClExtDef a' i' _ (ClBlock _ defs) -> (i', a', defs) + _ -> error "invalid def" isFldDef x = case x of FldDef {} -> True _ -> False isMthdDef x = case x of MthDef {} -> True _ -> False - defToFld def@(FldDef _ typ fldI) = fldCons typ fldI def - defToMthd def@(MthDef a typ mthdI args _) = lift $ - let res = mthdCons typ mthdI (Ref () $ Cl () i) args def - in if isRight res then res else mthdErr res - where mthdErr (Left s) = - Left $ errorMsg (s ++ "\n") a ("In definition of method `" ++ showI i ++ "." ++ showI mthdI ++ "`.") - clErr (Left s) = Left $ errorMsg (s ++ "\n") a ("In definition of class `" ++ showI i ++ "`.") + defToFld def'@(FldDef _ typ fldI) = fldCons typ fldI def' + defToFld _ = error "invalid def" + defToMthd def'@(MthDef a' typ mthdI args _) = lift $ + let res = mthdCons typ mthdI (Ref () $ Cl () i) args def' + in case res of + Right{} -> res + Left s -> Left $ errorMsg (s ++ "\n") a' ("In definition of method `" ++ showI i ++ "." ++ showI mthdI ++ "`.") + defToMthd _ = error "invalid def" tdIdent :: TopDef a -> Ident tdIdent x = case x of @@ -135,7 +140,7 @@ inhCycleError :: Maybe Pos -> Ident -> [Ident] -> ClTraversalM a inhCycleError a i cycle = lift $ Left $ Error.errorMsgMb msg a (Just ctx) where msg = "Cycle detected in inheritance hierarchy: " ++ cycleString ++ "." ctx = "In definition of class `" ++ showI i ++ "`." - cycleString = intercalate " -> " (map (\i -> "`" ++ showI i ++ "`") cycle) + cycleString = intercalate " -> " (map (\i' -> "`" ++ showI i' ++ "`") cycle) undefBaseError :: Maybe Pos -> Ident -> Ident -> ClTraversalM a undefBaseError a i ext = lift $ Left $ Error.errorMsgMb msg a (Just ctx) diff --git a/src/Syntax/Abs.hs b/src/Syntax/Abs.hs index 15cde88..2ac679b 100644 --- a/src/Syntax/Abs.hs +++ b/src/Syntax/Abs.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE FlexibleInstances #-} module Syntax.Abs where @@ -8,7 +9,7 @@ import Data.Maybe (fromJust) type Pos = (Int, Int) newtype Ident = Ident String deriving (Eq, Ord, Show, Read) data Program a = Program a [TopDef a] - deriving (Eq, Ord, Show, Read) + deriving (Eq, Ord, Show, Read, Foldable) showI :: Ident -> String showI (Ident i) = i @@ -37,7 +38,7 @@ data TopDef a = FnDef a (Type a) Ident [Arg a] (Block a) | ClDef a Ident (ClBlock a) | ClExtDef a Ident Ident (ClBlock a) - deriving (Eq, Ord, Show, Read) + deriving (Eq, Ord, Show, Read, Foldable) instance Functor TopDef where fmap f x = case x of @@ -52,7 +53,7 @@ instance Unwrappable TopDef where ClExtDef a _ _ _ -> a data Arg a = Arg a (Type a) Ident - deriving (Eq, Ord, Show, Read) + deriving (Eq, Ord, Show, Read, Foldable) instance Functor Arg where fmap f x = case x of @@ -63,7 +64,7 @@ instance Unwrappable Arg where Arg a _ _ -> a data ClBlock a = ClBlock a [ClDef a] - deriving (Eq, Ord, Show, Read) + deriving (Eq, Ord, Show, Read, Foldable) instance Functor ClBlock where fmap f x = case x of @@ -76,7 +77,7 @@ instance Unwrappable ClBlock where data ClDef a = MthDef a (Type a) Ident [Arg a] (Block a) | FldDef a (Type a) Ident - deriving (Eq, Ord, Show, Read) + deriving (Eq, Ord, Show, Read, Foldable) instance Functor ClDef where fmap f x = case x of @@ -89,7 +90,7 @@ instance Unwrappable ClDef where FldDef a _ _ -> a data Block a = Block a [Stmt a] - deriving (Eq, Ord, Show, Read) + deriving (Eq, Ord, Show, Read, Foldable) instance Functor Block where fmap f x = case x of @@ -113,7 +114,7 @@ data Stmt a | While a (Expr a) (Stmt a) | For a (Type a) Ident (Expr a) (Stmt a) | SExp a (Expr a) - deriving (Eq, Ord, Show, Read) + deriving (Eq, Ord, Show, Read, Foldable) instance Functor Stmt where fmap f x = case x of @@ -148,7 +149,7 @@ instance Unwrappable Stmt where SExp a _ -> a data Item a = NoInit a Ident | Init a Ident (Expr a) - deriving (Eq, Ord, Show, Read) + deriving (Eq, Ord, Show, Read, Foldable) instance Functor Item where fmap f x = case x of @@ -170,7 +171,7 @@ data Type a | Cl a Ident | Fun a (Type a) [Type a] | Ref a (Type a) - deriving (Eq, Ord, Show, Read) + deriving (Eq, Ord, Show, Read, Foldable) instance Functor Type where fmap f x = case x of @@ -217,7 +218,7 @@ data Expr a | ERel a (Expr a) (RelOp a) (Expr a) | EAnd a (Expr a) (Expr a) | EOr a (Expr a) (Expr a) - deriving (Eq, Ord, Show, Read) + deriving (Eq, Ord, Show, Read, Foldable) instance Functor Expr where fmap f x = case x of @@ -266,7 +267,7 @@ instance Unwrappable Expr where EOr a _ _ -> a data AddOp a = Plus a | Minus a - deriving (Eq, Ord, Show, Read) + deriving (Eq, Ord, Show, Read, Foldable) instance Functor AddOp where fmap f x = case x of @@ -279,7 +280,7 @@ instance Unwrappable AddOp where Minus a -> a data MulOp a = Times a | Div a | Mod a - deriving (Eq, Ord, Show, Read) + deriving (Eq, Ord, Show, Read, Foldable) instance Functor MulOp where fmap f x = case x of @@ -294,7 +295,7 @@ instance Unwrappable MulOp where Mod a -> a data RelOp a = LTH a | LE a | GTH a | GE a | EQU a | NE a - deriving (Eq, Ord, Show, Read) + deriving (Eq, Ord, Show, Read, Foldable) instance Functor RelOp where fmap f x = case x of diff --git a/src/Syntax/Printer.hs b/src/Syntax/Printer.hs index 8756f7b..54d883a 100644 --- a/src/Syntax/Printer.hs +++ b/src/Syntax/Printer.hs @@ -88,14 +88,14 @@ instance Print (Program a) where instance Print (TopDef a) where prt i e = case e of - FnDef _ type_ id args block -> prPrec i 0 (concatD [prt 0 type_, prt 0 id, doc (showString "("), prt 0 args, doc (showString ")"), prt 0 block]) - ClDef _ id clblock -> prPrec i 0 (concatD [doc (showString "class"), prt 0 id, prt 0 clblock]) - ClExtDef _ id1 id2 clblock -> prPrec i 0 (concatD [doc (showString "class"), prt 0 id1, doc (showString "extends"), prt 0 id2, prt 0 clblock]) + FnDef _ type_ ident args block -> prPrec i 0 (concatD [prt 0 type_, prt 0 ident, doc (showString "("), prt 0 args, doc (showString ")"), prt 0 block]) + ClDef _ ident clblock -> prPrec i 0 (concatD [doc (showString "class"), prt 0 ident, prt 0 clblock]) + ClExtDef _ ident1 ident2 clblock -> prPrec i 0 (concatD [doc (showString "class"), prt 0 ident1, doc (showString "extends"), prt 0 ident2, prt 0 clblock]) prtList _ [x] = (concatD [prt 0 x]) prtList _ (x:xs) = (concatD [prt 0 x, prt 0 xs]) instance Print (Arg a) where prt i e = case e of - Arg _ type_ id -> prPrec i 0 (concatD [prt 0 type_, prt 0 id]) + Arg _ type_ ident -> prPrec i 0 (concatD [prt 0 type_, prt 0 ident]) prtList _ [] = (concatD []) prtList _ [x] = (concatD [prt 0 x]) prtList _ (x:xs) = (concatD [prt 0 x, doc (showString ","), prt 0 xs]) @@ -105,8 +105,8 @@ instance Print (ClBlock a) where instance Print (ClDef a) where prt i e = case e of - MthDef _ type_ id args block -> prPrec i 0 (concatD [prt 0 type_, prt 0 id, doc (showString "("), prt 0 args, doc (showString ")"), prt 0 block]) - FldDef _ type_ id -> prPrec i 0 (concatD [prt 0 type_, prt 0 id, doc (showString ";")]) + MthDef _ type_ ident args block -> prPrec i 0 (concatD [prt 0 type_, prt 0 ident, doc (showString "("), prt 0 args, doc (showString ")"), prt 0 block]) + FldDef _ type_ ident -> prPrec i 0 (concatD [prt 0 type_, prt 0 ident, doc (showString ";")]) prtList _ [] = (concatD []) prtList _ (x:xs) = (concatD [prt 0 x, prt 0 xs]) instance Print (Block a) where @@ -119,21 +119,21 @@ instance Print (Stmt a) where BStmt _ block -> prPrec i 0 (concatD [prt 0 block]) Decl _ type_ items -> prPrec i 0 (concatD [prt 0 type_, prt 0 items, doc (showString ";")]) Ass _ expr1 expr2 -> prPrec i 0 (concatD [prt 0 expr1, doc (showString "="), prt 0 expr2, doc (showString ";")]) - Incr _ id -> prPrec i 0 (concatD [prt 0 id, doc (showString "++"), doc (showString ";")]) - Decr _ id -> prPrec i 0 (concatD [prt 0 id, doc (showString "--"), doc (showString ";")]) + Incr _ ident -> prPrec i 0 (concatD [prt 0 ident, doc (showString "++"), doc (showString ";")]) + Decr _ ident -> prPrec i 0 (concatD [prt 0 ident, doc (showString "--"), doc (showString ";")]) Ret _ expr -> prPrec i 0 (concatD [doc (showString "return"), prt 0 expr, doc (showString ";")]) VRet _ -> prPrec i 0 (concatD [doc (showString "return"), doc (showString ";")]) Cond _ expr stmt -> prPrec i 0 (concatD [doc (showString "if"), doc (showString "("), prt 0 expr, doc (showString ")"), prt 0 stmt]) CondElse _ expr stmt1 stmt2 -> prPrec i 0 (concatD [doc (showString "if"), doc (showString "("), prt 0 expr, doc (showString ")"), prt 0 stmt1, doc (showString "else"), prt 0 stmt2]) While _ expr stmt -> prPrec i 0 (concatD [doc (showString "while"), doc (showString "("), prt 0 expr, doc (showString ")"), prt 0 stmt]) - For _ type_ id expr stmt -> prPrec i 0 (concatD [doc (showString "for"), doc (showString "("), prt 0 type_, prt 0 id, doc (showString ":"), prt 0 expr, doc (showString ")"), prt 0 stmt]) + For _ type_ ident expr stmt -> prPrec i 0 (concatD [doc (showString "for"), doc (showString "("), prt 0 type_, prt 0 ident, doc (showString ":"), prt 0 expr, doc (showString ")"), prt 0 stmt]) SExp _ expr -> prPrec i 0 (concatD [prt 0 expr, doc (showString ";")]) prtList _ [] = (concatD []) prtList _ (x:xs) = (concatD [prt 0 x, prt 0 xs]) instance Print (Item a) where prt i e = case e of - NoInit _ id -> prPrec i 0 (concatD [prt 0 id]) - Init _ id expr -> prPrec i 0 (concatD [prt 0 id, doc (showString "="), prt 0 expr]) + NoInit _ ident -> prPrec i 0 (concatD [prt 0 ident]) + Init _ ident expr -> prPrec i 0 (concatD [prt 0 ident, doc (showString "="), prt 0 expr]) prtList _ [x] = (concatD [prt 0 x]) prtList _ (x:xs) = (concatD [prt 0 x, doc (showString ","), prt 0 xs]) instance Print (Type a) where @@ -144,7 +144,7 @@ instance Print (Type a) where Void _ -> prPrec i 0 (concatD [doc (showString "void")]) Var _ -> prPrec i 0 (concatD [doc (showString "var")]) Arr _ type_ -> prPrec i 0 (concatD [prt 0 type_, doc (showString "[]")]) - Cl _ id -> prPrec i 0 (concatD [prt 0 id]) + Cl _ ident -> prPrec i 0 (concatD [prt 0 ident]) Fun _ type_ types -> prPrec i 0 (concatD [prt 0 type_, doc (showString "("), prt 0 types, doc (showString ")")]) Ref _ type_ -> prPrec i 0 (concatD [prt 0 type_, doc (showString "&")]) prtList _ [] = (concatD []) @@ -152,19 +152,19 @@ instance Print (Type a) where prtList _ (x:xs) = (concatD [prt 0 x, doc (showString ","), prt 0 xs]) instance Print (Expr a) where prt i e = case e of - EVar _ id -> prPrec i 6 (concatD [prt 0 id]) + EVar _ ident -> prPrec i 6 (concatD [prt 0 ident]) ELitInt _ n -> prPrec i 6 (concatD [prt 0 n]) EString _ str -> prPrec i 6 (concatD [prt 0 str]) ELitTrue _ -> prPrec i 6 (concatD [doc (showString "true")]) ELitFalse _ -> prPrec i 6 (concatD [doc (showString "false")]) - ENullI _ id -> prPrec i 6 (concatD [doc (showString "("), prt 0 id, doc (showString ")"), doc (showString "null")]) - ENullArr _ id -> prPrec i 6 (concatD [doc (showString "("), prt 0 id, doc (showString "[]"), doc (showString ")"), doc (showString "null")]) + ENullI _ ident -> prPrec i 6 (concatD [doc (showString "("), prt 0 ident, doc (showString ")"), doc (showString "null")]) + ENullArr _ ident -> prPrec i 6 (concatD [doc (showString "("), prt 0 ident, doc (showString "[]"), doc (showString ")"), doc (showString "null")]) ENull _ type_ -> prPrec i 6 (concatD [doc (showString "("), prt 0 type_, doc (showString ")"), doc (showString "null")]) ENew _ type_ -> prPrec i 6 (concatD [doc (showString "new"), prt 0 type_]) ENewArr _ type_ expr -> prPrec i 6 (concatD [doc (showString "new"), prt 0 type_, doc (showString "["), prt 0 expr, doc (showString "]")]) EApp _ expr exprs -> prPrec i 6 (concatD [prt 6 expr, doc (showString "("), prt 0 exprs, doc (showString ")")]) EIdx _ expr1 expr2 -> prPrec i 6 (concatD [prt 6 expr1, doc (showString "["), prt 0 expr2, doc (showString "]")]) - EAcc _ expr id -> prPrec i 6 (concatD [prt 6 expr, doc (showString "."), prt 0 id]) + EAcc _ expr ident -> prPrec i 6 (concatD [prt 6 expr, doc (showString "."), prt 0 ident]) ENeg _ expr -> prPrec i 5 (concatD [doc (showString "-"), prt 6 expr]) ENot _ expr -> prPrec i 5 (concatD [doc (showString "!"), prt 6 expr]) EMul _ expr1 mulop expr2 -> prPrec i 4 (concatD [prt 4 expr1, prt 0 mulop, prt 5 expr2]) diff --git a/src/Syntax/Rewriter.hs b/src/Syntax/Rewriter.hs index 43df3c0..92fb034 100644 --- a/src/Syntax/Rewriter.hs +++ b/src/Syntax/Rewriter.hs @@ -53,34 +53,34 @@ rewriteStmt stmt = Decr _ i -> Decr code i Ret _ expr -> Ret code (rewriteExpr expr) VRet _ -> VRet code - Cond _ expr stmt -> Cond code (rewriteExpr expr) (blkWrap $ rewriteStmt stmt) + Cond _ expr stmt' -> Cond code (rewriteExpr expr) (blkWrap $ rewriteStmt stmt') CondElse _ expr stmt1 stmt2 -> CondElse code (rewriteExpr expr) (blkWrap $ rewriteStmt stmt1) (blkWrap $ rewriteStmt stmt2) - While _ expr stmt -> While code (rewriteExpr expr) (blkWrap $ rewriteStmt stmt) - For _ t i expr stmt -> let expr' = rewriteExpr expr - stmt' = rewriteStmt stmt - t' = rewriteType t - exprCode = unwrap expr' - stmtCode = unwrap stmt' - tCode = unwrap t' - arrDecl = Decl exprCode (Var exprCode) [Init exprCode forArrayIdent expr'] - idxDecl = Decl exprCode (Int exprCode) [Init exprCode forIndexIdent (ELitInt exprCode 0)] - arrVar = EVar exprCode forArrayIdent - idxVar = EVar exprCode forIndexIdent - lenExpr = EAcc exprCode arrVar arrayLengthIdent - whileGuard = ERel exprCode idxVar (LTH exprCode) lenExpr - arrAccess = EIdx exprCode arrVar idxVar - elemDecl = Decl tCode t' [Init tCode i arrAccess] - idxIncr = Incr exprCode forIndexIdent -{- { -} in BStmt stmtCode $ Block stmtCode [ -{- var ~l_arr = ; -} arrDecl, -{- int ~l_idx = 0; -} idxDecl, -{- while(~l_idx < ~l_arr.length)-} While stmtCode whileGuard $ -{- { -} BStmt stmtCode $ Block stmtCode [ -{- = ~l_arr[~l_idx];-} elemDecl, -{- -} stmt', -{- ~l_idx++; -} idxIncr -{- } -} ] -{- } -} ] + While _ expr stmt' -> While code (rewriteExpr expr) (blkWrap $ rewriteStmt stmt') + For _ t i expr stmt' -> let expr' = rewriteExpr expr + stmt'' = rewriteStmt stmt' + t' = rewriteType t + exprCode = unwrap expr' + stmtCode = unwrap stmt'' + tCode = unwrap t' + arrDecl = Decl exprCode (Var exprCode) [Init exprCode forArrayIdent expr'] + idxDecl = Decl exprCode (Int exprCode) [Init exprCode forIndexIdent (ELitInt exprCode 0)] + arrVar = EVar exprCode forArrayIdent + idxVar = EVar exprCode forIndexIdent + lenExpr = EAcc exprCode arrVar arrayLengthIdent + whileGuard = ERel exprCode idxVar (LTH exprCode) lenExpr + arrAccess = EIdx exprCode arrVar idxVar + elemDecl = Decl tCode t' [Init tCode i arrAccess] + idxIncr = Incr exprCode forIndexIdent +{- { -} in BStmt stmtCode $ Block stmtCode [ +{- var ~l_arr = ; -} arrDecl, +{- int ~l_idx = 0; -} idxDecl, +{- while(~l_idx < ~l_arr.length)-} While stmtCode whileGuard $ +{- { -} BStmt stmtCode $ Block stmtCode [ +{- = ~l_arr[~l_idx];-} elemDecl, +{- -} stmt'', +{- ~l_idx++; -} idxIncr +{- } -} ] +{- } -} ] SExp _ expr -> SExp code (rewriteExpr expr) -- Wrap a single statement into a block. @@ -101,26 +101,26 @@ rewriteExpr :: Expr Pos -> Expr Code rewriteExpr expr = let code = toCode expr expr' = case expr of - EVar _ i -> EVar code i - ELitInt _ n -> ELitInt code n - EString _ s -> EString code s - ELitTrue _ -> ELitTrue code - ELitFalse _ -> ELitFalse code - ENullI _ i -> ENull code (Cl code i) - ENullArr _ i -> ENull code (Arr code (Cl code i)) - ENull _ type_ -> ENull code (rewriteType type_) - ENew _ t -> ENew code (rewriteType t) - ENewArr _ t expr -> ENewArr code (rewriteType t) (rewriteExpr expr) - EApp _ expr exprs -> EApp code (rewriteExpr expr) (map rewriteExpr exprs) - EIdx _ expr1 expr2 -> EIdx code (rewriteExpr expr1) (rewriteExpr expr2) - EAcc _ expr i -> EAcc code (rewriteExpr expr) i - ENeg _ expr -> ENeg code (rewriteExpr expr) - ENot _ expr -> ENot code (rewriteExpr expr) + EVar _ i -> EVar code i + ELitInt _ n -> ELitInt code n + EString _ s -> EString code s + ELitTrue _ -> ELitTrue code + ELitFalse _ -> ELitFalse code + ENullI _ i -> ENull code (Cl code i) + ENullArr _ i -> ENull code (Arr code (Cl code i)) + ENull _ type_ -> ENull code (rewriteType type_) + ENew _ t -> ENew code (rewriteType t) + ENewArr _ t expr'' -> ENewArr code (rewriteType t) (rewriteExpr expr'') + EApp _ expr'' exprs -> EApp code (rewriteExpr expr'') (map rewriteExpr exprs) + EIdx _ expr1 expr2 -> EIdx code (rewriteExpr expr1) (rewriteExpr expr2) + EAcc _ expr'' i -> EAcc code (rewriteExpr expr'') i + ENeg _ expr'' -> ENeg code (rewriteExpr expr'') + ENot _ expr'' -> ENot code (rewriteExpr expr'') EMul _ expr1 op expr2 -> EMul code (rewriteExpr expr1) (nullRewrite op) (rewriteExpr expr2) EAdd _ expr1 op expr2 -> EAdd code (rewriteExpr expr1) (nullRewrite op) (rewriteExpr expr2) ERel _ expr1 op expr2 -> ERel code (rewriteExpr expr1) (nullRewrite op) (rewriteExpr expr2) - EAnd _ expr1 expr2 -> EAnd code (rewriteExpr expr1) (rewriteExpr expr2) - EOr _ expr1 expr2 -> EOr code (rewriteExpr expr1) (rewriteExpr expr2) + EAnd _ expr1 expr2 -> EAnd code (rewriteExpr expr1) (rewriteExpr expr2) + EOr _ expr1 expr2 -> EOr code (rewriteExpr expr1) (rewriteExpr expr2) in calcConstexpr expr' -- Calculate the value of an expression containing only constants or trivial cases as leaves. @@ -167,6 +167,7 @@ calcConstexpr srcExpr = case srcExpr of (ENull {}, ENull {}) -> case op of EQU _ -> ELitTrue code NE _ -> ELitFalse code + _ -> srcExpr _ -> srcExpr EAnd code expr1 expr2 -> case (expr1, expr2) of (ELitTrue _, ELitTrue _) -> ELitTrue code diff --git a/src/Utilities.hs b/src/Utilities.hs new file mode 100644 index 0000000..0c3c75e --- /dev/null +++ b/src/Utilities.hs @@ -0,0 +1,80 @@ +module Utilities where + +import Control.Monad (unless, when) +import Data.Bits (Bits, countLeadingZeros, (.&.)) +import Data.Foldable (find) +import Data.Int +import Data.List (sort, sortOn) +import qualified Data.Map as Map +import Data.Maybe (fromJust, fromMaybe) + +isPowerOfTwo :: (Bits i, Integral i) => i -> Bool +isPowerOfTwo 0 = False +isPowerOfTwo n = n .&. (n-1) == 0 + +log2 :: Int32 -> Int +log2 = (31 -) . countLeadingZeros + +unlessM :: Monad m => m Bool -> m () -> m () +unlessM p a = do + b <- p + unless b a + +whenM :: Monad m => m Bool -> m () -> m () +whenM p a = do + b <- p + when b a + +-- Find duplicates in a given list based on a key selector. +-- Returns a deduplicated list of duplicated keys and a list of values such that +-- there exists a value with the same key. +findDupsBy :: Ord k => (a -> k) -> [a] -> ([k], [a]) +findDupsBy f ds = collect $ foldr checkForDup (Map.empty, []) ds + where + checkForDup a (m, dups) = + let k = f a + in if Map.member k m then (m, (k, a) : dups) else (Map.insert k a m, dups) + collect (m, dups) = + let (ks, as) = unzip dups in (ks, foldr (\k as' -> m Map.! k : as') as ks) + +-- Inner join based on a key selector of two lists. +-- Returns a deduplicated list of keys that participated in a join +-- and the list of resulting products. +findConflictsBy :: Ord k => (a -> k) -> (b -> k) -> [a] -> [b] -> ([k], [(a, b)]) +findConflictsBy fa fb as bs = unzip $ foldr checkForConfl [] bs + where + m = Map.fromList $ zip (map fa as) as + checkForConfl b confls = + let k = fb b + in case Map.lookup k m of + Nothing -> confls + Just a -> (k, (a, b)) : confls + +-- O(nlogn) deduplication. +dedup :: Ord a => [a] -> [a] +dedup xs = run (sort xs) + where run [] = [] + run (x:xs') = x : run (dropWhile (== x) xs' ) + +-- O(nlogn) deduplication by key. +dedupBy :: Ord k => (a -> k) -> [a] -> [a] +dedupBy f xs = run (sortOn fst $ map (\x -> (f x, x)) xs) + where run [] = [] + run ((k, x):xs') = x : run (dropWhile ((== k) . fst) xs') + +ffirst :: (Foldable f) => f a -> Maybe a +ffirst = find (const True) + +single :: (Foldable f) => f a -> a +single xs = fromMaybe (error "single: empty structure") (ffirst xs) + +fixpoint :: (Eq a) => (a -> a) -> a -> a +fixpoint f x = let x' = f x in if x == x' then x else fixpoint f x' + +splitLast :: [a] -> (a, [a]) +splitLast [] = error "empty" +splitLast xs = + let (a, as) = foldr f (Nothing, []) xs + in (fromJust a, as) + where f x (Nothing, as) = (Just x, as) + f x' (x, as) = (x, x':as) diff --git a/src/X86_64/CodeGen/Consts.hs b/src/X86_64/CodeGen/Consts.hs new file mode 100644 index 0000000..01f3b1b --- /dev/null +++ b/src/X86_64/CodeGen/Consts.hs @@ -0,0 +1,33 @@ +-- Sets of string constants. +module X86_64.CodeGen.Consts where + +import qualified Data.Map as Map +import Identifiers + +-- Represents a string constant c of the form: +-- : +-- .string "" +data Const = Const {constName :: String, constValue :: String} + +-- Set of string constants where each literal string is guaranteed +-- to be uniquely mapped to a named constant. +newtype ConstSet = ConstSet (Map.Map String Const) + +-- Empty set. +constsEmpty :: ConstSet +constsEmpty = ConstSet Map.empty + +-- Add the given literal to the set. If it is already +-- part of the set the associated constant is returned +-- and the set is unchanged. +constsAdd :: String -> ConstSet -> (Const, ConstSet) +constsAdd s (ConstSet set) = + let n = Map.size set + 1 + c = Const (constIdent $ show n) s + in case Map.lookup s set of + Just c' -> (c', ConstSet set) + Nothing -> (c, ConstSet $ Map.insert s c set) + +-- All constants in the set. +constsElems :: ConstSet -> [Const] +constsElems (ConstSet set) = Map.elems set diff --git a/src/X86_64/CodeGen/Emit.hs b/src/X86_64/CodeGen/Emit.hs new file mode 100644 index 0000000..cec5b84 --- /dev/null +++ b/src/X86_64/CodeGen/Emit.hs @@ -0,0 +1,368 @@ +-- Instruction set used by the codegen and functions to emit them. +-- Uses AT&T syntax. +module X86_64.CodeGen.Emit ( + EmitM(..), + emitAsString, + add, + and, + call, + cdq, + cmp, + constDef, + decrStack, + extern, + globalMain, + idiv, + imul, + incrStack, + jmp, + jz, + label, + leave, + leaOfConst, + movToReg, + movToStack, + neg, + pop, + push, + ret, + sal, + sar, + sete, + setg, + setge, + setl, + setle, + setne, + sub, + test, + xor, +) where + +import Data.Int +import Espresso.Syntax.Abs +import Identifiers +import Prelude hiding (and) +import X86_64.CodeGen.Consts +import X86_64.Loc +import X86_64.Registers hiding (reg) +import X86_64.Size + +class EmitM m where + -- Emit a single instruction. + emit :: String -> m () + +newtype PhonyEmit a = PE String + +instance EmitM PhonyEmit where + emit = PE + +emitAsString :: PhonyEmit () -> String +emitAsString f = let PE s = f in s + +-- Emit an addition operation between a source and destination location. +-- Saves the result in the destination. +-- add , +-- where is the AT&T instruction suffix based on . +add :: EmitM m => Loc -> Loc -> m () +add src dest = + let srcString = loc Double src + destString = loc Double dest + in case (src, dest) of + (_, LocImm _) -> error "internal error. add to immediate" + (LocStack _, LocStack _) -> error "internal error. add from stack to stack" + _ -> emitInd $ bin "add" Double srcString destString "" + +-- Emit an and operation between a source and destination location. +-- Saves the result in the destination. +-- and , +-- where is the AT&T instruction suffix based on . +and :: EmitM m => Size -> Loc -> Loc -> String -> m () +and size src dest comment_ = + let srcString = loc size src + destString = loc size dest + in case (src, dest) of + (_, LocImm _) -> error "internal error. and to immediate" + (LocStack _, LocStack _) -> error "internal error. and from stack to stack" + _ -> emitInd $ bin "and" size srcString destString comment_ + +-- Emit a call instruction. +-- call +call :: EmitM m => String -> m () +call f = emitInd $ "call " ++ sanitiseAssembly f + +-- Emit a sign-extend instruction for division purposes, see idiv. +-- Loads the sign of eax into edx. +-- cdq +cdq :: EmitM m => m () +cdq = emitInd "cdq" + +-- Emit a comparison between two locations, where the first location +-- is logically the right-hand-side of the comparison. +-- cmp , +-- where is the AT&T instruction suffix based on . +cmp :: EmitM m => Size -> Loc -> Loc -> m () +cmp size rhs lhs = + let rhsString = loc size rhs + lhsString = loc size lhs + in case (rhs, lhs) of + (LocImm _, LocImm _) -> error "internal error. cmp on immediates" + (LocStack _, LocStack _) -> error "internal error. cmp on two stack locs" + _ -> emitInd $ bin "cmp" size rhsString lhsString "" + +-- Emit a label to a compile-time constant string. +constDef :: EmitM m => Const -> m () +constDef c = emit $ constName c ++ ":\n .string " ++ show (constValue c) + +-- Emit an instruction logically decreasing the stack +-- by increasing the rsp pointer. +-- subq $, %rsp # +decrStack :: EmitM m => Int64 -> m () +decrStack n = emitInd $ "addq " ++ lit64 n ++ ", %rsp" + +-- Emit a declaration of an external call target. +extern :: EmitM m => String -> m () +extern s = emit $ ".extern " ++ s + +-- Emit a declaration of the main function as entry point. +globalMain :: EmitM m => m () +globalMain = emit ".global main" + +-- Emit an instruction logically increasing the stack +-- by decreasing the rsp pointer. +-- subq $, %rsp # +incrStack :: EmitM m => Int64 -> String -> m () +incrStack n comment_ = emitInd $ "subq " ++ lit64 n ++ ", %rsp" ++ comment comment_ + +-- Emit a division instruction. +-- The left-hand-side has to be loaded to the eax register +-- and sign-extended to edx manually or by using the cdq instruction. +-- The other location must not be an immediate. +-- The division is stored in eax and the remainder in edx. +-- idiv +-- where is the AT&T instruction suffix based on . +idiv :: EmitM m => Size -> Loc -> m () +idiv size loc_ = case loc_ of + LocImm {} -> error "internal error. idiv on an immediate." + _ -> emitInd $ "idiv" ++ sizeSuf size ++ " " ++ loc size loc_ + +-- Emit a multiplication operation between a source and destination location. +-- imul , +-- where is the AT&T instruction suffix based on . +imul :: EmitM m => Loc -> Loc -> m () +imul src dest = + let srcString = loc Double src + destString = loc Double dest + in case (src, dest) of + (_, LocImm _) -> error "internal error. mul to immediate" + (LocStack _, LocStack _) -> error "internal error. mul from stack to stack" + _ -> emitInd $ bin "imul" Double srcString destString "" + +-- Emit a jump to a label. +-- jmp +jmp :: EmitM m => LabIdent -> m () +jmp (LabIdent l) = emitInd $ "jmp " ++ sanitiseAssembly l + +-- Emit a conditional jump instruction that tests the ZF CPU flag +-- and jumps if it is set. +-- jz +jz :: EmitM m => LabIdent -> m () +jz (LabIdent l) = emitInd $ "jz " ++ sanitiseAssembly l + +-- Emit a label. +-- : # +label :: EmitM m => LabIdent -> String -> m () +label (LabIdent l) comment_ = emit $ sanitiseAssembly l ++ ":" ++ comment comment_ + +-- Emit an address load operation for a compile-time string constant. +-- lea (%rip), % +-- where is the AT&T instruction suffix based on . +leaOfConst :: EmitM m => Const -> Reg -> m () +leaOfConst c dest = + emitInd $ "lea " ++ constName c ++ "(%rip), " ++ reg (reg64 dest) + +-- Emit a standard epilogue leave instruction +-- that restores the rsp and rbp registers. +leave :: EmitM m => m () +leave = emitInd "leave" + +-- Emit a move from a source location to a register. +-- mov , % # +-- where is the AT&T instruction suffix based on . +movToReg :: EmitM m => Size -> Loc -> Reg -> String -> m () +movToReg size src dest comment_ = + let srcString = loc size src + in emitInd $ bin "mov" size srcString (sizedReg size dest) comment_ + +-- Emit a move from a source location to a stack destination. +-- mov , (%rbp) # +-- where is the AT&T instruction suffix based on . +movToStack :: EmitM m => Size -> Loc -> Int64 -> String -> m () +movToStack size src stackDest comment_ = case src of + LocReg reg_ -> emitInd $ bin "mov" size (sizedReg size reg_) (stack stackDest) comment_ + LocImm int -> emitInd $ bin "mov" size (lit32 int) (stack stackDest) comment_ + LocStack _ -> error "internal error. mov from stack to stack" + +-- Emit a negation operation on a register. +-- neg % +neg :: EmitM m => Reg -> m () +neg reg_ = emitInd $ "neg" ++ sizeSuf Double ++ " " ++ sizedReg Double reg_ + +-- Emit a pop instruction that pops the top of the stack into the location. +-- The size of the pop is always 8 bytes. +-- pop +pop :: EmitM m => Loc -> m () +pop srcloc = emitInd $ "pop " ++ loc Quadruple srcloc + +-- Emit a push instruction that pushes contents of the location on the stack. +-- The size of the push is always 8 bytes. +-- push +push :: EmitM m => Loc -> String -> m () +push srcloc comment_ = emitInd $ "push " ++ loc Quadruple srcloc ++ comment comment_ + +-- Emit a ret instruction that ends the current function call. +ret :: EmitM m => m () +ret = emitInd "ret" + +-- Emit an instruction that shifts a register bitwise to the left by a given offset. +-- Logically this is a multiply-by-2^n operation. +-- sall $, % +sal :: EmitM m => Int -> Reg -> String -> m () +sal n loc_ comment_ = emitInd $ "sal " ++ lit n ++ ", " ++ sizedReg Double loc_ ++ comment comment_ + +-- Emit an instruction that shifts a register bitwise to the right by a given offset. +-- Logically this is a divide-by-2^n operation. +-- sarl $, % +sar :: EmitM m => Int -> Reg -> String -> m () +sar n loc_ comment_ = emitInd $ "sar " ++ lit n ++ ", " ++ sizedReg Double loc_ ++ comment comment_ + +-- Emit an instruction that loads 1 or 0 into a register based on +-- the result of the previous cmp operation interpreted as an +-- equal-to comparison. +-- sete % +sete :: EmitM m => Reg -> m () +sete reg_ = emitInd $ "sete " ++ sizedReg Byte reg_ + +-- Emit an instruction that loads 1 or 0 into a register based on +-- the result of the previous cmp operation interpreted as a +-- greater-than comparison. +-- setg % +setg :: EmitM m => Reg -> m () +setg reg_ = emitInd $ "setg " ++ sizedReg Byte reg_ + +-- Emit an instruction that loads 1 or 0 into a register based on +-- the result of the previous cmp operation interpreted as a +-- greater-than-or-equal-to comparison. +-- setge % +setge :: EmitM m => Reg -> m () +setge reg_ = emitInd $ "setge " ++ sizedReg Byte reg_ + +-- Emit an instruction that loads 1 or 0 into a register based on +-- the result of the previous cmp operation interpreted as a +-- less-than comparison. +-- setl % +setl :: EmitM m => Reg -> m () +setl reg_ = emitInd $ "setl " ++ sizedReg Byte reg_ + +-- Emit an instruction that loads 1 or 0 into a register based on +-- the result of the previous cmp operation interpreted as a +-- less-than-or-equal-to comparison. +-- setle % +setle :: EmitM m => Reg -> m () +setle reg_ = emitInd $ "setle " ++ sizedReg Byte reg_ + +-- Emit an instruction that loads 1 or 0 into a register based on +-- the result of the previous cmp operation interpreted as a +-- not-equal-to comparison. +-- setne % +setne :: EmitM m => Reg -> m () +setne reg_ = emitInd $ "setne " ++ sizedReg Byte reg_ +-- Emit a subtraction operation between a source and destination location (dest - src). +-- sub , +-- where is the AT&T instruction suffix based on . +sub :: EmitM m => Loc -> Loc -> m () +sub src dest = + let srcString = loc Double src + destString = loc Double dest + in case (src, dest) of + (_, LocImm _) -> error "internal error. sub to immediate" + (LocStack _, LocStack _) -> error "internal error. sub from stack to stack" + _ -> emitInd $ bin "sub" Double srcString destString "" + +-- Emit a test instruction between two locations that sets CPU flags +-- based on the result of a bitwise-and performed on the operands. +-- The operands are considered for their lower 8 bytes only. +-- testb , +test :: EmitM m => Loc -> Loc -> m () +test op1 op2 = + let op1String = loc Byte op1 + op2String = loc Byte op2 + in emitInd $ bin "test" Byte op1String op2String "" + +-- Emit a xor operation between a source and destination location. +-- Saves the result in the destination. +-- xor , +-- where is the AT&T instruction suffix based on . +xor :: EmitM m => Size -> Loc -> Loc -> m () +xor size src dest = + let srcString = loc size src + destString = loc size dest + in case (src, dest) of + (LocImm _, LocImm _) -> error "internal error. xor on immediates" + (LocStack _, LocStack _) -> error "internal error. xor on two stack locs" + _ -> emitInd $ bin "xor" size srcString destString "" + +-- String representation of a binary instruction with a given size suffix, +-- two operands and an end-of-line comment. +bin :: String -> Size -> String -> String -> String -> String +bin instr size x y comment_ = instr ++ sizeSuf size ++ " " ++ x ++ ", " ++ y ++ comment comment_ + +-- String representation of an end-of-line comment +comment :: String -> String +comment [] = [] +comment s = ' ':'#':' ':s + +-- Emit an instruction indented by 2 spaces. +emitInd :: EmitM m => String -> m () +emitInd s = emit (" " ++ s) + +-- String representation of an integral literal. +lit :: Int -> String +lit n = '$':show n + +-- String representation of an integral literal. +lit32 :: Int32 -> String +lit32 n = '$':show n + +-- String representation of an integral literal. +lit64 :: Int64 -> String +lit64 n = '$':show n + +-- String representation of a location. +loc :: Size -> Loc -> String +loc size loc_ = case loc_ of + LocReg r -> sizedReg size r + LocStack n -> stack n + LocImm n -> lit32 n + +-- String representation of a register (full 64-bits). +reg :: String -> String +reg r = '%':r + +-- String representation of a register identifier for a given size. +sizedReg :: Size -> Reg -> String +sizedReg size r = case size of + Byte -> reg $ reg8 r + Double -> reg $ reg32 r + Quadruple -> reg $ reg64 r + +-- AT&T size suffix for a given operand size. +sizeSuf :: Size -> String +sizeSuf s = case s of + Byte -> "b" + Double -> "l" + Quadruple -> "q" + +-- String representation of a stack location. +stack :: Int64 -> String +stack n = show n ++ "(%rbp)" diff --git a/src/X86_64/CodeGen/Epilogue.hs b/src/X86_64/CodeGen/Epilogue.hs new file mode 100644 index 0000000..0dab46d --- /dev/null +++ b/src/X86_64/CodeGen/Epilogue.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE FlexibleInstances #-} +module X86_64.CodeGen.Epilogue (withEpilogue) where + +import Data.List (sortOn) +import Data.Ord (Down (Down)) +import qualified Data.Set as Set +import qualified X86_64.CodeGen.Emit as Emit +import X86_64.CodeGen.GenM +import X86_64.Loc +import X86_64.Registers + +withEpilogue :: Store -> CompiledMethod -> CompiledMethod +withEpilogue st mthd = + let savedRegs = sortOn Down $ filter (\r -> regType r == CalleeSaved) $ Set.elems $ usedRegs st + neededAlignment = odd $ length savedRegs + epilogue = + Emit.leave : + [Emit.decrStack 8 | neededAlignment] ++ + map (Emit.pop . LocReg) savedRegs ++ + [Emit.ret] + in mthd {mthdEpilogue = map Emit.emitAsString epilogue} diff --git a/src/X86_64/CodeGen/GenM.hs b/src/X86_64/CodeGen/GenM.hs new file mode 100644 index 0000000..a7c1068 --- /dev/null +++ b/src/X86_64/CodeGen/GenM.hs @@ -0,0 +1,259 @@ +{-# LANGUAGE FlexibleInstances #-} +module X86_64.CodeGen.GenM ( + fullTrace, + getRegS, + getValLoc, + getValUnreservedReg, + getVarS, + isLive, + label, + newStrConst, + newVar, + nonStackLoc, + setRegS, + setStack, + setVarS, + traceM', + useReg, + useVal, + varSize, + CompiledMethod(..), + Env(..), + GenM, + Store(..), + VarState(..) +) where + +import Control.Monad.Reader +import Control.Monad.State +import Data.List +import qualified Data.Map as Map +import qualified Data.Set as Set +import Debug.Trace +import Espresso.ControlFlow.Liveness +import Espresso.Syntax.Abs +import Identifiers +import X86_64.CodeGen.Consts +import qualified X86_64.CodeGen.Emit as Emit +import X86_64.CodeGen.Stack +import X86_64.Loc +import X86_64.Registers +import X86_64.Size + +traceEnabled :: Bool +traceEnabled = False + +data VarState = VarS { + varName :: ValIdent, + varType :: SType (), + -- Locations in which the value of this variable currently resides. + varLocs :: [Loc], + -- All names this value is available under, including this valName. + varAliases :: [ValIdent]} + +data Store = St { + -- All code generated thus far, in reverse. + allCode :: [String], + -- All code generated for the current basic block, in reverse. + bbCode :: [String], + -- All string constants used thus far. + consts :: ConstSet, + -- The current state of the stack. + stack :: Stack, + -- All registers used in the current method. + usedRegs :: Set.Set Reg, + -- Descriptions of registers. + regs :: Map.Map Reg RegState, + -- Descriptions of variables. + vars :: Map.Map ValIdent VarState, + -- Currently live variables and their next usage. + live :: NextUse, + traceIdx :: Integer -- debug +} + +data Env = Env { + -- Generator of labels for the current method. + labelGen :: LabIdent -> LabIdent, + -- Liveness data for the current instruction. + liveness :: Liveness +} + +data CompiledMethod = CmpMthd { + -- Label of the method start, the target for calls. + mthdEntry :: String, + mthdPrologue :: [String], + mthdCode :: [String], + mthdEpilogue :: [String] +} + +type GenM = StateT Store (Reader Env) + +instance Emit.EmitM GenM where + emit s = modify (\st -> st {bbCode = s:bbCode st}) + +newStrConst :: String -> GenM Const +newStrConst s = do + (c, cs) <- gets (constsAdd s . consts) + modify (\st -> st{consts = cs}) + return c + +-- Generate a label in the context of the current method. +label :: LabIdent -> GenM LabIdent +label l = asks (`labelGen` l) + +setStack :: Stack -> GenM () +setStack s = modify (\st -> st {stack = s}) + +-- Mark the variable as already used in this instruction, +-- possibly freeing it if it is dead after the current instruction. +useVar :: ValIdent -> GenM () +useVar vi = do + l <- asks liveness + unless (toStr vi `Map.member` liveOut l) (do + modify (\st -> st {live = Map.delete (toStr vi) (live st)}) + free vi) + +-- Mark the value as already used in this instruction, +-- possibly freeing the associated variable if it is dead after the +-- current instruction. +useVal :: Val a -> GenM () +useVal val = case val of + VVal _ _ vi -> useVar vi + _ -> return () + +-- Remove the variable from all locations it is in. +free :: ValIdent -> GenM () +free vi = do + mbvarS <- lookupVarS vi + case mbvarS of + Just varS -> do + forM_ (varLocs varS) (freeFromLoc varS) + varsMap <- gets vars + let varsMap' = Map.map (\vs -> vs {varAliases = filter (/= vi) (varAliases vs)}) $ + Map.adjust (\vs -> vs {varAliases = [vi], varLocs = []}) vi varsMap + modify (\st -> st {vars = varsMap'}) + Nothing -> return () + +-- Remove the variable from a given location. +freeFromLoc :: VarState -> Loc -> GenM () +freeFromLoc varS loc = case loc of + LocReg reg_ -> do + regS <- getRegS reg_ + let regS' = regS {regVals = filter (/= varName varS) (regVals regS)} + setRegS regS' + LocStack _ -> do + s <- gets stack + let s' = stackDelete (varName varS) s + modify (\st -> st {stack = s'}) + _ -> return () + +-- Get the description of a variable. +getVarS :: ValIdent -> GenM VarState +getVarS vi = do + mb <- gets (Map.lookup vi . vars) + case mb of + Nothing -> error $ "internal error. no varS for var " ++ show vi + Just g -> return g + +-- Lookup the description of a variable. +lookupVarS :: ValIdent -> GenM (Maybe VarState) +lookupVarS vi = gets (Map.lookup vi . vars) + +-- Get the description of a register. +getRegS :: Reg -> GenM RegState +getRegS reg_ = do + mb <- gets (Map.lookup reg_ . regs) + case mb of + Nothing -> error $ "internal error. no regS for reg " ++ show reg_ + Just g -> return g + +-- Update the description of a variable. +setVarS :: VarState -> GenM () +setVarS varS = modify (\st -> st {vars = Map.insert (varName varS) varS (vars st)}) + +-- Update the description of a register. +setRegS :: RegState -> GenM () +setRegS regS = modify (\st -> st {regs = Map.insert (reg regS) regS (regs st)}) + +-- Get any non-stack location of a variable. +nonStackLoc :: VarState -> Maybe Loc +nonStackLoc varS = find isNonStack (varLocs varS) + +-- Get the size of a variable. +varSize :: VarState -> Size +varSize varS = typeSize $ varType varS + +-- Mark a register as used within this method +-- for the purposes of preserving callee-saved registers. +useReg :: Reg -> GenM RegState +useReg reg_ = do + modify (\st -> st {usedRegs = Set.insert reg_ $ usedRegs st}) + mbregS <- gets (Map.lookup reg_ . regs) + case mbregS of + Just regS -> return regS + Nothing -> do + let regS = initialRegs Map.! reg_ + setRegS regS + return regS + +-- Create a new variable or completely kill it if it exists, +-- freeing it from all current locations. +newVar :: ValIdent -> SType () -> GenM () +newVar vi t = do + free vi + l <- asks liveness + case Map.lookup (toStr vi) (liveOut l) of + Just next -> modify (\st -> st {live = Map.insert (toStr vi) next (live st)}) + Nothing -> return () + setVarS $ VarS vi t [] [vi] + +-- Is the variable currently alive. +isLive :: ValIdent -> GenM Bool +isLive (ValIdent vi) = gets $ Map.member vi . live + +-- Get the location of a value. +-- If the value is a variable, the "best" location is returned, +-- i.e. immediates are preferred over registers, which are preferred +-- over memory locations. +getValLoc :: Val a -> GenM Loc +getValLoc val = case val of + VInt _ n -> return $ LocImm (fromInteger n) + VNegInt _ n -> return $ LocImm (fromInteger $ -n) + VTrue _ -> return $ LocImm 1 + VFalse _ -> return $ LocImm 0 + VVal _ _ vi -> do + varS <- getVarS vi + case sort $ varLocs varS of + [] -> gets traceIdx >>= (\idx -> error $ "no locations for var " ++ toStr vi ++ " {" ++ show idx ++ "}") + x:_ -> return x + VNull _ -> return $ LocImm 0 + +-- Try to get an unreserved register containing the given value. +getValUnreservedReg :: Val a -> GenM (Maybe Reg) +getValUnreservedReg val = case val of + VVal _ _ vi -> do + varS <- getVarS vi + let regLocs = filter isReg (varLocs varS) + regSs <- mapM (getRegS . asReg) regLocs + return $ reg <$> find (not . regReserved) regSs + _ -> return Nothing + +-- Debug + +fullTrace :: GenM () +fullTrace = do + l <- gets live + traceM' ("live: " ++ show (Set.elems $ Map.keysSet $ l)) + varSs <- gets (Map.elems . vars) + s <- gets stack + traceM' ("stack: " ++ show (Map.toList $ stackOccupiedSlots s) ++ ", " ++ show (stackReservedSize s) ++ " + " ++ show (stackOverheadSize s)) + mapM_ (\vs -> traceM' ("value " ++ toStr (varName vs) ++ ", " + ++ "aliases: " ++ intercalate ", " (map toStr (varAliases vs)) + ++ " locs: " ++ intercalate ", " (map show (varLocs vs)))) varSs + +traceM' :: String -> GenM () +traceM' s = when traceEnabled (do + idx <- gets traceIdx + modify (\st -> st{traceIdx = idx + 1}) + traceM ("{" ++ show idx ++ "} " ++ s) + ) diff --git a/src/X86_64/CodeGen/Generator.hs b/src/X86_64/CodeGen/Generator.hs new file mode 100644 index 0000000..287f18e --- /dev/null +++ b/src/X86_64/CodeGen/Generator.hs @@ -0,0 +1,369 @@ +-- The core assembly codegen module. +-- Many debug traces are included in this code, controlled by the switch +-- traceEnabled in X86_64.CodeGen.GenM. +{-# LANGUAGE FlexibleInstances #-} +module X86_64.CodeGen.Generator (generate) where + +import Control.Monad.Reader +import Control.Monad.State +import Data.Bifunctor (Bifunctor (second)) +import Data.List (partition) +import qualified Data.Map as Map +import qualified Data.Set as Set +import Espresso.ControlFlow.CFG (CFG (..), Node (..)) +import Espresso.ControlFlow.Liveness +import Espresso.Syntax.Abs +import Espresso.Types (isInt, isStr, valType) +import Identifiers +import Utilities (isPowerOfTwo, log2, single) +import X86_64.CodeGen.Consts +import qualified X86_64.CodeGen.Emit as Emit +import X86_64.CodeGen.Epilogue +import X86_64.CodeGen.GenM +import X86_64.CodeGen.Module +import X86_64.CodeGen.Prologue +import X86_64.CodeGen.RegisterAllocation +import X86_64.CodeGen.Stack +import X86_64.Loc +import X86_64.Registers +import X86_64.Size + +generate :: [(CFG Liveness, Method a)] -> String +generate mthds = + let (mthds', cs) = foldr go ([], constsEmpty) mthds + in generateModule mthds' cs + where + go (cfg@(CFG g), Mthd _ _ qi ps _) (xs, cs) = + let initStack = stackReserve (map (second typeSize) locals) stackEmpty + initState = St [] [] cs initStack Set.empty initialRegs Map.empty Map.empty 0 + st = runReader (execStateT goOne initState) (Env (labelFor qi) emptyLiveness) + rawMthd = CmpMthd (toStr $ labelFor qi entryLabel) [] (reverse $ allCode st) [] + mthd = withEpilogue st $ withPrologue qi st rawMthd + in (mthd:xs, consts st) + where + goOne = do + traceM' ("========== starting method: " ++ toStr (labelFor qi (LabIdent ""))) + traceM' (show locals) + forM_ locals (uncurry newVar) + forM_ (map fst locals) reserveLocal + addParams ps + let nodes = Map.elems g + entryNode = single $ filter ((== entryLabel) . nodeLabel) nodes + exitNode = single $ filter ((== exitLabel) . nodeLabel) nodes + otherNodes = filter ((\l -> l /= entryLabel && l /= exitLabel) . nodeLabel) nodes + genNode entryNode + mapM_ genNode otherNodes + genNode exitNode + genNode node = do + traceM' ("===== starting block: " ++ toStr (nodeLabel node)) + mapM_ genInstr (nodeCode node) + locals = Map.toList $ persistedLocals cfg + reserveLocal vi = do + s <- gets stack + varS <- getVarS vi + let (loc, s') = stackInsertReserved vi s + varS' = varS {varLocs = [loc]} + setVarS varS' + setStack s' + +-- Set the descriptions for method parameters. +addParams :: [Param a] -> GenM () +addParams ps = mapM_ (uncurry addParam) (zip ps [0..]) + where + addParam (Param _ t vi) idx = do + let loc = argLoc idx + _ <- newVar vi (() <$ t) + case loc of + LocReg reg_ -> saveInReg vi reg_ + LocStack {} -> do + varS <- getVarS vi + setVarS varS {varLocs = [loc]} + _ -> error $ "addParams: invalid location from argLoc " ++ show loc + +{- +czemu tak trudno +assembler generować +termin nadchodzi +-} +genInstr :: Instr Liveness -> GenM () +genInstr instr = + let instrLiveness = single instr + in local (\env -> env {liveness = instrLiveness}) (do + modify (\st -> st {live = liveIn instrLiveness}) + traceM' (show instr) + fullTrace + case instr of + ILabel _ l -> do + l' <- label l + Emit.label l' "" + ILabelAnn _ l f t -> do + l' <- label l + Emit.label l' $ "lines " ++ show f ++ "-" ++ show t + IVRet _ -> do + resetStack + endBlock + IRet _ val -> do + moveToReg val rax + resetStack + endBlock + IOp _ vi v1 op v2 -> case op of + OpAdd _ | isInt (valType v1) -> emitSimpleBin Emit.add vi v1 v2 + OpAdd _ | isStr (valType v1) -> do + genCall "lat_cat_strings" [v1, v2] + newVar vi (Ref () (Str ())) + saveInReg vi rax + useVal v1 + useVal v2 + OpAdd _ -> error "internal error. invalid operand types for add." + OpSub _ -> emitSimpleBin Emit.sub vi v1 v2 + OpMul _ -> do + loc1 <- getValLoc v1 + loc2 <- getValLoc v2 + case (loc1, loc2) of + (LocImm n, _) | isPowerOfTwo n -> + useVal v1 >> emitBitShift (\r -> + Emit.sal (log2 n) r ("multiply by " ++ show n)) vi v2 + (_, LocImm n) | isPowerOfTwo n -> + useVal v2 >> emitBitShift (\r -> + Emit.sal (log2 n) r ("multiply by " ++ show n)) vi v1 + _ -> emitSimpleBin Emit.imul vi v1 v2 + OpDiv _ -> do + locRhs <- getValLoc v2 + case locRhs of + LocImm n | isPowerOfTwo n -> + useVal v2 >> emitBitShift (\r -> + Emit.sar (log2 n) r ("divide by " ++ show n)) vi v1 + _ -> emitDivBin rax vi v1 v2 + OpMod _ -> do + locRhs <- getValLoc v2 + case locRhs of + LocImm n | isPowerOfTwo n -> do + -- n % 2^k + -- is the same as + -- n AND (2^k - 1) + useVal v2 + reg_ <- moveToAnyReg v1 + useVal v1 + freeReg reg_ + Emit.and Double (LocImm (n - 1)) (LocReg reg_) ("modulo by " ++ show n) + newVar vi (Int ()) + saveInReg vi reg_ + _ -> emitDivBin rdx vi v1 v2 + OpLTH _ -> emitCmpBin Emit.setl vi v1 v2 + OpLE _ -> emitCmpBin Emit.setle vi v1 v2 + OpGTH _ -> emitCmpBin Emit.setg vi v1 v2 + OpGE _ -> emitCmpBin Emit.setge vi v1 v2 + OpEQU _ -> emitCmpBin Emit.sete vi v1 v2 + OpNE _ -> emitCmpBin Emit.setne vi v1 v2 + ISet _ vi v -> do + let t = () <$ valType v + case v of + VVal _ _ othVi -> do + othVarS <- getVarS othVi + let othVarS' = othVarS {varAliases = vi:varAliases othVarS} + rs = map asReg $ filter isReg (varLocs othVarS') + regSs <- mapM getRegS rs + let regSs' = map (\r -> r {regVals = vi:regVals r}) regSs + mapM_ setRegS regSs' + setVarS othVarS' + newVar vi t + varS <- getVarS vi + setVarS varS {varLocs = varLocs othVarS', varAliases = varAliases othVarS'} + _ -> do + newVar vi t + varS <- getVarS vi + setVarS $ case v of + VInt _ n -> varS {varLocs = [LocImm (fromInteger n)]} + VNegInt _ n -> varS {varLocs = [LocImm (fromInteger $ -n)]} + VTrue _ -> varS {varLocs = [LocImm 1]} + VFalse _ -> varS {varLocs = [LocImm 0]} + VNull _ -> varS {varLocs = [LocImm 0]} + VVal {} -> error "impossible" + useVal v + IStr _ vi str -> do + let len = toInteger $ length str + t = Ref () (Str ()) + strConst <- newStrConst str + reg_ <- moveConstToAnyReg strConst + newVar vi t + saveInReg vi reg_ + genCall "lat_new_string" [VVal () t vi, VInt () len] + newVar vi t + saveInReg vi rax + IUnOp _ vi op v -> case op of + UnOpNeg _ -> do + let t = () <$ valType v + case v of + VVal {} -> do + reg_ <- moveToAnyReg v + useVal v + freeReg reg_ + Emit.neg reg_ + newVar vi t + saveInReg vi reg_ + _ -> do + newVar vi t + varS <- getVarS vi + setVarS $ case v of + VInt _ n -> varS {varLocs = [LocImm (fromInteger (-n))]} + VNegInt _ n -> varS {varLocs = [LocImm (fromInteger n)]} + _ -> error "internal error. invalid operand to UnOpNeg." + UnOpNot _ -> do + let t = () <$ valType v + case v of + VVal {} -> do + reg_ <- moveToAnyReg v + useVal v + freeReg reg_ + Emit.xor Byte (LocImm 1) (LocReg reg_) + newVar vi t + saveInReg vi reg_ + _ -> do + newVar vi t + varS <- getVarS vi + setVarS $ case v of + VTrue _ -> varS {varLocs = [LocImm 0]} + VFalse _ -> varS {varLocs = [LocImm 1]} + _ -> error "internal error. invalid operand to UnOpNot" + IVCall _ call -> case call of + Call _ _ qi args -> genCall (getCallTarget qi) args + CallVirt {} -> error "callvirt unimplemented" + ICall _ vi call -> do + t <- case call of + Call _ t' qi args -> genCall (getCallTarget qi) args >> return t' + CallVirt {} -> error "callvirt unimplemented" + newVar vi (() <$ t) + saveInReg vi rax + ICondJmp _ v l1 l2 -> do + loc <- getValLoc v + l1' <- label l1 + l2' <- label l2 + resetStack + case loc of + LocImm 0 -> do + saveBetweenBlocks + endBlock + Emit.jmp l2' + LocImm 1 -> do + saveBetweenBlocks + endBlock + Emit.jmp l1' + _ -> do + Emit.test loc loc + saveBetweenBlocks + endBlock + Emit.jz l2' + Emit.jmp l1' + IJmp _ li -> do + li' <- label li + resetStack + saveBetweenBlocks + endBlock + Emit.jmp li' + IPhi {} -> error "internal error. phi should be eliminated before assembly codegen" + _ -> error $ "unimplemented " ++ show instr + fullTrace + return () + ) + +genCall :: String -> [Val a] -> GenM () +genCall target args = do + let argsWithLocs = zip args (map argLoc [0..]) + (argsWithLocReg, argsWithLocStack) = partition (isReg . snd) argsWithLocs + argsInRegs = map (second asReg) argsWithLocReg + argsOnStack = map fst argsWithLocStack + callerSavedRegs <- gets (filter (\r -> regType r == CallerSaved) . Map.keys . regs) + forM_ argsInRegs (uncurry passInReg) + forM_ callerSavedRegs reserveReg + forM_ callerSavedRegs freeReg + forM_ callerSavedRegs unreserveReg + stackBefore <- gets (stackOverheadSize . stack) + locs <- mapM prepOnStack (reverse argsOnStack) + alignStack + stackAfter <- gets (stackOverheadSize . stack) + forM_ locs (`Emit.push` "passing arg") + Emit.call target + Emit.decrStack (stackAfter - stackBefore) + modify (\st -> st{stack = (stack st){stackOverheadSize = stackBefore}}) + where passInReg val reg_ = moveToReg val reg_ >> useVal val + prepOnStack val = do + s <- gets stack + loc <- getValLoc val + let s' = stackPushUnnamed Quadruple s + setStack s' + useVal val + return loc + alignStack = do + (misalignment, s) <- gets (stackAlign16 . stack) + Emit.incrStack misalignment "16 bytes alignment" + setStack s + +emitSimpleBin :: (Loc -> Loc -> GenM ()) -> ValIdent -> Val a -> Val a -> GenM () +emitSimpleBin emitter vi v1 v2 = do + reg_ <- moveToAnyReg v1 + loc2 <- getValLoc v2 + useVal v1 + useVal v2 + freeReg reg_ + emitter loc2 (LocReg reg_) + newVar vi (Int ()) + saveInReg vi reg_ + +emitBitShift :: (Reg -> GenM ()) -> ValIdent -> Val a -> GenM () +emitBitShift emitter vi val = do + reg_ <- moveToAnyReg val + useVal val + freeReg reg_ + emitter reg_ + newVar vi (Int ()) + saveInReg vi reg_ + +emitCmpBin :: (Reg -> GenM ()) -> ValIdent -> Val a -> Val a -> GenM () +emitCmpBin emitter vi v1 v2 = do + reg_ <- moveToAnyReg v1 + loc2 <- getValLoc v2 + useVal v1 + useVal v2 + freeReg reg_ + Emit.cmp (valSize v1) loc2 (LocReg reg_) + emitter reg_ + newVar vi (Bool ()) + saveInReg vi reg_ + +emitDivBin :: Reg -> ValIdent -> Val a -> Val a -> GenM () +emitDivBin resultReg_ vi v1 v2 = do + moveToReg v1 rax + reserveReg rax + reserveReg rdx + useVal v1 + freeReg rax + freeReg rdx + unreserveReg rax + unreserveReg rdx + loc2 <- materialise v2 + useVal v2 + Emit.cdq + Emit.idiv Double loc2 + newVar vi (Int ()) + saveInReg vi resultReg_ + +resetStack :: GenM () +resetStack = do + s <- gets stack + let (n, s') = stackClearOverhead s + Emit.decrStack n + setStack s' + +endBlock :: GenM () +endBlock = do + locals <- gets (stackReservedSlots . stack) + varSs <- gets vars + let varSs' = Map.mapWithKey (\vi slot -> VarS { + varName = vi, + varType = varType $ varSs Map.! vi, + varLocs = [slotToLoc slot], + varAliases = [vi]}) locals + modify (\st -> st {allCode = bbCode st ++ allCode st, + bbCode = [], + regs = initialRegs, + vars = varSs'}) diff --git a/src/X86_64/CodeGen/Module.hs b/src/X86_64/CodeGen/Module.hs new file mode 100644 index 0000000..d871541 --- /dev/null +++ b/src/X86_64/CodeGen/Module.hs @@ -0,0 +1,20 @@ +module X86_64.CodeGen.Module where + +import Espresso.Syntax.Abs +import Identifiers +import X86_64.CodeGen.Consts +import qualified X86_64.CodeGen.Emit as Emit +import X86_64.CodeGen.GenM + +generateModule :: [CompiledMethod] -> ConstSet -> String +generateModule mthds allConsts = + let code = concatMap (\m -> emitMthd m ++ "\n") mthds + header = map Emit.extern runtimeSymbols ++ + [Emit.globalMain | mainEntry `elem` map mthdEntry mthds] ++ + map Emit.constDef (constsElems allConsts) + in unlines (map Emit.emitAsString header) ++ "\n\n" ++ code + where mainEntry = toStr $ + labelFor (QIdent () (SymIdent $ toStr topLevelClassIdent) (SymIdent $ toStr mainSymIdent)) entryLabel + emitMthd mthd = + let code = unlines $ mthdPrologue mthd ++ mthdCode mthd ++ mthdEpilogue mthd + in if mthdEntry mthd == mainEntry then "main:\n" ++ code else code diff --git a/src/X86_64/CodeGen/Prologue.hs b/src/X86_64/CodeGen/Prologue.hs new file mode 100644 index 0000000..2dfd01e --- /dev/null +++ b/src/X86_64/CodeGen/Prologue.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE QuasiQuotes #-} +module X86_64.CodeGen.Prologue (withPrologue) where + +import Data.List +import qualified Data.Set as Set +import Espresso.Syntax.Abs +import Identifiers (labelFor) +import Text.RE.Replace +import Text.RE.TDFA.String +import qualified X86_64.CodeGen.Emit as Emit +import X86_64.CodeGen.GenM +import X86_64.CodeGen.Stack +import X86_64.Loc +import X86_64.Registers +import X86_64.Size + +withPrologue :: QIdent a -> Store -> CompiledMethod -> CompiledMethod +withPrologue qi st mthd = + let locs = stackReservedSize $ stack st + savedRegs = sort $ filter (\r -> regType r == CalleeSaved) $ Set.elems $ usedRegs st + needsAlignment = odd $ length savedRegs + prologue = + [Emit.label (labelFor qi (LabIdent "")) ""] ++ + map (\r -> Emit.push (LocReg r) "") savedRegs ++ + [Emit.incrStack 8 "16 bytes alignment" | needsAlignment] ++ + [ + Emit.push (LocReg rbp) "", + Emit.movToReg Quadruple (LocReg rsp) rbp "", + Emit.incrStack locs "space for locals" + ] + -- Access to parameters passed on stack has to be offset by 8 for each saved + -- register, including rbp. Additionally correct for alignment. + paramOffset = 8 * (length savedRegs + 1 + if needsAlignment then 1 else 0) + newCode = offsetStackParamReferences paramOffset (mthdCode mthd) + in mthd {mthdPrologue = map Emit.emitAsString prologue, mthdCode = newCode} + +offsetStackParamReferences :: Int -> [String] -> [String] +offsetStackParamReferences offset = map go + where go line = + let pattern_ = [re|([[:space:]])([0-9]+)\(%rbp\)|] + ms = line *=~ pattern_ + repl _ loc capt = + if getCaptureOrdinal (locationCapture loc) == 2 + then let base = read $ capturedText capt + in Just $ show (base + offset) + else Nothing + in replaceAllCaptures SUB repl ms diff --git a/src/X86_64/CodeGen/RegisterAllocation.hs b/src/X86_64/CodeGen/RegisterAllocation.hs new file mode 100644 index 0000000..401a13c --- /dev/null +++ b/src/X86_64/CodeGen/RegisterAllocation.hs @@ -0,0 +1,209 @@ +module X86_64.CodeGen.RegisterAllocation where + +import Control.Monad.Reader +import Control.Monad.State +import Data.List (minimumBy) +import qualified Data.Map as Map +import Data.Ord (comparing) +import qualified Data.Set as Set +import Espresso.ControlFlow.CFG +import Espresso.ControlFlow.Liveness +import Espresso.Syntax.Abs +import Identifiers +import Utilities +import X86_64.CodeGen.Consts +import qualified X86_64.CodeGen.Emit as Emit +import X86_64.CodeGen.GenM +import X86_64.CodeGen.Stack +import X86_64.Loc +import X86_64.Registers +import X86_64.Size + +-- Get all locals that need to be persisted between basic blocks based on +-- CFG liveness data. +persistedLocals :: CFG Liveness -> Map.Map ValIdent (SType ()) +persistedLocals (CFG g) = + let sizes = foldr seekSize Map.empty (concatMap nodeCode (Map.elems g)) + result = Map.restrictKeys sizes vis + in if Map.keysSet result /= vis + then error "internal error. missing sizes in persisted locals" + else Map.map (() <$) result + where + vis = Map.foldr (Set.union . nodePersisted) Set.empty g + nodePersisted node = Set.map ValIdent $ Map.keysSet $ liveOut (nodeTail node) + seekSize instr m = case instr of + IRet _ val -> addVal val m + IOp _ _ val1 _ val2 -> addVal val2 (addVal val1 m) + ISet _ _ val -> addVal val m + IUnOp _ _ _ val -> addVal val m + IVCall _ call -> addCall call m + ICall _ _ call -> addCall call m + ICondJmp _ val _ _ -> addVal val m + ILoad _ _ val -> addVal val m + IStore _ val1 val2 -> addVal val2 (addVal val1 m) + IFld _ _ val _ -> addVal val m + IArr _ _ val1 val2 -> addVal val2 (addVal val1 m) + _ -> m + addVal val m = case val of + VVal _ t vi -> Map.insert vi t m + _ -> m + addCall (Call _ _ _ vs) m = foldr addVal m vs + addCall (CallVirt _ _ _ vs) m = foldr addVal m vs + +-- Ensure the value is available in a register or in memory. +materialise :: Val a -> GenM Loc +materialise val = do + loc <- getValLoc val + case loc of + LocStack {} -> return loc + LocReg {} -> return loc + LocImm {} -> LocReg <$> moveToAnyReg val + +-- Free the register while preserving alive values that had their only +-- location set as this register. May cause spilling if no other registers +-- are availbale. +freeReg :: Reg -> GenM () +freeReg reg_ = do + regS <- getRegS reg_ + reserveReg reg_ + forM_ (regVals regS) go + setRegS (regS {regVals = []}) -- sets reserve state back + where + go vi = do + secureValue vi + varS <- getVarS vi + let varS' = varS {varLocs = filter (\r -> r /= LocReg reg_) (varLocs varS)} + setVarS varS' + +-- Mark the register as reserved. +-- Reserved registers cannot be inserted into. +reserveReg :: Reg -> GenM () +reserveReg reg_ = do + regS <- getRegS reg_ + let regS' = regS {regReserved = True} + setRegS regS' + +-- Mark the register as not reserved. +unreserveReg :: Reg -> GenM () +unreserveReg reg_ = do + regS <- getRegS reg_ + let regS' = regS {regReserved = False} + setRegS regS' + +-- Ensure that the variable has a persisted location that is not a reserved +-- register if it is alive. +-- - If the value is on the stack, do nothing. +-- - If the value is only in reserved registers, move it to any unreserved register. +secureValue :: ValIdent -> GenM () +secureValue vi = do + alive <- isLive vi + varS <- getVarS vi + when (alive && all isNonStack (varLocs varS)) (do + regSs <- mapM (getRegS . asReg) (filter isReg (varLocs varS)) + when (all regReserved regSs) (void $ moveToAnyReg (VVal () (varType varS) vi))) + +-- Put the given variable into the register, replacing any values that were in it before. +saveInReg :: ValIdent -> Reg -> GenM () +saveInReg vi reg_ = do + regS <- useReg reg_ + freeReg reg_ + varS <- getVarS vi + when (regReserved regS) (error $ "internal error. attempt to use a reserved register " ++ show reg_) + let varS' = varS {varLocs = LocReg reg_ : varLocs varS} + regS' = regS {regVals = varAliases varS} + setVarS varS' + setRegS regS' + +-- Write all alive, yet unwritten locals persisted between blocks. +saveBetweenBlocks :: GenM () +saveBetweenBlocks = do + locals <- gets (map fst . stackReservedLocs . stack) + liveLocals <- filterM isLive locals + forM_ liveLocals (\vi -> unlessM (gets (stackContains vi . stack)) (saveOnStack vi)) + +-- Save the variable on the stack if it is not already there. +saveOnStack :: ValIdent -> GenM () +saveOnStack vi = do + varS <- getVarS vi + s <- gets stack + let mbsrcLoc = nonStackLoc varS + (varS', s') <- case mbsrcLoc of + Nothing + | stackIsValueReserved vi s && not (stackContains vi s) -> do + -- Value is already on stack, but not in its reserved local slot. + let (loc@(LocStack n), s') = stackInsertReserved vi s + reg_ <- moveToAnyReg (VVal () (varType varS) vi) + Emit.movToStack (varSize varS) (LocReg reg_) n ("save " ++ toStr vi) + return (varS {varLocs = loc : varLocs varS}, s') + Nothing -> return (varS, s) -- Value is already on stack. + Just srcLoc | stackIsValueReserved vi s -> do + let (loc@(LocStack n), s') = stackInsertReserved vi s + Emit.movToStack (varSize varS) srcLoc n ("save " ++ toStr vi ) + return (varS {varLocs = loc : varLocs varS}, s') + Just srcLoc -> do + let (loc, s') = stackPush vi Quadruple s + Emit.push srcLoc ("spill " ++ toStr vi) + return (varS {varLocs = loc : varLocs varS}, s') + setVarS varS' + setStack s' + +-- Select the best unreserved register to put a value into. +chooseReg :: GenM Reg +chooseReg = do + regSs <- gets (filter (not . regReserved) . Map.elems . regs) + ranks <- mapM rankReg regSs + traceM' ("Length of regSs: " ++ show (length regSs)) + return $ reg $ fst $ minimumBy (comparing snd) (zip regSs ranks) + +-- Get the rank of the register based on its state. +rankReg :: RegState -> GenM RegRank +rankReg regS = + if null $ regVals regS + then return $ Free (regType $ reg regS) + else do + l <- gets live + let nextUse = minimum $ map (getValUse l) (regVals regS) + varSs <- mapM getVarS (regVals regS) + return $ if all (any isStack . varLocs) varSs + then Clean nextUse + else Dirty nextUse + where + getValUse l vi = + case Map.lookup (toStr vi) l of + Just use -> use + Nothing -> + error $ "internal error. dead variable " ++ toStr vi ++ " in reg " ++ show (reg regS) + +-- Move the value to the register removing any values currently in it. +moveToReg :: Val a -> Reg -> GenM () +moveToReg val reg_ = do + freeReg reg_ + loc <- getValLoc val + let size = valSize val + comment <- case val of + VVal _ _ vi -> saveInReg vi reg_ >> + traceM' ("moving " ++ toStr vi ++ " to " ++ show reg_) >> return ("moving " ++ toStr vi) + _ -> return "" + Emit.movToReg size loc reg_ comment + +-- Move the address of a string constant to an unreserved register. +moveConstToAnyReg :: Const -> GenM Reg +moveConstToAnyReg c = do + reg_ <- chooseReg + freeReg reg_ + Emit.leaOfConst c reg_ + return reg_ + +-- Move the value to any unreserved register if it is not already +-- in one. If it is, return that register. +moveToAnyReg :: Val a -> GenM Reg +moveToAnyReg val = do + mbreg <- getValUnreservedReg val + case mbreg of + Just reg_ -> return reg_ + Nothing -> do + reg_ <- chooseReg + regS <- getRegS reg_ + forM_ (regVals regS) saveOnStack + moveToReg val reg_ + return reg_ diff --git a/src/X86_64/CodeGen/Stack.hs b/src/X86_64/CodeGen/Stack.hs new file mode 100644 index 0000000..b23ee47 --- /dev/null +++ b/src/X86_64/CodeGen/Stack.hs @@ -0,0 +1,99 @@ +-- Stack state during assembly generation. +module X86_64.CodeGen.Stack where + +import Data.Int +import Data.List +import qualified Data.Map as Map +import Espresso.Syntax.Abs +import Identifiers +import X86_64.Loc +import X86_64.Size + +-- The stack contains a number of reserved slots for locals which +-- are preserved between basic blocks, and an overhead of spilled +-- variables and empty areas for alignment purposes. +data Stack = Stack { + stackReservedSize :: Int64, + stackReservedSlots :: Map.Map ValIdent Slot, + stackOverheadSize :: Int64, + stackOccupiedSlots :: Map.Map ValIdent Slot} + +data Slot = Slot { + -- Offset on the stack. The stack grows downwards, + -- so the offset is usually negative. + slotOffset :: Int64, + -- Size of the value in this slot. + slotSize :: Size +} deriving Show + +stackEmpty :: Stack +stackEmpty = Stack 0 Map.empty 0 Map.empty + +-- Allocate slots for the given variables to be preserved +-- between basic blocks. +stackReserve :: [(ValIdent, Size)] -> Stack -> Stack +stackReserve vals sInit = foldl' reserveOne sInit vals + where reserveOne s (vi, size) = + let sizeBefore = stackReservedSize s + bytes = sizeInBytes size + slot = Slot (-sizeBefore - bytes) size + in s {stackReservedSize = sizeBefore + bytes, + stackReservedSlots = Map.insert vi slot (stackReservedSlots s), + stackOccupiedSlots = Map.insert vi slot (stackOccupiedSlots s)} + +-- Get all variables that have reserved locations along with these locations. +stackReservedLocs :: Stack -> [(ValIdent, Loc)] +stackReservedLocs s = Map.toList $ Map.map slotToLoc (stackReservedSlots s) + +-- Remove all values that do not have reserved locations. +stackClearOverhead :: Stack -> (Int64, Stack) +stackClearOverhead s = + let overhead = stackOverheadSize s + reservedValues = Map.keysSet (stackReservedSlots s) + s' = s {stackOverheadSize = 0, + stackOccupiedSlots = Map.restrictKeys (stackOccupiedSlots s) reservedValues} + in (overhead, s') + +-- Push the variable onto the stack, ignoring whether it has or does not have +-- a reserved slot. +stackPush :: ValIdent -> Size -> Stack -> (Loc, Stack) +stackPush vi size s = + let sizeBefore = stackOverheadSize s + bytes = sizeInBytes size + slot = Slot (-sizeBefore - stackReservedSize s - bytes) size + s' = s {stackOverheadSize = sizeBefore + bytes, + stackOccupiedSlots = Map.insert vi slot (stackOccupiedSlots s)} + in (slotToLoc slot, s') + +-- Increase the stack overhead with some unidentified value. +stackPushUnnamed :: Size -> Stack -> Stack +stackPushUnnamed size s = s {stackOverheadSize = stackOverheadSize s + sizeInBytes size} + +-- Remove the given variable from the stack. +stackDelete :: ValIdent -> Stack -> Stack +stackDelete vi s = s {stackOccupiedSlots = Map.delete vi (stackOccupiedSlots s)} + +-- Whether the given variable has a reserved slot. +stackIsValueReserved :: ValIdent -> Stack -> Bool +stackIsValueReserved vi = Map.member vi . stackReservedSlots + +-- Insert a given variable into its reserved slot. Fails if the variable +-- has no reserved slot. +stackInsertReserved :: ValIdent -> Stack -> (Loc, Stack) +stackInsertReserved vi s = case Map.lookup vi (stackReservedSlots s) of + Just slot -> (slotToLoc slot, s {stackOccupiedSlots = Map.insert vi slot (stackOccupiedSlots s)}) + Nothing -> error $ "stackInsertReserved: value with not reserved slot " ++ toStr vi + +-- Whether the given variable is saved on the stack. +stackContains :: ValIdent -> Stack -> Bool +stackContains vi s = Map.member vi (stackOccupiedSlots s) + +-- Align the stack to take a multiple of 16 bytes. Returns the applied additional offset +-- and the aligned stack. +stackAlign16 :: Stack -> (Int64, Stack) +stackAlign16 s = let misalignment = 16 - (stackReservedSize s + stackOverheadSize s) `mod` 16 + x = if misalignment == 16 then 0 else misalignment + in (x, s {stackOverheadSize = stackOverheadSize s + x}) + +slotToLoc :: Slot -> Loc +slotToLoc slot = LocStack (slotOffset slot) diff --git a/src/X86_64/Loc.hs b/src/X86_64/Loc.hs new file mode 100644 index 0000000..3e85d92 --- /dev/null +++ b/src/X86_64/Loc.hs @@ -0,0 +1,53 @@ +-- Data type for representing variable locations during execution +-- such as register or memory. +module X86_64.Loc where + +import Data.Int +import X86_64.Registers + +data Loc = LocImm Int32 | LocReg Reg | LocStack Int64 deriving (Eq, Show) + +-- This is the same as deriving(Ord), but we rely on this ordering so it is stated explicitly. +-- When extracting a value from a location we want the cheapest possibilities first, +-- so it's immediate values, registers and then memory. +instance Ord Loc where + compare l1 l2 = case (l1, l2) of + (LocReg r1, LocReg r2) -> compare r1 r2 + (LocStack n1, LocStack n2) -> compare n1 n2 + (LocImm n1, LocImm n2) -> compare n1 n2 + (LocImm _, _) -> LT + (_, LocImm _) -> GT + (LocReg _, _) -> LT + (_, LocReg _) -> GT + +isNonStack :: Loc -> Bool +isNonStack = not . isStack + +isStack :: Loc -> Bool +isStack loc = case loc of + LocStack _ -> True + _ -> False + +isReg :: Loc -> Bool +isReg loc = case loc of + LocReg _ -> True + _ -> False + +asReg :: Loc -> Reg +asReg loc = case loc of + LocReg r -> r + _ -> error "asReg: not a reg" + +-- For n-th argument of a function (starting from zero) give +-- the location it is stored in. Assumes only the return +-- address is stored after arguments on stack, the consumer +-- must correct for the actual offset. +argLoc :: Integer -> Loc +argLoc idx = case idx of + 0 -> LocReg rdi + 1 -> LocReg rsi + 2 -> LocReg rdx + 3 -> LocReg rcx + 4 -> LocReg r8 + 5 -> LocReg r9 + _ -> LocStack ((fromInteger idx - 6) * 8 + 8) diff --git a/src/X86_64/Optimisation/Peephole.hs b/src/X86_64/Optimisation/Peephole.hs new file mode 100644 index 0000000..beb1ad7 --- /dev/null +++ b/src/X86_64/Optimisation/Peephole.hs @@ -0,0 +1,254 @@ +-- Optimisations based on matching the generated code to patterns of common +-- unoptimal code and transforming it to better versions. +{-# LANGUAGE QuasiQuotes #-} +module X86_64.Optimisation.Peephole (optimise) where + +import Data.Maybe +import Text.RE.Replace +import Text.RE.TDFA.String +import Utilities + +-- Applying one optimisation can make another one possible, +-- so we take the fixpoint of applying them continuously. +optimise :: [String] -> [String] +optimise = fixpoint runPeephole + +runPeephole :: [String] -> [String] +runPeephole = runSize1 . runSize2 . runSize3 + +runSize1 :: [String] -> [String] +runSize1 = mapWithWindow1 size1Opts + +runSize2 :: [String] -> [String] +runSize2 = mapWithWindow2 size2Opts + +runSize3 :: [String] -> [String] +runSize3 = mapWithWindow3 size3Opts + +size1Opts :: String -> Maybe [String] +size1Opts = foldr optComp optId [ + optSubZero, + optAddZero, + optCmpZero, + optCmpZero2, + optInc, + optDec, + optZero + ] + +size2Opts :: (String, String) -> Maybe [String] +size2Opts = foldr optComp optId [optJmpToNext] + +size3Opts :: (String, String, String) -> Maybe [String] +size3Opts = foldr optComp optId [optXchg, optCondJmp] + +optId :: a -> Maybe b +optId = const Nothing + +optComp :: (a -> Maybe b) -> (a -> Maybe b) -> a -> Maybe b +optComp f g x = case g x of + Just y -> Just y + Nothing -> f x + +mapWithWindow1 :: (a -> Maybe [a]) -> [a] -> [a] +mapWithWindow1 f = concatMap (\l -> fromMaybe [l] (f l)) + +mapWithWindow2 :: ((a, a) -> Maybe [a]) -> [a] -> [a] +mapWithWindow2 _ [] = [] +mapWithWindow2 _ [x] = [x] +mapWithWindow2 f (x1:x2:xs) = + case f (x1, x2) of + Nothing -> x1:mapWithWindow2 f (x2:xs) + Just ys -> ys ++ mapWithWindow2 f xs + +mapWithWindow3 :: ((a, a, a) -> Maybe [a]) -> [a] -> [a] +mapWithWindow3 _ [] = [] +mapWithWindow3 _ [x] = [x] +mapWithWindow3 _ [x1, x2] = [x1, x2] +mapWithWindow3 f (x1:x2:x3:xs) = + case f (x1, x2, x3) of + Nothing -> x1:mapWithWindow3 f (x2:x3:xs) + Just ys -> ys ++ mapWithWindow3 f xs + +-- From: +-- movx $0, %a +-- To: +-- xorx %a, %a +optZero :: String -> Maybe [String] +optZero line = + let pattern_ = [re|mov([a-z]) \$0, (%[^[:space:]]+)|] + -- capt1 capt2 + m = line ?=~ pattern_ + in if matched m + then let (size, target) = extrMatch2 m + in Just [" xor" ++ size ++ " " ++ target ++ ", " ++ target ++ matchSuf m] + else Nothing + +-- From: +-- addx $1, a +-- To: +-- incx a +optInc :: String -> Maybe [String] +optInc line = + let pattern_ = [re|add([a-z]) \$1, ([^[:space:]]+)|] + -- capt1 capt2 + m = line ?=~ pattern_ + in if matched m + then let (size, target) = extrMatch2 m + in Just [" inc" ++ size ++ " " ++ target ++ matchSuf m] + else Nothing + +-- From: +-- subx $1, a +-- To: +-- decx a +optDec :: String -> Maybe [String] +optDec line = + let pattern_ = [re|sub([a-z]) \$1, ([^[:space:]]+)|] + -- capt1 capt2 + m = line ?=~ pattern_ + in if matched m + then let (size, target) = extrMatch2 m + in Just [" dec" ++ size ++ " " ++ target ++ matchSuf m] + else Nothing + +-- From: +-- addx $0, a +-- To: +-- _ +optAddZero :: String -> Maybe [String] +optAddZero line = + let pattern_ = [re|add[a-z] \$0,|] + in if matched $ line ?=~ pattern_ + then Just [] + else Nothing + +-- From: +-- subx $0, a +-- To: +-- _ +optSubZero :: String -> Maybe [String] +optSubZero line = + let pattern_ = [re|sub[a-z] \$0,|] + in if matched $ line ?=~ pattern_ + then Just [] + else Nothing + +-- From: +-- cmpx $0, a +-- To: +-- testx a +optCmpZero :: String -> Maybe [String] +optCmpZero line = + let pattern_ = [re|cmp([a-z]) \$0, ([^[:space:]]+)|] + -- capt1 capt2 + m = line ?=~ pattern_ + in if matched m + then let (size, target) = extrMatch2 m + in Just [" test" ++ size ++ " " ++ target ++ ", " ++ target ++ matchSuf m] + else Nothing + +-- From: +-- cmpx $0, a +-- To: +-- testx a +optCmpZero2 :: String -> Maybe [String] +optCmpZero2 line = + let pattern_ = [re|cmp([a-z]) ([^[:space:]]+), \$0|] + -- capt1 capt2 + m = line ?=~ pattern_ + in if matched m + then let (size, target) = extrMatch2 m + in Just [" test" ++ size ++ " " ++ target ++ ", " ++ target ++ " " ++ matchSuf m] + else Nothing + +-- From: +-- jmp .L_label +-- .L_label: +-- To: +-- _ +optJmpToNext :: (String, String) -> Maybe [String] +optJmpToNext (line1, line2) = + let pattern1 = [re|jmp ([^[:space:]]+)|] + -- capt1 + pattern2 = [re|([^[:space:]]+):|] + -- capt1 + m1 = line1 ?=~ pattern1 + m2 = line2 ?=~ pattern2 + in if matched m1 && matched m2 + then let label1 = extrMatch m1 + label2 = extrMatch m2 + in if label1 == label2 then Just [label1 ++ ":" ++ matchSuf m1 ++ matchSuf m2] else Nothing + else Nothing + +-- From: +-- setx a +-- testb a, a +-- jz .L_label +-- To: +-- j(!x) .L_label +optCondJmp :: (String, String, String) -> Maybe [String] +optCondJmp (line1, line2, line3) = + let pattern1 = [re|set([a-z]) ([^[:space:]]+)|] + -- capt1 capt2 + pattern2 = [re|testb ([^[:space:]]+), ([^[:space:]]+)|] + -- capt1 capt2 + pattern3 = [re|jz ([^[:space:]]+)|] + -- capt1 + m1 = line1 ?=~ pattern1 + m2 = line2 ?=~ pattern2 + m3 = line3 ?=~ pattern3 + in + if matched m1 && matched m2 && matched m3 + then let (cmp, target1) = extrMatch2 m1 + (target2_1, target2_2) = extrMatch2 m2 + label = extrMatch m3 + in if target1 == target2_1 && target2_1 == target2_2 + then Just [" j" ++ negated cmp ++ " " ++ label ++ concatMap matchSuf [m1, m2, m3]] + else Nothing + else Nothing + where negated x = case x of + "g" -> "le" + "ge" -> "l" + "l" -> "ge" + "le" -> "l" + "e" -> "ne" + "ne" -> "e" + _ -> error $ "optCondJmp: invalid condition " ++ x + +-- From: +-- movx a, c +-- movx b, a +-- movx c, b +-- To: +-- xchgx a, b +optXchg :: (String, String, String) -> Maybe [String] +optXchg (line1, line2, line3) = + let pattern_ = [re|mov([a-z]) ([^[:space:]]+), ([^[:space:]]+)|] + -- capt1 capt2 capt3 + in case (line1 ?=~ pattern_, line2 ?=~ pattern_, line3 ?=~ pattern_) of + (m1, m2, m3) | matched m1 && + matched m2 && + matched m3 -> + let (s1, l1, r1) = extrMatch3 m1 + (s2, l2, r2) = extrMatch3 m2 + (s3, l3, r3) = extrMatch3 m3 + in if s1 == s2 && s2 == s3 && + l1 == r2 && l2 == r3 && r1 == l3 + then Just [" xchg" ++ s1 ++ " " ++ l1 ++ ", " ++ l2 ++ " " ++ concatMap matchSuf [m1, m2, m3]] + else Nothing + _ -> Nothing + +extrMatch :: Match a -> a +extrMatch m = capturedText $ m !$ [cp|1|] + +extrMatch2 :: Match a -> (a, a) +extrMatch2 m = (capturedText $ m !$ [cp|1|], capturedText $ m !$ [cp|2|]) + +extrMatch3 :: Match a -> (a, a, a) +extrMatch3 m = (capturedText $ m !$ [cp|1|], + capturedText $ m !$ [cp|2|], + capturedText $ m !$ [cp|3|]) + +matchSuf :: Match String -> String +matchSuf m = captureSuffix $ m !$ [cp|0|] diff --git a/src/X86_64/Registers.hs b/src/X86_64/Registers.hs new file mode 100644 index 0000000..3c8ef4b --- /dev/null +++ b/src/X86_64/Registers.hs @@ -0,0 +1,152 @@ +module X86_64.Registers where + +import qualified Data.Map as Map +import Espresso.Syntax.Abs + +data RegType = CallerSaved | CalleeSaved deriving Eq +data Reg = Reg { + -- Identifier for the 64 bits of the register. + reg64 :: String, + -- Identifier for the lower 32 bits of the register. + reg32 :: String, + -- Identifier for the lower 16 bits of the register. + reg16 :: String, + -- Identifier for the lower 8 bits of the register. + reg8 :: String, + -- Whether the register is caller or callee saved. + regType :: RegType +} + +data RegState = RegS { + reg :: Reg, + -- Whether the register is reserved for some operation and cannot be modified. + regReserved :: Bool, + -- Values currently residing in the register. + regVals :: [ValIdent] +} deriving Show + +-- Register rank for the purposes of spilling. +data RegRank = + -- Currently free + Free RegType | + -- The contained values are all saved in memory. + -- The integer value is the distance to the next use + -- of a value inside. + Clean Int | + -- The contained values are not saved in memory. + -- The integer value is the distance to the next use + -- of a value inside. + Dirty Int + deriving Eq + +instance Show Reg where + show = reg64 + +instance Eq Reg where + r1 == r2 = reg64 r1 == reg64 r2 + +instance Ord Reg where + compare r1 r2 = compare (reg64 r1) (reg64 r2) + +-- Caller saved registers are preferred over callee saved. +instance Ord RegType where + compare rt1 rt2 = case (rt1, rt2) of + (CallerSaved, CallerSaved) -> EQ + (CalleeSaved, CalleeSaved) -> EQ + (CalleeSaved, CallerSaved) -> LT + (CallerSaved, CalleeSaved) -> GT + +-- When choosing a register to put a value in prefer free +-- registers. +-- Otherwise, when choosing a register to spill: +-- - Choose a register holding a value whose use lies farthest in the future; +-- - prefer clean values to dirty values; +-- - if no clean value, chooese a dirty one. +instance Ord RegRank where + compare r1 r2 = case (r1, r2) of + (Free rt1, Free rt2) -> compare rt1 rt2 + (Clean n1, Clean n2) -> compare n2 n1 + (Dirty n1, Dirty n2) -> compare n2 n1 + (Free CalleeSaved, _) -> LT + (_, Free CalleeSaved ) -> GT + (Free CallerSaved, _) -> LT + (_, Free CallerSaved ) -> GT + (Clean c, Dirty d) -> if d < c then GT else LT + (Dirty d, Clean c) -> if d < c then LT else GT + +-- Default state at start of execution for general purpose registers. +emptyState :: Reg -> RegState +emptyState r = RegS r False [] + +-- Default state at start of execution for special registers (rsp, rbp). +reservedState :: Reg -> RegState +reservedState r = RegS r True [] + +-- All registers and their states for x86_64. +initialRegs :: Map.Map Reg RegState +initialRegs = Map.fromList [ + (rax, emptyState rax), + (rdx, emptyState rdx), + (rbx, emptyState rbx), + (rcx, emptyState rcx), + (rsi, emptyState rsi), + (rdi, emptyState rdi), + (rsp, reservedState rsp), + (rbp, reservedState rbp), + (r8, emptyState r8), + (r9, emptyState r9), + (r10, emptyState r10), + (r11, emptyState r11), + (r12, emptyState r12), + (r13, emptyState r13), + (r14, emptyState r14), + (r15, emptyState r15) + ] + +rax :: Reg +rax = Reg "rax" "eax" "ax" "al" CallerSaved + +rdx :: Reg +rdx = Reg "rdx" "edx" "dx" "dl" CallerSaved + +rbx :: Reg +rbx = Reg "rbx" "ebx" "bx" "bl" CalleeSaved + +rcx :: Reg +rcx = Reg "rcx" "ecx" "cx" "cl" CallerSaved + +rsi :: Reg +rsi = Reg "rsi" "esi" "si" "sil" CallerSaved + +rdi :: Reg +rdi = Reg "rdi" "edi" "di" "dil" CallerSaved + +rsp :: Reg +rsp = Reg "rsp" "esp" "sp" "spl" CallerSaved + +rbp :: Reg +rbp = Reg "rbp" "ebp" "bp" "bpl" CalleeSaved + +r8 :: Reg +r8 = Reg "r8" "r8d" "r8w" "r8b" CallerSaved + +r9 :: Reg +r9 = Reg "r9" "r9d" "r9w" "r9b" CallerSaved + +r10 :: Reg +r10 = Reg "r10" "r10d" "r10w" "r10b" CallerSaved + +r11 :: Reg +r11 = Reg "r11" "r11d" "r11w" "r11b" CallerSaved + +r12 :: Reg +r12 = Reg "r12" "r12d" "r12w" "r12b" CalleeSaved + +r13 :: Reg +r13 = Reg "r13" "r13d" "r13w" "r13b" CalleeSaved + +r14 :: Reg +r14 = Reg "r14" "r14d" "r14w" "r14b" CalleeSaved + +r15 :: Reg +r15 = Reg "r15" "r15d" "r15w" "r15b" CalleeSaved diff --git a/src/X86_64/Size.hs b/src/X86_64/Size.hs new file mode 100644 index 0000000..4a833f3 --- /dev/null +++ b/src/X86_64/Size.hs @@ -0,0 +1,29 @@ +-- Sizes of different types of values from Espresso. +module X86_64.Size where + +import Data.Int +import Espresso.Syntax.Abs + +data Size = Byte | Double | Quadruple deriving (Eq, Show) + +sizeInBytes :: Size -> Int64 +sizeInBytes size = case size of + Byte -> 1 + Double -> 4 + Quadruple -> 8 + +typeSize :: SType a -> Size +typeSize t = case t of + Int _ -> Double + Bool _ -> Byte + Ref _ _ -> Quadruple + _ -> error "typeSize: invalid type" + +valSize :: Val a -> Size +valSize val = case val of + VInt _ _ -> Double + VNegInt _ _ -> Double + VTrue _ -> Byte + VFalse _ -> Byte + VNull _ -> Quadruple + VVal _ t _ -> typeSize t diff --git a/test/Discovery/Compiler/CompilerSpec.hs b/test/Discovery/Compiler/CompilerSpec.hs new file mode 100644 index 0000000..0a758af --- /dev/null +++ b/test/Discovery/Compiler/CompilerSpec.hs @@ -0,0 +1,176 @@ +module Compiler.CompilerSpec (spec) where + +import Compiler +import Data.List +import Data.Maybe +import ErrM (toEither) +import Espresso.Interpreter +import Espresso.Syntax.Abs +import qualified Espresso.Syntax.Parser as ParEspresso (myLexer, pProgram) +import LatteIO +import System.Directory (listDirectory) +import System.Exit +import System.FilePath (replaceExtension, takeBaseName, + takeExtension, (<.>), ()) +import Test.Hspec + +data LatTest = LatTest { + tstName :: String, + tstContents :: String, + tstIn :: [String], + tstOut :: [String], + tstErr :: [String] +} +data LatResult = Res Int [String] deriving (Eq, Show, Ord) + +skip :: [String] +skip = [] + +spec :: Spec +spec = parallel $ do + describe "Core good" $ do + tests <- runIO $ getLatTestsFromDir coreGoodDir + mapM_ goodTest tests + describe "Core bad" $ do + tests <- runIO $ getLatTestsFromDir coreBadDir + mapM_ badTest tests + dont $ describe "Extension struct good" $ do + tests <- runIO $ getLatTestsFromDir structGoodDir + mapM_ goodTest tests + dont $ describe "Extension arrays good" $ do + tests <- runIO $ getLatTestsFromDir arraysGoodDir + mapM_ goodTest tests + dont $ describe "Extension objects1 good" $ do + tests <- runIO $ getLatTestsFromDir objects1GoodDir + mapM_ goodTest tests + describe "Extension objects1 bad" $ do + tests <- runIO $ getLatTestsFromDir objects1BadDir + mapM_ badTest tests + dont $ describe "Extension objects2 good" $ do + tests <- runIO $ getLatTestsFromDir objects2GoodDir + mapM_ goodTest tests + dont $ describe "Extension var good" $ do + tests <- runIO $ getLatTestsFromDir varGoodDir + mapM_ goodTest tests + describe "Extension var bad" $ do + tests <- runIO $ getLatTestsFromDir varBadDir + mapM_ badTest tests + +dont :: SpecWith a -> SpecWith () +dont _ = return () + +goodTest :: LatTest -> Spec +goodTest latTest = + if tstName latTest `elem` skip then runIO $ putStrLn $ "skipping " ++ tstName latTest + else describe (tstName latTest) $ do + let fs = StaticFS [StaticF (tstName latTest <.> latExt) (tstContents latTest)] + out = runStaticIO (go latTest) [] fs + esp = staticContents $ fromJust $ + find (\f -> staticPath f == espressoFile "." (tstName latTest)) (staticFiles $ staticFS out) + espOpt = staticContents $ fromJust $ + find (\f -> staticPath f == espressoOptFile "." (tstName latTest)) (staticFiles $ staticFS out) + espPhi = staticContents $ fromJust $ + find (\f -> staticPath f == espressoWithUnfoldedPhiFile "." (tstName latTest)) (staticFiles $ staticFS out) + asm = staticContents $ fromJust $ + find (\f -> staticPath f == assemblyFile "." (tstName latTest)) (staticFiles $ staticFS out) + espPar = toEither $ ParEspresso.pProgram $ ParEspresso.myLexer esp + espOptPar = toEither $ ParEspresso.pProgram $ ParEspresso.myLexer espOpt + espPhiPar = toEither $ ParEspresso.pProgram $ ParEspresso.myLexer espPhi + it (tstName latTest ++ " returns 0") $ LatteIO.staticCode out `shouldBe` ExitSuccess + case sequence [espPar, espOptPar, espPhiPar] of + Right [espProg, espOptProg, espPhiProg] -> do + let espOut = runStaticIO (interpret $ unwrapPos espProg) (tstIn latTest) (StaticFS []) + espOptOut = runStaticIO (interpret $ unwrapPos espOptProg) (tstIn latTest) (StaticFS []) + espPhiOut = runStaticIO (interpret $ unwrapPos espPhiProg) (tstIn latTest) (StaticFS []) + it (tstName latTest ++ " is OK") $ LatteIO.staticErr out `shouldBe` tstErr latTest + it (tstName latTest ++ " Espresso returns 0") $ + LatteIO.staticCode espOut `shouldBe` ExitSuccess + it (tstName latTest ++ " Espresso output is correct") $ + normaliseOut (LatteIO.staticOut espOut) `shouldBe` normaliseOut (tstOut latTest) + it (tstName latTest ++ " optimised Espresso returns 0") $ + LatteIO.staticCode espOptOut `shouldBe` ExitSuccess + it (tstName latTest ++ " optimised Espresso output is correct") $ + normaliseOut (LatteIO.staticOut espOptOut) `shouldBe` normaliseOut (tstOut latTest) + it (tstName latTest ++ " unfolded phis Espresso returns 0") $ + LatteIO.staticCode espPhiOut `shouldBe` ExitSuccess + it (tstName latTest ++ " unfolded phis Espresso output is correct") $ + normaliseOut (LatteIO.staticOut espPhiOut) `shouldBe` normaliseOut (tstOut latTest) + it (tstName latTest ++ " x86_64 output is nonempty") $ + null asm `shouldBe` False + Right _ -> Prelude.error "impossible" + Left s -> Prelude.error (tstName latTest ++ ": " ++ s) + +badTest :: LatTest -> Spec +badTest latTest = do + let fs = StaticFS [StaticF (tstName latTest <.> latExt) (tstContents latTest)] + out = runStaticIO (go latTest) [] fs + it (tstName latTest ++ " gives correct error") $ + normaliseOut (LatteIO.staticErr out) `shouldBe` normaliseOut (tstErr latTest) + it (tstName latTest ++ " returns 1") $ LatteIO.staticCode out `shouldBe` ExitFailure 1 + +go :: LatTest -> LatteIO.StaticIO () +go tst = do + let options = Opt {verbosity = Quiet, inputFile = tstName tst <.> latExt, generateIntermediate = True} + run options + +getLatTestsFromDir :: FilePath -> IO [LatTest] +getLatTestsFromDir dir = do + entries <- listDirectory dir + let latEntries = filter (\f -> takeExtension f == latExt) entries + mapM latToTest latEntries + where latToTest f = do + let outPath = dir f `replaceExtension` outExt + inPath = dir f `replaceExtension` inExt + errPath = dir f `replaceExtension` errExt + hasInput <- doesFileExist inPath + hasOutput <- doesFileExist outPath + c <- Prelude.readFile (dir f) + o <- if hasOutput then Prelude.readFile outPath else return [] + i <- if hasInput then Prelude.readFile inPath else return [] + e <- Prelude.readFile errPath + return $ LatTest (takeBaseName f) c (lines i) (lines o) (lines e) + +normaliseOut :: [String] -> String +normaliseOut = unwords . words . unlines + +latExt :: String +latExt = ".lat" + +errExt :: String +errExt = ".err" + +inExt :: String +inExt = ".input" + +outExt :: String +outExt = ".output" + +coreBadDir :: FilePath +coreBadDir = testRootDir "bad" + +coreGoodDir :: FilePath +coreGoodDir = testRootDir "good" + +arraysGoodDir :: FilePath +arraysGoodDir = testRootDir "extensions" "arrays1" + +objects1GoodDir :: FilePath +objects1GoodDir = testRootDir "extensions" "objects1" "good" + +objects1BadDir :: FilePath +objects1BadDir = testRootDir "extensions" "objects1" "bad" + +objects2GoodDir :: FilePath +objects2GoodDir = testRootDir "extensions" "objects2" + +structGoodDir :: FilePath +structGoodDir = testRootDir "extensions" "struct" + +varGoodDir :: FilePath +varGoodDir = testRootDir "extensions" "var" "good" + +varBadDir :: FilePath +varBadDir = testRootDir "extensions" "var" "bad" + +testRootDir :: FilePath +testRootDir = "." "test" "lattests" diff --git a/test/Discovery/Espresso/InterpreterSpec.hs b/test/Discovery/Espresso/InterpreterSpec.hs new file mode 100644 index 0000000..6c83d63 --- /dev/null +++ b/test/Discovery/Espresso/InterpreterSpec.hs @@ -0,0 +1,55 @@ +module Espresso.InterpreterSpec (spec) where + +import ErrM (toEither) +import Espresso.Interpreter (interpret) +import Espresso.Syntax.Abs (unwrapPos) +import Espresso.Syntax.Parser (myLexer, pProgram) +import LatteIO +import System.Directory (listDirectory) +import System.Exit +import System.FilePath (replaceExtension, takeBaseName, + takeExtension, ()) +import Test.Hspec + +data EspTest = EspTest { tstName :: String, tstContents :: String, tstIn :: [String], tstOut :: [String] } + +spec :: Spec +spec = parallel $ do + describe "Espresso good" $ do + tests <- runIO $ getEspTestsFromDir testRootDir + mapM_ test tests + +test :: EspTest -> Spec +test espTest = do + let out = run (tstContents espTest) (tstIn espTest) + it (tstName espTest ++ " returns 0") $ staticCode out `shouldBe` ExitSuccess + it (tstName espTest ++ " consumes all input") $ staticRemIn out `shouldBe` [] + it (tstName espTest ++ " gives correct output") $ unlines (staticOut out) `shouldBe` unlines (tstOut espTest) + +run :: String -> [String] -> StaticOutput () +run s input = case toEither $ pProgram $ myLexer s of + Left e -> Prelude.error e + Right t -> runStaticIO (interpret $ unwrapPos t) input (StaticFS []) + +getEspTestsFromDir :: FilePath -> IO [EspTest] +getEspTestsFromDir dir = do + entries <- listDirectory dir + let espEntries = filter (\f -> takeExtension f == espExt) entries + mapM espToTest espEntries + where espToTest f = do + c <- Prelude.readFile (dir f) + i <- Prelude.readFile (dir f `replaceExtension` inExt) + o <- Prelude.readFile (dir f `replaceExtension` outExt) + return $ EspTest (takeBaseName f) c (lines i) (lines o) + +espExt :: String +espExt = ".esp" + +inExt :: String +inExt = ".in" + +outExt :: String +outExt = ".out" + +testRootDir :: FilePath +testRootDir = "." "test" "esptests" diff --git a/test/Spec.hs b/test/Discovery/Spec.hs similarity index 100% rename from test/Spec.hs rename to test/Discovery/Spec.hs diff --git a/test/Exec/X86_64Spec.hs b/test/Exec/X86_64Spec.hs new file mode 100644 index 0000000..9e307bd --- /dev/null +++ b/test/Exec/X86_64Spec.hs @@ -0,0 +1,117 @@ +module X86_64Spec where + +import Control.Monad +import Data.Char +import System.Directory +import System.Exit +import System.FilePath +import System.Process +import Test.Hspec +import Utilities + +-- If True, the workdir is removed after execution ends. +-- Set to False to inspect the compiler output when tests fail. +cleanupEnabled :: Bool +cleanupEnabled = True + +main :: IO () +main = do + testPaths <- getTestFilesWithoutExtensions + prepareTests testPaths + hspec $ runTests $ map takeFileName testPaths + +runTests :: [FilePath] -> Spec +runTests tests = do + parallel $ describe "Core" $ forM_ tests runTest + runIO cleanup + +runTest :: FilePath -> Spec +runTest test = do + let latFile = workDirectory test <.> latExtension + inputFile = workDirectory test <.> inputExtension + outputFile = workDirectory test <.> expectedOutputExtension + actualOutputFile = workDirectory test <.> actualOutputExtension + execFile = workDirectory test + latcExitCode <- runIO $ runPrtCommand (compilerPath ++ " -g " ++ latFile) >>= waitForProcess + execExists <- runIO $ doesFileExist execFile + execExitCode <- runIO $ runPrtCommand (execFile ++ " < " ++ inputFile ++ " > " ++ actualOutputFile) + >>= waitForProcess + expectedOutputExists <- runIO $ doesFileExist outputFile + actualOutputExists <- runIO $ doesFileExist actualOutputFile + expectedOutput <- runIO $ if expectedOutputExists then readFile outputFile else return "" + actualOutput <- runIO $ if actualOutputExists then readFile actualOutputFile else return "" + it (test ++ " compiles successfully") $ latcExitCode `shouldBe` ExitSuccess + it (test ++ " executable is created") $ execExists `shouldBe` True + it (test ++ " executes successfully") $ execExitCode `shouldBe` ExitSuccess + it (test ++ " gives correct output") $ normaliseOut actualOutput `shouldBe` normaliseOut expectedOutput + +prepareTests :: [FilePath] -> IO () +prepareTests tests = do + makeExitCode <- runPrtCommand "make" >>= waitForProcess + unless (makeExitCode == ExitSuccess) (failCmd "make" makeExitCode) + mkdirExitCode <- runPrtCommand ("mkdir " ++ workDirectory) >>= waitForProcess + unless (mkdirExitCode == ExitSuccess) (failCmd "mkdir" mkdirExitCode) + forM_ tests copyTestToWorkdir + where copyTestToWorkdir fp = do + let latFile = fp <.> latExtension + inputFile = fp <.> inputExtension + outputFile = fp <.> expectedOutputExtension + cpExitCode <- + runPrtCommand ("cp " ++ latFile ++ " " ++ outputFile ++ " " ++ workDirectory) + >>= waitForProcess + unless (cpExitCode == ExitSuccess) (failCmd "cp" cpExitCode) + inputExists <- doesFileExist inputFile + if inputExists + then do + cpExitCode2 <- runPrtCommand ("cp " ++ inputFile ++ " " ++ workDirectory) + >>= waitForProcess + unless (cpExitCode2 == ExitSuccess) (failCmd "cp" cpExitCode2) + else do + let targetOutput = workDirectory takeFileName fp <.> inputExtension + touchExitCode <- runPrtCommand ("touch " ++ targetOutput) >>= waitForProcess + unless (touchExitCode == ExitSuccess) (failCmd "touch" touchExitCode) + +runPrtCommand :: String -> IO ProcessHandle +runPrtCommand s = putStrLn ("running: " ++ s) >> runCommand s + +cleanup :: IO () +cleanup = when cleanupEnabled (do + rmExitCode <- runPrtCommand ("rm -rf " ++ workDirectory) >>= waitForProcess + unless (rmExitCode == ExitSuccess) (failCmd "rm" rmExitCode)) + +normaliseOut :: String -> String +normaliseOut s = dropWhile isSpace $ reverse $ dropWhile isSpace $ reverse s + +getTestFilesWithoutExtensions :: IO [FilePath] +getTestFilesWithoutExtensions = do + files <- listDirectory coreTestsDirectory + let lats = filter (\f -> takeExtension f == latExtension) files + tests = map dropExtension lats + return $ map (coreTestsDirectory ) (dedup tests) + +compilerPath :: FilePath +compilerPath = "." "latc_x86_64" + +testDirectoryRoot :: FilePath +testDirectoryRoot = "." "test" "lattests" + +coreTestsDirectory :: FilePath +coreTestsDirectory = testDirectoryRoot "good" + +workDirectory :: FilePath +workDirectory = "." "test" "x86_64Spec_workdir" + +latExtension :: FilePath +latExtension = ".lat" + +inputExtension :: FilePath +inputExtension = ".input" + +expectedOutputExtension :: FilePath +expectedOutputExtension = ".output" + +actualOutputExtension :: FilePath +actualOutputExtension = ".output.actual" + +failCmd :: String -> ExitCode -> IO () +failCmd s c = putStr (s ++ " failed with exit code ") >> print c >> cleanup >> exitFailure diff --git a/test/SemanticAnalysis/AcceptanceSpec.hs b/test/SemanticAnalysis/AcceptanceSpec.hs deleted file mode 100644 index ff07d6a..0000000 --- a/test/SemanticAnalysis/AcceptanceSpec.hs +++ /dev/null @@ -1,109 +0,0 @@ -module SemanticAnalysis.AcceptanceSpec (spec) where - -import ErrM (toEither) -import SemanticAnalysis.Analyser (analyse) -import SemanticAnalysis.Toplevel (programMetadata) -import Syntax.Abs (unwrapPos) -import Syntax.Parser (myLexer, pProgram) -import Syntax.Rewriter (rewrite) -import System.Directory (listDirectory) -import System.FilePath (replaceExtension, takeBaseName, - takeExtension, ()) -import Test.Hspec - -data LatTest = LatTest { name :: String, contents :: String, err :: String } -data LatResult = Ok | Error String deriving (Eq, Show, Ord) - -spec :: Spec -spec = parallel $ do - describe "Core good" $ do - tests <- runIO $ getLatTestsFromDir coreGoodDir - mapM_ goodTest tests - describe "Core bad" $ do - tests <- runIO $ getLatTestsFromDir coreBadDir - mapM_ badTest tests - describe "Extension struct good" $ do - tests <- runIO $ getLatTestsFromDir structGoodDir - mapM_ goodTest tests - describe "Extension arrays good" $ do - tests <- runIO $ getLatTestsFromDir arraysGoodDir - mapM_ goodTest tests - describe "Extension objects1 good" $ do - tests <- runIO $ getLatTestsFromDir objects1GoodDir - mapM_ goodTest tests - describe "Extension objects1 bad" $ do - tests <- runIO $ getLatTestsFromDir objects1BadDir - mapM_ badTest tests - describe "Extension objects2 good" $ do - tests <- runIO $ getLatTestsFromDir objects2GoodDir - mapM_ goodTest tests - describe "Extension var good" $ do - tests <- runIO $ getLatTestsFromDir varGoodDir - mapM_ goodTest tests - describe "Extension var bad" $ do - tests <- runIO $ getLatTestsFromDir varBadDir - mapM_ badTest tests - -goodTest :: LatTest -> Spec -goodTest latTest = do - it (name latTest) $ run (contents latTest) `shouldBe` Ok - -badTest :: LatTest -> Spec -badTest latTest = do - it (name latTest) $ run (contents latTest) `shouldBe` Error (err latTest) - -run :: String -> LatResult -run s = case toEither $ pProgram ts of - Left e -> Error $ "ERROR\n" ++ e - Right t -> case programMetadata (rewrite $ unwrapPos t) of - Left e -> Error $ "ERROR\n" ++ e - Right m -> case analyse m of - Left e -> Error $ "ERROR\n" ++ e - Right _ -> Ok - where ts = myLexer s - -getLatTestsFromDir :: FilePath -> IO [LatTest] -getLatTestsFromDir dir = do - entries <- listDirectory dir - let latEntries = filter (\f -> takeExtension f == latExt) entries - mapM latToTest latEntries - where latToTest f = do - c <- readFile (dir f) - e <- readFile (dir f `replaceExtension` errExt) - return $ LatTest (takeBaseName f) c e - -latExt :: String -latExt = ".lat" - -errExt :: String -errExt = ".err" - -coreBadDir :: FilePath -coreBadDir = testRootDir "bad" - -coreGoodDir :: FilePath -coreGoodDir = testRootDir "good" - -arraysGoodDir :: FilePath -arraysGoodDir = testRootDir "extensions" "arrays1" - -objects1GoodDir :: FilePath -objects1GoodDir = testRootDir "extensions" "objects1" "good" - -objects1BadDir :: FilePath -objects1BadDir = testRootDir "extensions" "objects1" "bad" - -objects2GoodDir :: FilePath -objects2GoodDir = testRootDir "extensions" "objects2" - -structGoodDir :: FilePath -structGoodDir = testRootDir "extensions" "struct" - -varGoodDir :: FilePath -varGoodDir = testRootDir "extensions" "var" "good" - -varBadDir :: FilePath -varBadDir = testRootDir "extensions" "var" "bad" - -testRootDir :: FilePath -testRootDir = "." "test" "lattests" diff --git a/test/esptests/hello_world.esp b/test/esptests/hello_world.esp new file mode 100644 index 0000000..f5e86b1 --- /dev/null +++ b/test/esptests/hello_world.esp @@ -0,0 +1,22 @@ +.metadata: [ + .classes: [ + ~cl_TopLevel: [ + .fields: [ ] + .methods: [ + int() ~cl_TopLevel.main; + void(int) ~cl_TopLevel.printInt; + void(string) ~cl_TopLevel.printString; + void() ~cl_TopLevel.error; + int() ~cl_TopLevel.readInt; + string() ~cl_TopLevel.readString; + ] + ] + ] +] + +.method int ~cl_TopLevel.main(): [ + .L_entry: + %v_0 := "Hello, World!"; + call void ~cl_TopLevel.printString (string& %v_0); + return 0; +] \ No newline at end of file diff --git a/test/lattests/extensions/var/good/var001.out b/test/esptests/hello_world.in similarity index 100% rename from test/lattests/extensions/var/good/var001.out rename to test/esptests/hello_world.in diff --git a/test/esptests/hello_world.out b/test/esptests/hello_world.out new file mode 100644 index 0000000..b45ef6f --- /dev/null +++ b/test/esptests/hello_world.out @@ -0,0 +1 @@ +Hello, World! \ No newline at end of file diff --git a/test/esptests/iterative_factorial.esp b/test/esptests/iterative_factorial.esp new file mode 100644 index 0000000..ea23aa1 --- /dev/null +++ b/test/esptests/iterative_factorial.esp @@ -0,0 +1,39 @@ +.metadata: [ + .classes: [ + ~cl_TopLevel: [ + .fields: [ ] + .methods: [ + int() ~cl_TopLevel.main; + int(int) ~cl_TopLevel.fac; + void(int) ~cl_TopLevel.printInt; + void(string) ~cl_TopLevel.printString; + void() ~cl_TopLevel.error; + int() ~cl_TopLevel.readInt; + string() ~cl_TopLevel.readString; + ] + ] + ] +] + +.method int ~cl_TopLevel.main(): [ + .L_entry: + %v_1 := call int ~cl_TopLevel.readInt(); + %v_2 := call int ~cl_TopLevel.fac(int %v_1); + call void ~cl_TopLevel.printInt(int %v_2); + return 0; +] + +.method int ~cl_TopLevel.fac(int %a_n): [ + .L_entry: + .L_cond1: + %v_i1 := phi (.L_entry: int %a_n, .L_body1: int %v_i2); + %v_r1 := phi (.L_entry: 1, .L_body1: int %v_r2); + %v_t0 := int %v_i1 <= 1; + jump if bool %v_t0 then .L_end else .L_body1; + .L_body1: + %v_r2 := int %v_r1 * int %v_i1; + %v_i2 := int %v_i1 - 1; + jump .L_cond1; + .L_end: + return int %v_r1; +] \ No newline at end of file diff --git a/test/esptests/iterative_factorial.in b/test/esptests/iterative_factorial.in new file mode 100644 index 0000000..f599e28 --- /dev/null +++ b/test/esptests/iterative_factorial.in @@ -0,0 +1 @@ +10 diff --git a/test/esptests/iterative_factorial.out b/test/esptests/iterative_factorial.out new file mode 100644 index 0000000..c94e349 --- /dev/null +++ b/test/esptests/iterative_factorial.out @@ -0,0 +1 @@ +3628800 \ No newline at end of file diff --git a/test/esptests/recursive_factorial.esp b/test/esptests/recursive_factorial.esp new file mode 100644 index 0000000..3af2cb4 --- /dev/null +++ b/test/esptests/recursive_factorial.esp @@ -0,0 +1,38 @@ +.metadata: [ + .classes: [ + ~cl_TopLevel: [ + .fields: [ ] + .methods: [ + int() ~cl_TopLevel.main; + int(int) ~cl_TopLevel.fac; + void(int) ~cl_TopLevel.printInt; + void(string) ~cl_TopLevel.printString; + void() ~cl_TopLevel.error; + int() ~cl_TopLevel.readInt; + string() ~cl_TopLevel.readString; + ] + ] + ] +] + +.method int ~cl_TopLevel.main(): [ + .L_entry: + %v_1 := call int ~cl_TopLevel.readInt(); + %v_2 := call int ~cl_TopLevel.fac(int %v_1); + call void ~cl_TopLevel.printInt(int %v_2); + return 0; +] + +.method int ~cl_TopLevel.fac(int %a_n): [ + .L_entry: + .L_cond1: + %v_1 := int %a_n <= 1; + jump if bool %v_1 then .L_then1 else .L_else1; + .L_else1: + %v_2 := int %a_n - 1; + %v_3 := call int ~cl_TopLevel.fac(int %v_2); + %v_4 := int %a_n * int %v_3; + return int %v_4; + .L_then1: + return 1; +] \ No newline at end of file diff --git a/test/esptests/recursive_factorial.in b/test/esptests/recursive_factorial.in new file mode 100644 index 0000000..f599e28 --- /dev/null +++ b/test/esptests/recursive_factorial.in @@ -0,0 +1 @@ +10 diff --git a/test/esptests/recursive_factorial.out b/test/esptests/recursive_factorial.out new file mode 100644 index 0000000..c94e349 --- /dev/null +++ b/test/esptests/recursive_factorial.out @@ -0,0 +1 @@ +3628800 \ No newline at end of file diff --git a/test/lattests/extensions/var/good/var004.out b/test/lattests/extensions/var/good/var001.output similarity index 100% rename from test/lattests/extensions/var/good/var004.out rename to test/lattests/extensions/var/good/var001.output diff --git a/test/lattests/extensions/var/good/var002.out b/test/lattests/extensions/var/good/var002.output similarity index 100% rename from test/lattests/extensions/var/good/var002.out rename to test/lattests/extensions/var/good/var002.output diff --git a/test/lattests/extensions/var/good/var003.out b/test/lattests/extensions/var/good/var003.output similarity index 100% rename from test/lattests/extensions/var/good/var003.out rename to test/lattests/extensions/var/good/var003.output diff --git a/test/lattests/good/constexprInIf.out b/test/lattests/extensions/var/good/var004.output similarity index 100% rename from test/lattests/good/constexprInIf.out rename to test/lattests/extensions/var/good/var004.output diff --git a/test/lattests/good/constexprInWhile.out b/test/lattests/good/constexprInIf.output similarity index 100% rename from test/lattests/good/constexprInWhile.out rename to test/lattests/good/constexprInIf.output diff --git a/test/lattests/good/constexprInWhile.output b/test/lattests/good/constexprInWhile.output new file mode 100644 index 0000000..e69de29 diff --git a/test/lattests/good/core033.err b/test/lattests/good/core033.err new file mode 100755 index 0000000..a0aba93 --- /dev/null +++ b/test/lattests/good/core033.err @@ -0,0 +1 @@ +OK \ No newline at end of file diff --git a/test/lattests/good/core033.lat b/test/lattests/good/core033.lat new file mode 100755 index 0000000..78e5081 --- /dev/null +++ b/test/lattests/good/core033.lat @@ -0,0 +1,41 @@ +int foo(int a, int b) { + int c = a + b; // 42 + 17 = 59 + int d = c + b; // 59 + 17 = 76 + int e = a + d; // 42 + 76 = 118 + + printInt(e); + + return e; +} + +boolean bar() { + return true; +} + +boolean baz() { + return false; +} + +int main() { + int spec = foo(42, 17); + + if (bar()) { + printInt(spec); + } + + if (bar()) { + printInt(spec + 1000); + } + else { + printInt(spec + 2000); + } + + if (baz()) { + printInt(spec + 3000); + } + else { + printInt(spec + 4000); + } + + return 0; +} \ No newline at end of file diff --git a/test/lattests/good/core033.output b/test/lattests/good/core033.output new file mode 100755 index 0000000..f90cbfa --- /dev/null +++ b/test/lattests/good/core033.output @@ -0,0 +1,4 @@ +118 +118 +1118 +4118 \ No newline at end of file diff --git a/test/lattests/good/core034.err b/test/lattests/good/core034.err new file mode 100644 index 0000000..a0aba93 --- /dev/null +++ b/test/lattests/good/core034.err @@ -0,0 +1 @@ +OK \ No newline at end of file diff --git a/test/lattests/good/core034.lat b/test/lattests/good/core034.lat new file mode 100644 index 0000000..2223146 --- /dev/null +++ b/test/lattests/good/core034.lat @@ -0,0 +1,23 @@ +int foo(int one, int two, int three, int four, int five, int six, int seven, int eight, int nine) { + return one + two + three + four + five + six + seven + eight + nine; +} + +int main() { + int first = 42; + int second = 17; + int third = -1; + int fourth = first + second; // 59 + int fifth = fourth + first; // 101 + int sixth = fifth; // 101 + int seventh = sixth + fifth; // 202 + int eighth = 1000000; + int ninth = -eighth; + + // 42+17-1+52+101+101+202+1000000-1000000 = 521 + int x = first + second + third + fourth + fifth + sixth + seventh + eighth + ninth; + printInt(x); + int y = foo(first, second, third, fourth, fifth, sixth, seventh, eighth, ninth); + printInt(y); + + return 0; +} \ No newline at end of file diff --git a/test/lattests/good/core034.output b/test/lattests/good/core034.output new file mode 100644 index 0000000..44bce08 --- /dev/null +++ b/test/lattests/good/core034.output @@ -0,0 +1,2 @@ +521 +521 \ No newline at end of file diff --git a/test/lattests/good/core035.err b/test/lattests/good/core035.err new file mode 100644 index 0000000..a0aba93 --- /dev/null +++ b/test/lattests/good/core035.err @@ -0,0 +1 @@ +OK \ No newline at end of file diff --git a/test/lattests/good/core035.lat b/test/lattests/good/core035.lat new file mode 100644 index 0000000..3f08433 --- /dev/null +++ b/test/lattests/good/core035.lat @@ -0,0 +1,12 @@ +int main() { + int n = 100; + int i = 0; + + while (i < n) { + int x = i % 32; + printInt(x); + i++; + } + + return 0; +} \ No newline at end of file diff --git a/test/lattests/good/core035.output b/test/lattests/good/core035.output new file mode 100644 index 0000000..110f6db --- /dev/null +++ b/test/lattests/good/core035.output @@ -0,0 +1,100 @@ +0 +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +11 +12 +13 +14 +15 +16 +17 +18 +19 +20 +21 +22 +23 +24 +25 +26 +27 +28 +29 +30 +31 +0 +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +11 +12 +13 +14 +15 +16 +17 +18 +19 +20 +21 +22 +23 +24 +25 +26 +27 +28 +29 +30 +31 +0 +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +11 +12 +13 +14 +15 +16 +17 +18 +19 +20 +21 +22 +23 +24 +25 +26 +27 +28 +29 +30 +31 +0 +1 +2 +3 \ No newline at end of file