diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2014 + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,151 @@ +# A Rail compiler written in Haskell [![Build Status](https://travis-ci.org/SWP-Ubau-SoSe2014-Haskell/SWPSoSe14.svg?branch=master)](https://travis-ci.org/SWP-Ubau-SoSe2014-Haskell/SWPSoSe14) + +This is (or rather: will become) a compiler for the esoteric programming +language [Rail](http://esolangs.org/wiki/Rail), written in Haskell. + +## Contents of this repository + +- `documentation` contains additional documentation. + - The main documentation will be found in the code. +- `src` contains the Rail compiler and editor (written in Haskell). +- `tests` contains the hunit tests +- `integration-tests` contains integration tests + - see section `tests` for more information. + +## Development + +If you plan to contribute to the project, +make sure that your contribution does not break any tests and hlint is happy. + +### Coding conventions + +Though not applied consistently until now, +there are some things which would be really NICE to have: + +- Set indetations to 2 spaces +- Remove trailing white spaces +- Do not retab/reformat other people's code, especially not in a commit which + contains some logical changes as well +- One logical change per commit +- Integrate [hlint](https://hackage.haskell.org/package/hlint) to your editor of + choice and try to stick to the suggestions it makes +- Would be cool, if lines are not longer than 80 characters + +### Module testing with HUnit + +`tests` contains a `Main.hs` file that runs an HUnit test with a list of test +functions. For each module `src/[module-name].hs` of the compiler pipeline +exists a corresponding test file `tests/T[module-name].hs` exporting a list of +test functions for the named module. In the `Main.hs` file the list that is +tested by HUnit, is concatenated by the exported test lists of all test modules. + +### Integration tests + +Integration tests are stored in `integration-tests` in three subdirectories: +- `passing/` contains tests that are testing already implemented features and + that already passed before +- `failing/` contains tests that are testing already implemented features but + never passed +- `future/` contains tests that are testing functionality that will be added + in the future + +Each test consists of two files. A rail program `[test-name].rail` and an +io-file `[test-name].io`. + +The io-file specifies test cases, i.e. a set of inputs +with the expected corresponding outputs of the rail-program. + +Input and output as well as the test cases themselves are separated by a hash +tag. If an input has more than one value, they are separated by a newline. Consider +a rail program adding two numbers and printing the result (without any newlines). A +corresponding io-file with two test cases could look as follows: + +``` +3 +5 +# +8 +# +21 +56 +# +377 +``` + +**NOTE 1:** printed newlines have to be stated explicitly. Consider a hello-world +program printing `Hello World\n` (without any input). The io-file has to look +as follows: + +``` +# +Hello World\n +``` + +**NOTE 2:** The expected output is only tested against `stdout`. If you want to test the output +on `stderr` as well, you can add another section to a test case, separated by a single `%` line: + +``` +This is the input. +# +This is the expected output on stdout. +% +This is the expected output on stderr. +# +Another input. +# +Another stdout output. +``` + +**NOTE 3:** Lines containing only a single `%` or `#` character always delimit sections as +described above. There is no way to escape them, sorry. + +`tests/integration_tests.sh` is a script written in bash. It iterates over all +rail programs in `passing/`, compiles each of them using the current version of +our rail compiler and retrieves runnable llvm-code, i.e. it already links it +with the stack implementation, etc. For each input/output value, it puts the +input into the llvm-binary and compares the actual output with the current +output. The result will be printed to stdout. + +(TODO: do we have to run cabal first manually?) + +## Dependencies / Building the Compiler + +- Install cabal (package cabal-install in most distributions) +- Install llvm, versions llvm-3.3 and llvm-3.4 work. +- run `cabal update` +- If you don't use llvm-3.4 you manually need to install the corresponding haskell bindings, i.e.: `cabal install llvm-general-3.3.11.2` +- Switch to project folder +- Run `cabal install --enable-tests` to install all dependencies and build the project +- `cabal test` to run the tests +- Run the compiler with `dist/build/SWPSoSe14/SWPSoSe14 -c -i -o output` +- You still need to link the stack manually if you want to have executables: + `llvm-link src/RailCompiler/stack.ll -o executable` + +## Documentation + +You can generate the compiler documentation using `cabal haddock --executables +--haddock-options --ignore-all-exports` from the root project directory. + +## Branching model + +Currently, there are several (long-lived) team branches and one main development branch, +`master`. The `master` branch should always contain something that "works" to +some degree, i. e. it should never break. + +All team branches are merged into the `master` branch on a regular basis. + +### Team branches + +The following team branches exist. Except for `master`, all branches not mentioned +here are to be considered (short-lived) feature branches. + +- `gui`: Contains everything with a graphical user interface, most notably the debugger + and the graphical Rail editor. +- `intertarget-code`: Contains code for the backend, for intermediate code generation and + for code optimization. +- `preproc-lexer`: Contains code for the preprocessor and lexer components. +- `synsem-analysis`: Contains code for the syntactic/semantic analysis. + +## Additional Information + +For additional information take a look at our wiki pages: https://github.com/SWP-Ubau-SoSe2014-Haskell/SWPSoSe14/wiki diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/rail-compiler-editor.cabal b/rail-compiler-editor.cabal new file mode 100644 --- /dev/null +++ b/rail-compiler-editor.cabal @@ -0,0 +1,66 @@ +name: rail-compiler-editor +version: 0.2.0.0 +synopsis: Compiler and editor for the esolang rail. +description: A compiler and a graphical editor for the esoteric programming language rail. +homepage: https://github.com/SWP-Ubau-SoSe2014-Haskell/SWPSoSe14 +license: MIT +license-file: LICENSE +author: see AUTHORS +maintainer: borgers@mi.fu-berlin.de +-- A copyright notice. +-- copyright: +category: Language +build-type: Simple +extra-source-files: README.md, tests/integration_tests, src/RailCompiler/stack.ll +cabal-version: >=1.10 + +source-repository head + type: git + location: https://github.com/SWP-Ubau-SoSe2014-Haskell/SWPSoSe14.git + +executable RailCompiler + main-is: Main.hs + other-modules: + Backend + CodeOptimization + ErrorHandling + InterfaceDT + IntermediateCode + Lexer + Preprocessor + SemanticalAnalysis + SyntacticalAnalysis + --other-extensions: DeriveDataTypeable, GADTs, StandaloneDeriving + build-depends: base (>=4.5.0.0 && <5), llvm-general-pure, llvm-general <3.3.12 || (>=3.4 && < 3.4.3), mtl, containers + + -- Directories containing source files. + hs-source-dirs: src/RailCompiler + + -- Base language which the package is written in. + default-language: Haskell2010 + +executable RailEditor + main-is: Main.hs + other-modules: + EditorBackend + Execute + Menu + TextArea + build-depends: base (>=4.5.0.0 && <5), llvm-general-pure, llvm-general < 3.4.3, mtl, containers, transformers, gtk, process + hs-source-dirs: src/RailEditor src/RailCompiler + default-language: Haskell2010 + +Test-suite testcases + main-is: Main.hs + other-modules: + TBackend + TCodeOpt + TInterCode + TLexer + TPreProc + TSemAna + TSynAna + build-depends: base (>=4.5.0.0 && <5), HUnit, llvm-general-pure, llvm-general < 3.4.3, mtl, containers, process + hs-source-dirs: tests, src/RailCompiler + default-language: Haskell2010 + type: exitcode-stdio-1.0 diff --git a/src/RailCompiler/Backend.hs b/src/RailCompiler/Backend.hs new file mode 100644 --- /dev/null +++ b/src/RailCompiler/Backend.hs @@ -0,0 +1,45 @@ +{- | +Module : Backend +Description : Converts the internal LLVM representation into textual LLVM IR. +Maintainer : See the AUTHORS file in the root directory of this project for a list + of contributors. +License : MIT + +Uses the LLVM bindings for Haskell to convert the internal LLVM representation +(provided by the bindings themselves) into the final, textual LLVM IR. + +Does not do any linking. +-} +module Backend ( + process -- main function of the module "Backend" + ) +where + +-- imports -- +import InterfaceDT as IDT +import ErrorHandling as EH + +import LLVM.General.AST +import qualified LLVM.General.AST as AST +import LLVM.General.Context +import LLVM.General.Module +import Control.Monad.Error +import LLVM.General.AST.Global + + +-- functions -- +-- |Converts the internal LLVM representation into textual LLVM IR. +process :: IDT.CodeOpt2Backend -> IDT.Backend2Output +process input = output + where + output = IDT.IBO $ generateOutput input + +-- |Uses the Haskell LLVM bindings to convert the internal LLVM +-- representation into textual LLVM IR. +generateOutput :: IDT.CodeOpt2Backend -> IO String +generateOutput (IDT.ICB mod) = do + s <- withContext $ \context -> + runErrorT $ withModuleFromAST context mod $ \m -> moduleLLVMAssembly m + case s of + Left err -> return err + Right ll -> return ll diff --git a/src/RailCompiler/CodeOptimization.hs b/src/RailCompiler/CodeOptimization.hs new file mode 100644 --- /dev/null +++ b/src/RailCompiler/CodeOptimization.hs @@ -0,0 +1,23 @@ +{- | +Module : CodeOptimization.hs +Description : . +Maintainer : Christopher Pockrandt +License : MIT + +This module might be used for optimizing intermediate llvm code one day (or not). +Until then, `process` equals the identity function. + +-}module CodeOptimization ( + process -- main function of the module "CodeOptimization" + ) + where + + -- imports -- + import InterfaceDT as IDT + import ErrorHandling as EH + + -- functions -- + process :: IDT.InterCode2CodeOpt -> IDT.CodeOpt2Backend + process (IDT.IIC input) = IDT.ICB output + where + output = input diff --git a/src/RailCompiler/ErrorHandling.hs b/src/RailCompiler/ErrorHandling.hs new file mode 100644 --- /dev/null +++ b/src/RailCompiler/ErrorHandling.hs @@ -0,0 +1,41 @@ +{- | +Module : ErrorHandling.hs +Description : . +Maintainer : (c) Christopher Pockrandt, Nicolas Lehmann +License : MIT + +Contains error messages for errors during the compilation of a rail program +that result in an immediate stop of the process. The purpose is to get an +overview of all possible error messages for negative test cases for integration +testing. + +-} +module ErrorHandling where + +-- Common-Errors +generalError = "An error occured! Unfortunately, we can give you no exact indication of the error." + +-- PreProcessor-Errors +noStartSymbolFound = "No startsymbol '$' found! You should add a '$' as the startsymbol to your rail program." + +-- Lexer errors +strFunctionNameMissing = "Function without name found." +strNestedOpenBracket = "Nested opening bracket in string constant." +strNonSymmetricEscape = "Non-symmetric escape sequence in string constant." +strUnhandledEscape = "Unhandled escape sequence `\\%c' in string constant." +strMissingClosingBracket= "Closing Bracket not found." + +-- "shr" like in "shared graph representation". +shrLineNoLexeme = "No lexeme found in line: %s" + +-- SyntacticalAnalysis-Errors + +-- SemanticalAnalysis-Errors +strInvalidMovement = "Invalid movement." +strMainMissing = "No 'main' Method found." + +-- IntermediateCode-Errors + +-- CodeOptimization-Errors + +-- Backend diff --git a/src/RailCompiler/InterfaceDT.hs b/src/RailCompiler/InterfaceDT.hs new file mode 100644 --- /dev/null +++ b/src/RailCompiler/InterfaceDT.hs @@ -0,0 +1,43 @@ +{- | +Module : InterfaceDT.hs +Description : . +Maintainer : Nicolas Lehmann +License : MIT + +Defining algebraic data types for all compiler stages. Each module in the +pipeline has two corresponding algebraic data types, one defining the input and +the other defining the output. The output data type of a compiler stage is the +input data type of the following compiler stage. The algebraic data types ensure +a clean interface between the modules. + +-} +module InterfaceDT where + + import qualified LLVM.General.AST as LAST + + -- type definitions -- + type Grid2D = [String] + + -- |(NodeID (start: 1), Lexeme of Node, NodeID of following Node (0 if none)) + type LexNode = (Int, Lexeme, Int) + -- |(FunctionID, Graph of Function as adjacency list) + type Graph = (String, [LexNode]) + -- |(FunctionID, [(PathID (start: 1), List of Lexemes to be executed sequentially, PathID of following Path)]) + type AST = (String, [(Int, [Lexeme], Int)]) + -- |* following Nodes or Pathes could have ID==0, in this case there is no Follower + + -- |Junction Int <=> if false goto Int; if true <=> following node + data Lexeme = NOP | Boom | EOF | Input | Output | Underflow | RType | + Constant String | Push String | Pop String | Call String | Add1 | Divide | + Multiply | Remainder | Subtract | Cut | Append | Size | Nil | Cons | + Breakup | Greater | Equal | Start | Finish | Junction Int deriving (Eq, Show) + + -- interface datatypes -- + data Input2PreProc = IIP String deriving (Eq, Show) + data PreProc2Lexer = IPL [Grid2D] deriving (Eq, Show) + data Lexer2SynAna = ILS [Graph] deriving (Eq, Show) + data SynAna2SemAna = ISS [AST] deriving (Eq, Show) + data SemAna2InterCode = ISI [AST] deriving (Eq, Show) + data InterCode2CodeOpt = IIC LAST.Module deriving (Eq, Show) + data CodeOpt2Backend = ICB LAST.Module deriving (Eq, Show) + data Backend2Output = IBO (IO String) diff --git a/src/RailCompiler/IntermediateCode.hs b/src/RailCompiler/IntermediateCode.hs new file mode 100644 --- /dev/null +++ b/src/RailCompiler/IntermediateCode.hs @@ -0,0 +1,693 @@ +{- | +Module : IntermediateCode.hs +Description : Intermediate code generation +Copyright : (c) AUTHORS +License : MIT +Stability : unstable + +IntemediateCode.hs takes the output from the SemanticalAnalysis module +(which is a list of paths) and generates LLVM IR code. +It turns every path of the form (PathID, [Lexeme], PathID) into a basic block. + +-} + +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module IntermediateCode(process) where + +-- imports -- +import InterfaceDT as IDT +import ErrorHandling as EH + +import LLVM.General.AST +import qualified LLVM.General.AST.Global as Global +import LLVM.General.AST.CallingConvention +import LLVM.General.AST.Constant as Constant +import LLVM.General.AST.Linkage +import LLVM.General.AST.AddrSpace +import LLVM.General.AST.Operand +import LLVM.General.AST.Instruction as Instruction +import LLVM.General.AST.IntegerPredicate +import LLVM.General.AST.Float +import Data.Char +import Data.Word +import Data.List +import Data.Map hiding (filter, map) + +import Control.Monad.State +import Control.Applicative + +data CodegenState = CodegenState { + blocks :: [BasicBlock], + count :: Word, --Count of unnamed Instructions + localDict :: Map String (Int, Integer) +} + +newtype Codegen a = Codegen { runCodegen :: State CodegenState a } + deriving (Functor, Applicative, Monad, MonadState CodegenState) + +data GlobalCodegenState = GlobalCodegenState { + dict :: Map String (Int, Integer) +} + +newtype GlobalCodegen a = GlobalCodegen { runGlobalCodegen :: State GlobalCodegenState a } + deriving (Functor, Applicative, Monad, MonadState GlobalCodegenState) + +execGlobalCodegen :: Map String (Int, Integer) -> GlobalCodegen a -> a +execGlobalCodegen d m = evalState (runGlobalCodegen m) $ GlobalCodegenState d + +execCodegen :: Map String (Int, Integer) -> Codegen a -> a +execCodegen d m = evalState (runCodegen m) $ CodegenState [] 0 d + +-- generate module from list of definitions +generateModule :: [Definition] -> Module +generateModule definitions = defaultModule { + moduleName = "rail-heaven", + moduleDefinitions = definitions +} + +-- |Generate a ret statement, returning a 32-bit Integer to the caller. +-- While we use 64-bit integers everywhere else, our "main" function +-- needs to return an "int" which usually is 32-bits even on 64-bit systems. +terminator :: Integer -- ^The 32-bit Integer to return. + -> Named Terminator -- ^The return statement. +terminator ret = Do Ret { + returnOperand = Just $ ConstantOperand $ Int 32 ret, + metadata' = [] +} + +-- generate global byte array (constant string) +createGlobalString :: Lexeme -> Global +createGlobalString (Constant s) = globalVariableDefaults { + Global.type' = ArrayType { + nArrayElements = fromInteger l, + elementType = IntegerType {typeBits = 8} + }, + Global.initializer = Just Array { + memberType = IntegerType {typeBits = 8}, + memberValues = map trans s ++ [Int { integerBits = 8, integerValue = 0 }] + } +} + where + l = toInteger $ 1 + length s + trans c = Int { integerBits = 8, integerValue = toInteger $ ord c } + +-- create constant strings/byte arrays for module +-- TODO maybe rename these subfunctions? +generateConstants :: [AST] -> [Global] +generateConstants = map createGlobalString . getAllCons + +getAllCons :: [AST] -> [Lexeme] +getAllCons = concatMap generateCons + +generateCons :: AST -> [Lexeme] +generateCons (name, paths) = concatMap generateC paths + +generateC :: (Int, [Lexeme], Int) -> [Lexeme] +generateC (pathID, lex, nextPath) = filter checkCons lex +checkCons (Constant c) = True +checkCons _ = False + +-------------------------------------------------------------------------------- +-- generate global variables for push and pop form and into variables +createGlobalVariable :: Lexeme -> Global +createGlobalVariable (Pop v) = globalVariableDefaults { + Global.name = Name v, + Global.type' = bytePointerTypeVar, + Global.initializer = Just (Undef VoidType) +} + +generateVariables :: [AST] -> [Global] +generateVariables = map createGlobalVariable . getAllVars + +getAllVars :: [AST] -> [Lexeme] +getAllVars = concatMap generateVars + +generateVars :: AST -> [Lexeme] +generateVars (name, paths) = nub $ concatMap generateV paths --delete duplicates + +generateV :: (Int, [Lexeme], Int) -> [Lexeme] +generateV (pathID, lex, nextPath) = filter checkVars lex +checkVars (Pop v) = True +checkVars _ = False +-------------------------------------------------------------------------------- + +-- pointer type for i8* used e.g. as "string" pointer +bytePointerType = PointerType { + pointerReferent = IntegerType 8, + pointerAddrSpace = AddrSpace 0 +} + +-- pointer type for i8** used as variable pointer +bytePointerTypeVar = PointerType { + pointerReferent = PointerType { + pointerReferent = IntegerType 8, + pointerAddrSpace = AddrSpace 0 + }, + pointerAddrSpace = AddrSpace 0 +} + +-- |Function declaration for 'underflow_check'. +underflowCheck = GlobalDefinition $ Global.functionDefaults { + Global.name = Name "underflow_check", + Global.returnType = VoidType, + Global.parameters = ([], False) +} + +-- |Function declaration for 'print'. +print = GlobalDefinition $ Global.functionDefaults { + Global.name = Name "print", + Global.returnType = VoidType, + Global.parameters = ([], False) +} + +-- |Function declaration for 'crash'. +crash = GlobalDefinition $ Global.functionDefaults { + Global.name = Name "crash", + Global.returnType = VoidType, + Global.parameters = ([ Parameter (IntegerType 1) (Name "is_custom_error") [] ], False) +} + +-- |Function declaration for 'finish'. +finish = GlobalDefinition $ Global.functionDefaults { + Global.name = Name "finish", + Global.returnType = VoidType, + Global.parameters = ([], False) +} + +-- |Function declaration for 'input'. +inputFunc = GlobalDefinition $ Global.functionDefaults { + Global.name = Name "input", + Global.returnType = VoidType, + Global.parameters = ([], False) +} + +-- |Function declaration for 'eof_check'. +eofCheck = GlobalDefinition $ Global.functionDefaults { + Global.name = Name "eof_check", + Global.returnType = VoidType, + Global.parameters = ([], False) +} + +-- |Function declaration for 'add'. +add = GlobalDefinition $ Global.functionDefaults { + Global.name = Name "add", + Global.returnType = VoidType, + Global.parameters = ([], False) +} + +-- |Function declaration for 'rem'. +rem1 = GlobalDefinition $ Global.functionDefaults { + Global.name = Name "rem", + Global.returnType = VoidType, + Global.parameters = ([], False) +} + +-- |Function declaration for 'sub'. +sub = GlobalDefinition $ Global.functionDefaults { + Global.name = Name "sub", + Global.returnType = VoidType, + Global.parameters = ([], False) +} + +-- |Function declaration for 'mul'. +mul = GlobalDefinition $ Global.functionDefaults { + Global.name = Name "mult", + Global.returnType = VoidType, + Global.parameters = ([], False) +} + +-- |Function declaration for 'div'. +div1 = GlobalDefinition $ Global.functionDefaults { + Global.name = Name "div", + Global.returnType = VoidType, + Global.parameters = ([], False) +} + + +-- function declaration for push +push = GlobalDefinition $ Global.functionDefaults { + Global.name = Name "push", + Global.returnType = VoidType, + Global.parameters = ([ Parameter bytePointerType (UnName 0) [] ], False) +} + +-- function declaration for pop +pop = GlobalDefinition $ Global.functionDefaults { + Global.name = Name "pop", + Global.returnType = bytePointerType, + Global.parameters = ([], False) +} + +-- function declaration for peek +peek = GlobalDefinition $ Global.functionDefaults { + Global.name = Name "peek", + Global.returnType = bytePointerType, + Global.parameters = ([], False) +} + + +-- function declaration for streq +streq = GlobalDefinition $ Global.functionDefaults { + Global.name = Name "streq", + Global.returnType = bytePointerType, + Global.parameters = ([], False) +} + +-- function declaration for strlen +strlen = GlobalDefinition $ Global.functionDefaults { + Global.name = Name "strlen", + Global.returnType = bytePointerType, + Global.parameters = ([], False) +} + +-- function declaration for strapp +strapp = GlobalDefinition $ Global.functionDefaults { + Global.name = Name "strapp", + Global.returnType = bytePointerType, + Global.parameters = ([], False) +} + +-- function declaration for pop_int +popInt = GlobalDefinition $ Global.functionDefaults { + Global.name = Name "pop_int", + Global.returnType = IntegerType 64, + Global.parameters = ([], False) +} + +-- function declaration for equal +equal = GlobalDefinition $ Global.functionDefaults { + Global.name = Name "equal", + Global.returnType = VoidType, + Global.parameters = ([], False) +} +-- function declaration for greater +greater = GlobalDefinition $ Global.functionDefaults { + Global.name = Name "greater", + Global.returnType = VoidType, + Global.parameters = ([], False) +} + +-- function declaration for pop_into +popInto = GlobalDefinition $ Global.functionDefaults { + Global.name = Name "pop_into", + Global.returnType = VoidType, + Global.parameters = ([ Parameter bytePointerTypeVar (UnName 0) [] ], False) +} + +-- function declaration for push_from +pushFrom = GlobalDefinition $ Global.functionDefaults { + Global.name = Name "push_from", + Global.returnType = VoidType, + Global.parameters = ([ Parameter bytePointerTypeVar (UnName 0) [] ], False) +} + +-- |Generate an instruction for the 'u'nderflow check command. +generateInstruction Underflow = + return [Do LLVM.General.AST.Call { + isTailCall = False, + callingConvention = C, + returnAttributes = [], + function = Right $ ConstantOperand $ GlobalReference $ Name "underflow_check", + arguments = [], + functionAttributes = [], + metadata = [] + }] + +generateInstruction (Junction label) = do + index <- fresh + index2 <- fresh + return [ UnName index := LLVM.General.AST.Call { + isTailCall = False, + callingConvention = C, + returnAttributes = [], + function = Right $ ConstantOperand $ GlobalReference $ Name "pop_int", + arguments = [], + functionAttributes = [], + metadata = [] + }, UnName index2 := LLVM.General.AST.ICmp { + LLVM.General.AST.iPredicate = LLVM.General.AST.IntegerPredicate.EQ, + LLVM.General.AST.operand0 = LocalReference (UnName index), + LLVM.General.AST.operand1 = ConstantOperand $ Int 64 0, + metadata = [] + }] + + +-- generate instruction for pop into a variable +generateInstruction (Pop name) = do + index <- fresh + index2 <- fresh + index3 <- fresh + return [ UnName index := Instruction.Alloca { + allocatedType = bytePointerType, + numElements = Nothing, --Just (LocalReference (Name name)), + alignment = 4, + metadata = [] + }, + UnName index2 := LLVM.General.AST.Call { + isTailCall = False, + callingConvention = C, + returnAttributes = [], + function = Right $ ConstantOperand $ GlobalReference $ Name "pop_into", + arguments = [(LocalReference $ UnName index, [])], + functionAttributes = [], + metadata = [] + }, + UnName index3 := Instruction.Store { + volatile = False, + Instruction.address = ConstantOperand $ GlobalReference $ Name name, + value = LocalReference (UnName index), + maybeAtomicity = Nothing, + alignment = 4, + metadata = [] +}] + +-- generate instruction for push from a variable +generateInstruction (Push name) = do + index <- fresh + index2 <- fresh + return [ UnName index := Instruction.Load { + volatile = False, + Instruction.address = ConstantOperand $ GlobalReference $ Name name, + maybeAtomicity = Nothing, + alignment = 4, + metadata = [] + }, + UnName index2 := LLVM.General.AST.Call { + isTailCall = False, + callingConvention = C, + returnAttributes = [], + function = Right $ ConstantOperand $ GlobalReference $ Name "push_from", + arguments = [(LocalReference $ UnName index, [])], + functionAttributes = [], + metadata = [] + }] + + +-- generate instruction for push of a constant +-- access to our push function definied in stack.ll?? +-- http://llvm.org/docs/LangRef.html#call-instruction +generateInstruction (Constant value) = do + index <- fresh + dict <- gets localDict + return [UnName index := LLVM.General.AST.Call { + -- The optional tail and musttail markers indicate that the optimizers + --should perform tail call optimization. + isTailCall = False, + -- The optional "cconv" marker indicates which calling convention the call + -- should use. If none is specified, the call defaults to using C calling + -- conventions. + callingConvention = C, + -- The optional Parameter Attributes list for return values. Only 'zeroext', + -- 'signext', and 'inreg' attributes are valid here + returnAttributes = [], + -- actual function to call + function = Right $ ConstantOperand $ GlobalReference $ Name "push", + -- argument list whose types match the function signature argument types + -- and parameter attributes. All arguments must be of first class type. If + -- the function signature indicates the function accepts a variable number of + -- arguments, the extra arguments can be specified. + arguments = [ + -- The 'getelementptr' instruction is used to get the address of a + -- subelement of an aggregate data structure. It performs address + -- calculation only and does not access memory. + -- http://llvm.org/docs/LangRef.html#getelementptr-instruction + (ConstantOperand Constant.GetElementPtr { + Constant.inBounds = True, + Constant.address = Constant.GlobalReference (UnName $ fromInteger $ snd $ dict ! value), + Constant.indices = [ + Int { integerBits = 8, integerValue = 0 }, + Int { integerBits = 8, integerValue = 0 } + ] + }, []) + ], + -- optional function attributes list. Only 'noreturn', 'nounwind', + -- 'readonly' and 'readnone' attributes are valid here. + functionAttributes = [], + metadata = [] + }] + +-- depending on the Lexeme we see we need to create one or more Instructions +-- the generateInstruction function should return a list of instructions +-- after the mapping phase we should flatten the array with concat so we that we get +-- a list of Instructions that we can insert in the BasicBlock + +-- |Generate instruction for printing strings to stdout. +generateInstruction Output = + return [Do LLVM.General.AST.Call { + isTailCall = False, + callingConvention = C, + returnAttributes = [], + function = Right $ ConstantOperand $ GlobalReference $ Name "print", + arguments = [], + functionAttributes = [], + metadata = [] + }] + +-- |Generate instruction for the Boom lexeme (crashes program). +generateInstruction Boom = + return [Do LLVM.General.AST.Call { + isTailCall = False, + callingConvention = C, + returnAttributes = [], + function = Right $ ConstantOperand $ GlobalReference $ Name "crash", + arguments = [(ConstantOperand $ Int 1 1, [])], + functionAttributes = [], + metadata = [] + }] + +-- |Generate instruction for the Input lexeme. +generateInstruction Input = + return [Do LLVM.General.AST.Call { + isTailCall = False, + callingConvention = C, + returnAttributes = [], + function = Right $ ConstantOperand $ GlobalReference $ Name "input", + arguments = [], + functionAttributes = [], + metadata = [] + }] + +-- |Generate instruction for the EOF lexeme. +generateInstruction EOF = + return [Do LLVM.General.AST.Call { + isTailCall = False, + callingConvention = C, + returnAttributes = [], + function = Right $ ConstantOperand $ GlobalReference $ Name "eof_check", + arguments = [], + functionAttributes = [], + metadata = [] + }] + +-- |Generate instruction for the add instruction. +generateInstruction Add1 = + return [Do LLVM.General.AST.Call { + isTailCall = False, + callingConvention = C, + returnAttributes = [], + function = Right $ ConstantOperand $ GlobalReference $ Name "add", + arguments = [], + functionAttributes = [], + metadata = [] + }] + +-- |Generate instruction for the remainder instruction. +generateInstruction Remainder = + return [Do LLVM.General.AST.Call { + isTailCall = False, + callingConvention = C, + returnAttributes = [], + function = Right $ ConstantOperand $ GlobalReference $ Name "rem", + arguments = [], + functionAttributes = [], + metadata = [] + }] + + +-- |Generate instruction for the sub instruction. +generateInstruction Subtract = + return [Do LLVM.General.AST.Call { + isTailCall = False, + callingConvention = C, + returnAttributes = [], + function = Right $ ConstantOperand $ GlobalReference $ Name "sub", + arguments = [], + functionAttributes = [], + metadata = [] + }] + +-- |Generate instruction for the mul instruction. +generateInstruction Multiply = + return [Do LLVM.General.AST.Call { + isTailCall = False, + callingConvention = C, + returnAttributes = [], + function = Right $ ConstantOperand $ GlobalReference $ Name "mult", + arguments = [], + functionAttributes = [], + metadata = [] + }] + +-- |Generate instruction for the div instruction. +generateInstruction Divide = + return [Do LLVM.General.AST.Call { + isTailCall = False, + callingConvention = C, + returnAttributes = [], + function = Right $ ConstantOperand $ GlobalReference $ Name "div", + arguments = [], + functionAttributes = [], + metadata = [] + }] + + +-- |Generate instruction for the strlen instruction. +generateInstruction Size = + return [Do LLVM.General.AST.Call { + isTailCall = False, + callingConvention = C, + returnAttributes = [], + function = Right $ ConstantOperand $ GlobalReference $ Name "strlen", + arguments = [], + functionAttributes = [], + metadata = [] + }] + +-- |Generate instruction for the strapp instruction. +generateInstruction Append = + return [Do LLVM.General.AST.Call { + isTailCall = False, + callingConvention = C, + returnAttributes = [], + function = Right $ ConstantOperand $ GlobalReference $ Name "strapp", + arguments = [], + functionAttributes = [], + metadata = [] + }] + +-- |Generate instruction for the equal instruction. +generateInstruction Equal = + return [Do LLVM.General.AST.Call { + isTailCall = False, + callingConvention = C, + returnAttributes = [], + function = Right $ ConstantOperand $ GlobalReference $ Name "equal", + arguments = [], + functionAttributes = [], + metadata = [] + }] + + +-- |Generate instruction for the greater instruction. +generateInstruction Greater = + return [Do LLVM.General.AST.Call { + isTailCall = False, + callingConvention = C, + returnAttributes = [], + function = Right $ ConstantOperand $ GlobalReference $ Name "greater", + arguments = [], + functionAttributes = [], + metadata = [] + }] + +-- do nothing? +--generateInstruction Start = +-- undefined + +-- |Generate instruction for finish instruction +generateInstruction Finish = + return [Do LLVM.General.AST.Call { + isTailCall = False, + callingConvention = C, + returnAttributes = [], + function = Right $ ConstantOperand $ GlobalReference $ Name "finish", + arguments = [], + functionAttributes = [], + metadata = [] + }] + +-- noop +generateInstruction _ = return [ Do $ Instruction.FAdd (ConstantOperand $ Float $ Single 1.0) (ConstantOperand $ Float $ Single 1.0) [] ] + +isUsefulInstruction Start = False +isUsefulInstruction _ = True + +-- removes Lexemes without meaning to us +filterInstrs = filter isUsefulInstruction + + +generateBasicBlock :: (Int, [Lexeme], Int) -> Codegen BasicBlock +generateBasicBlock (label, instructions, 0) = do + tmp <- mapM generateInstruction $ filterInstrs instructions + return $ BasicBlock (Name $ "l_" ++ show label) (concat tmp) $ terminator 0 +generateBasicBlock (label, instructions, jumpLabel) = do + tmp <- mapM generateInstruction $ filterInstrs instructions + i <- gets count + case filter isJunction instructions of + [Junction junctionLabel] -> return $ BasicBlock (Name $ "l_" ++ show label) (concat tmp) $ condbranch junctionLabel i + [] -> return $ BasicBlock (Name $ "l_" ++ show label) (concat tmp) branch + where + isJunction (Junction a) = True + isJunction _ = False + condbranch junctionLabel i = Do CondBr { + condition = LocalReference $ UnName i, + trueDest = Name $ "l_" ++ show junctionLabel, + falseDest = Name $ "l_" ++ show jumpLabel, + metadata' = [] + } + branch = Do Br { + dest = Name $ "l_" ++ show jumpLabel, + metadata' = [] + } + + +generateBasicBlocks :: [(Int, [Lexeme], Int)] -> Codegen [BasicBlock] +generateBasicBlocks = mapM generateBasicBlock + +-- generate function definition from AST +generateFunction :: AST -> GlobalCodegen Definition +generateFunction (name, lexemes) = do + dict <- gets dict + return $ GlobalDefinition $ Global.functionDefaults { + Global.name = Name name, + Global.returnType = IntegerType 32, + Global.basicBlocks = execCodegen dict $ generateBasicBlocks lexemes + } + +fresh :: Codegen Word +fresh = do + i <- gets count + modify $ \s -> s { count = 1 + i } + return $ i + 1 + +-- generate list of LLVM Definitions from list of ASTs +generateFunctions :: [AST] -> GlobalCodegen [Definition] +generateFunctions = mapM generateFunction + +generateGlobalDefinition :: Integer -> Global -> Definition +generateGlobalDefinition index def = GlobalDefinition def { + Global.name = UnName $ fromInteger index, + Global.isConstant = True, + Global.linkage = Internal, + Global.hasUnnamedAddr = True +} + +-- TODO find a more elegant way to solve this +generateGlobalDefinitionVar :: Integer -> Global -> Definition +generateGlobalDefinitionVar i def = GlobalDefinition def { + Global.initializer = Just (Undef VoidType) +} + +-- entry point into module -- +process :: IDT.SemAna2InterCode -> IDT.InterCode2CodeOpt +process (IDT.ISI input) = IDT.IIC $ generateModule $ constants ++ variables ++ + [ underflowCheck, IntermediateCode.print, crash, finish, inputFunc, + eofCheck, push, pop, peek, add, sub, rem1, mul, div1, streq, strlen, strapp, + popInt, equal, greater, popInto, pushFrom ] ++ generateFunctionsFoo input + where + constants = zipWith generateGlobalDefinition [0..] $ generateConstants input + variables = zipWith generateGlobalDefinitionVar [0..] $ generateVariables input + d = fromList $ zipWith foo [0..] $ getAllCons input + foo index (Constant s) = (s, (length s, index)) --TODO rename foo to something meaningful e.g. createSymTable + generateFunctionsFoo input = execGlobalCodegen d $ generateFunctions input diff --git a/src/RailCompiler/Lexer.hs b/src/RailCompiler/Lexer.hs new file mode 100644 --- /dev/null +++ b/src/RailCompiler/Lexer.hs @@ -0,0 +1,659 @@ +{- | +Module : Lexer +Description : Processes preprocessor output into input for the syntactical analysis. +Maintainer : Christian H. et al. +License : MIT + +The lexer receives the output of the preprocessor -- a list of lists of strings, +where each list represents a single function -- and turns it into a forest of function +graphs. The forest is represented as a list of tuples; each tuple describes a function +graph and contains the function name as a string as well as the function's graph itself. + +A single function graph is a list of nodes. A node is a triple containing the following +elements, in this order: + + * Node ID as an Integer. Starts with 1 for each function. + * The 'IDT.Lexeme' for this node. + * The node ID of the follower node or 0 if there is no next node. + +Note that for valid input, the only node with a follower ID of 0 can be +a node containing the 'IDT.Finish' lexeme. If any other node contains a follower +ID of 0, this is an error (or, in Rail terms, a "crash". +-} +module Lexer ( + -- * Main (pipeline) functions + process, + -- * Utility functions + fromAST, toAST, + -- * Editor functions + step, parse, IP(IP), posx, posy, start, crash, turnaround, junctionturns, lambdadirs , move , current, RelDirection(Forward) + ) + where + + -- imports -- + import InterfaceDT as IDT + import ErrorHandling as EH + import Data.List + import Text.Printf + + -- |Modified 'IDT.LexNode' with an additional identifier for nodes + -- to check whether we have circles in the graph. + -- + -- The identifier is the last element of the tuple and contains + -- the following sub-elements, in this order: + -- + -- * When we visited this node, at which X position did we start to parse its lexeme? + -- * When we visited this node, at which Y position did we start to parse its lexeme? + -- * When we visited this node, from which direction did we come? + type PreLexNode = (Int, IDT.Lexeme, Int, (Int, Int, Direction)) + -- |An absolute direction. + data Direction = N | NE | E | SE | S | SW | W | NW deriving (Eq, Show) + -- |A relative direction. + data RelDirection = Left | Forward | Right deriving (Eq, Show) + -- |Instruction pointer consisting of position and an orientation. + data IP = + IP { + -- |Number of processed characters since start of current function. + count :: Int, + -- |Current X position. + posx :: Int, + -- |Current Y position. + posy :: Int, + -- |Current 'Direction'. + dir :: Direction, + -- |Determines if the instruction pointer is on a left or right path of a Junction + path :: RelDirection + } + deriving (Show) + + instance Eq IP + where + (==) ipl ipr = posx ipl == posx ipr && posy ipl == posy ipr && dir ipl == dir ipr + + -- functions -- + + -- |Process preprocessor output into a list of function ASTs. + -- + -- Raises 'error's on invalid input; see 'ErrorHandling' for a list of error messages. + process :: IDT.PreProc2Lexer -- ^Preprocessor output (a list of lists of strings; i. e. a list of functions + -- in their line representation). + -> IDT.Lexer2SynAna -- ^A list of ASTs, each describing a single function. + process (IDT.IPL input) = IDT.ILS $ concatMap processfn input + + -- |Process a single function. + processfn :: IDT.Grid2D -- ^The lines representing the function. + -> [IDT.Graph] -- ^A graph of nodes representing the function. + -- There may be more functions because of lambdas. + processfn [x] = [(funcname x, [(1, Start, 0)])] -- oneliners are illegal; follower == 0 will + -- lead to a crash, which is what we want. + processfn code@(x:xs) = if head x /= '$' then [(funcname x, [(1, Start, 0)])] else [(funcname x, finalize (head nxs) [])] + where + (nxs, _) = nodes code [[(1, Start, 0, (0, 0, SE))]] start + + -- |Get the name of the given function. + -- + -- TODO: Note that this will crash the entire program if there is + -- no function name. + funcname :: String -- ^A line containing the function declaration, + -- e. g. @$ \'main\'@. + -> String -- ^The function name. + funcname line + | null line || length (elemIndices '\'' line) < 2 = error EH.strFunctionNameMissing + | otherwise = takeWhile (/='\'') $ tail $ dropWhile (/='\'') line + + -- |Get the nodes for the given function. + nodes :: IDT.Grid2D -- ^Lines representing the function. + -> [[PreLexNode]] -- ^Current graph representing the function. + -- Initialize with @[[(1, Start, 0, (0, 0, SE))]]@. + -> IP -- ^Current instruction pointer. + -- Initialize with @'start'@. + -> ([[PreLexNode]], IP) -- ^Final graph for the function and the new instruction pointer. + nodes code list ip + | current code tempip == ' ' = (list, tempip) -- If we are not finished yet, this will + -- automatically lead to a + -- crash since the list will have + -- a leading node without a follower + -- (follower == 0) because it is + -- not modified here at all. + | otherwise = if endless then (endlesslist, crash) else nodes code newlist newip + where + -- This checks if we have e. g. two reflectors that "bounce" the IP between them + -- endlessly. + endless = count ip > sum (map length code) + endlesslist = (newnode, NOP, newnode, (-1, -1, SE)) `prepend` update list (path ip) newnode + newnode = sum (map length list) + 1 + prepend newx (x:xs) = (newx:x):xs + tempip = step code ip + (newlist, newip) = handle code list tempip + + -- |Helper function for 'nodes': Handle the creation of the next 'PreLexNode' + -- for the current function. + handle :: IDT.Grid2D -- ^Line representation of input function. + -> [[PreLexNode]] -- ^Current list of nodes. + -> IP -- ^Current instruction pointer. + -> ([[PreLexNode]], IP) -- ^New node list and new instruction pointer. + handle code list ip = helper code list newip lexeme + where + (lexeme, newip) = parse code ip + helper _ list ip Nothing = (list, ip) + helper code list ip (Just lexeme) + | knownat > 0 = (update list (path ip) knownat, crash) + | lexeme == Finish = (newlist, crash) + | isjunction lexeme = (merge final, crash) + | otherwise = (newlist, ip{count = 0}) + where + knownat = visited list ip + newnode = sum (map length list) + 1 + newlist = (newnode, lexeme, 0, (posx ip, posy ip, dir ip)) `prepend` update list (path ip) newnode + prepend newx (x:xs) = (newx:x):xs + isjunction (Junction _) = True + isjunction _ = False + final = fst $ nodes code ([]:temp) trueip + temp = fst $ nodes code ([]:newlist) falseip + (falseip, trueip) = junctionturns code ip + + + -- |Shift a node by the given amount. May be positive or negative. + -- This is used by 'toGraph' and 'fromGraph' to shift all nodes by 1 or -1, respectively, + -- which is done because the portable text representation of the graph does not include + -- a leading "Start" node with ID 1 -- instead, the node with ID 1 is the first "real" + -- graph node. In other words, when exporting to the text representation, the "Start" + -- node is removed and all other nodes are "shifted" by -1 using this function. When + -- importing, a "Start" node is added and all nodes are shifted by 1. + offset :: Int -- ^Amount to shift node by. + -> IDT.LexNode -- ^Node to operate on. + -> IDT.LexNode -- ^Shifted node. + offset c (node, lexeme, 0) = (node + c, lexeme, 0) + offset c (node, lexeme, following) = (node + c, lexeme, following + c) + + -- |Change the following node of the first (i. e. "last", since the list is reversed) + -- node in the graph. + update :: [[PreLexNode]] -- ^The graph to operate on. + -> RelDirection -- ^Turn taken on last Junctions + -> Int -- ^ID of new follower to set for the first node in the list. + -> [[PreLexNode]] -- ^Resulting graph. + update list@(x:xs) dir following + | null x && startsjunction xs && dir == Lexer.Left = helpera list following + | null x && not (null xs) && startsjunction (tail xs) && dir == Lexer.Right = x:head xs:helper (head (tail xs)) following:tail (tail xs) + | null x = list + | otherwise = helper x following:xs + where + helper ((node, lexeme, _, location):xs) following = (node, lexeme, following, location):xs + helpera (x:(((node, _, following, location):xs):xss)) attribute = x:(((node, Junction attribute, following, location):xs):xss) + startsjunction (((_, Junction _, _, _):_):_) = True + startsjunction _ = False + + -- merges splitted graphs (e.g. Junction) + -- x3 is the graph until the special node appeared + -- x2 is the graph that will result in the special attribute + -- x1 is the graph that will become the follower + merge :: [[PreLexNode]] -> [[PreLexNode]] + merge (x1:x2:x3:xs) = (x1 ++ x2 ++ x3):xs + + -- |Move the instruction pointer a single step. + step :: IDT.Grid2D -- ^Current function in its line representation. + -> IP -- ^Current instruction pointer. + -> IP -- ^New instruction pointer. + step code ip + | forward `elem` fval = move ip Forward + | left `elem` lval && right `elem` rval = crash + | left `elem` lval = move ip Lexer.Left + | right `elem` rval = move ip Lexer.Right + | otherwise = crash + where + (left, forward, right) = adjacent code ip + (lval, fval, rval) = valids code ip + + -- |Collect characters until a condition is met while moving in the current direction. + stepwhile :: IDT.Grid2D -- ^Line representation of current function. + -> IP -- ^Current instruction pointer. + -> (Char -> Bool) -- ^Function: Should return True if collection should stop. + -- Gets the current Char as an argument. + -> (String, IP) -- ^Collected characters and the new instruction pointer. + stepwhile code ip fn + | not (fn curchar) = ("", ip) + | not (moveable code ip Forward) = error EH.strMissingClosingBracket + | otherwise = (curchar:resstring, resip) + where + curchar = current code ip + (resstring, resip) = stepwhile code (move ip Forward) fn + + -- |Checks if the instruction pointer can be moved without leaving the grid + moveable :: IDT.Grid2D -- ^Line representation of current function + -> IP -- ^Current instruction pointer + -> RelDirection -- ^Where to move to + -> Bool -- ^Whether or not the move could be made + moveable code ip reldir + | null code = False + | newy < 0 || newy >= length code = False + | dir ip `elem` [W, E] && (newx < 0 || newx >= length line) = False + | otherwise = True + where + (newy, newx) = posdir ip reldir + line = code!!newy + + -- |Read a string constant and handle escape sequences like \n. + -- Raises an error on invalid escape sequences and badly formatted constants. + readconstant :: IDT.Grid2D -- ^Current function in line representation + -> IP -- ^Current instruction pointer + -> Char -- ^Opening string delimiter, e. g. '[' + -> Char -- ^Closing string delimiter, e. g. ']' + -> (String, IP) -- ^The processed constant and the new instruction pointer + readconstant code ip startchar endchar + | curchar == startchar = error EH.strNestedOpenBracket + | curchar == endchar = ("", ip) + | not (moveable code ip Forward) = error EH.strMissingClosingBracket + | otherwise = (newchar:resstring, resip) + where + curchar = current code ip + (newchar, newip) = processescape + (resstring, resip) = readconstant code newip startchar endchar + + -- This does the actual work and converts the escape sequence + -- (if there is no escape sequence at the current position, do + -- nothing and pass the current Char through). + processescape :: (Char, IP) + processescape + | curchar /= '\\' = (curchar, move ip Forward) + | esctrail /= '\\' = error EH.strNonSymmetricEscape + | otherwise = case escsym of + '\\' -> ('\\', escip) + '[' -> ('[', escip) + ']' -> (']', escip) + 'n' -> ('\n', escip) + 't' -> ('\t', escip) + _ -> error $ printf EH.strUnhandledEscape escsym + where + [escsym, esctrail] = lookahead code ip 2 + -- Points to the character after the trailing backslash + escip = skip code ip 3 + + -- |Lookahead n characters in the current direction. + lookahead :: IDT.Grid2D -- ^Line representation of current function + -> IP -- ^Current instruction pointer + -> Int -- ^How many characters of lookahead to produce? + -> String -- ^n characters of lookahead + lookahead code ip 0 = [] + lookahead code ip n = current code newip : lookahead code newip (n-1) + where + newip = move ip Forward + + -- |Skip n characters in the current direction and return the new IP. + skip :: IDT.Grid2D -- ^Line representation of current function + -> IP -- ^Current instruction pointer + -> Int -- ^How many characters to skip? If 1, this is the same + -- as doing "move ip Forward". + -> IP -- ^New instruction pointer + skip code ip n = foldl (\x _ -> move x Forward) ip [1..n] + + -- |Move the instruction pointer in a relative direction. + move :: IP -- ^Current instruction pointer. + -> RelDirection -- ^Relative direction to move in. + -> IP -- ^New instruction pointer. + move ip reldir = ip{count = newcount, posx = newx, posy = newy, dir = absolute ip reldir} + where + (newy, newx) = posdir ip reldir + newcount = count ip + 1 + + -- |Get the 'Char' at the current position of the instruction pointer. + current :: IDT.Grid2D -- ^Line representation of the current function. + -> IP -- ^Current instruction pointer. + -> Char -- ^'Char' at the current IP position. + current code ip = charat code (posy ip, posx ip) + + -- |Get the 'Char' at the next position of the instruction pointer + next :: IDT.Grid2D -> IP -> Char + next code ip = current code $ move ip Forward + + -- |Get adjacent (left secondary, primary, right secondary) + -- symbols for the current IP position. + adjacent :: IDT.Grid2D -- ^Line representation of the current function. + -> IP -- ^Current instruction pointer. + -> (Char, Char, Char) -- ^Adjacent (left secondary, primary, right secondary) symbols + adjacent code ip + | current code ip `elem` turnblocked = (' ', charat code (posdir ip Forward), ' ') + | otherwise = (charat code (posdir ip Lexer.Left), charat code (posdir ip Forward), charat code (posdir ip Lexer.Right)) + + -- returns instruction pointers turned for (False, True) + junctionturns :: IDT.Grid2D -> IP -> (IP, IP) + junctionturns code ip = tuplecheck $ tuplemove $ addpath $ turning (current code ip) ip + where + tuplecheck (ipl, ipr) = (if current code ipl == primary ipl then ipl else crash, if current code ipr == primary ipr then ipr else crash) + tuplemove (ipl, ipr) = (move ipl Forward, move ipr Forward) + addpath (ipl, ipr) = (ipl{path = Lexer.Left}, ipr{path = Lexer.Right}) + turning char ip + | char == '<' = case dir ip of + E -> (ip{dir = NE}, ip{dir = SE}) + SW -> (ip{dir = SE}, ip{dir = W}) + NW -> (ip{dir = W}, ip{dir = NE}) + _ -> (crash, crash) + | char == '>' = case dir ip of + W -> (ip{dir = SW}, ip{dir = NW}) + SE -> (ip{dir = E}, ip{dir = SW}) + NE -> (ip{dir = NW}, ip{dir = E}) + _ -> (crash, crash) + | char == '^' = case dir ip of + S -> (ip{dir = SE}, ip{dir = SW}) + NE -> (ip{dir = N}, ip{dir = SE}) + NW -> (ip{dir = SW}, ip{dir = N}) + _ -> (crash, crash) + | char == 'v' = case dir ip of + N -> (ip{dir = NW}, ip{dir = NE}) + SE -> (ip{dir = NE}, ip{dir = S}) + SW -> (ip{dir = S}, ip{dir = NW}) + _ -> (crash, crash) + | otherwise = (ip, ip) + + -- returns insturction pointers turned for (Lambda, Reflected) + lambdadirs :: IP -> (IP, IP) + lambdadirs ip = (ip, turnaround ip) + + -- make a 180° turn on instruction pointer + turnaround :: IP -> IP + turnaround ip = ip{dir = absolute ip{dir = absolute ip{dir = absolute ip{dir = absolute ip Lexer.Left} Lexer.Left} Lexer.Left} Lexer.Left} + + -- |Returns 'Char' at given position, @\' \'@ if position is invalid. + charat :: IDT.Grid2D -- ^Line representation of current function. + -> (Int, Int) -- ^Position as (x, y) coordinate. + -> Char -- ^'Char' at given position. + charat code _ | null code = ' ' + charat code (y, _) | y < 0 || y >= length code = ' ' + charat code (y, x) + | x < 0 || x >= length line = ' ' + | otherwise = line!!x + where + line = code!!y + + -- |Get the position of a specific heading. + posdir :: IP -- ^Current instruction pointer. + -> RelDirection -- ^Current relative direction. + -> (Int, Int) -- ^New position that results from the given relative movement. + posdir ip reldir = posabsdir ip (absolute ip reldir) + + -- |Get the position of an absolute direction. + posabsdir :: IP -- ^Current instruction pointer. + -> Direction -- ^Current absolute direction. + -> (Int, Int) -- ^New position that results from the given absolute movement. + posabsdir ip N = (posy ip - 1, posx ip) + posabsdir ip NE = (posy ip - 1, posx ip + 1) + posabsdir ip E = (posy ip, posx ip + 1) + posabsdir ip SE = (posy ip + 1, posx ip + 1) + posabsdir ip S = (posy ip + 1, posx ip) + posabsdir ip SW = (posy ip + 1, posx ip - 1) + posabsdir ip W = (posy ip, posx ip - 1) + posabsdir ip NW = (posy ip - 1, posx ip - 1) + + -- |Convert a relative direction into a relative one. + absolute :: IP -- ^Current instruction pointer. + -> RelDirection -- ^Relative direction to convert. + -> Direction -- ^Equivalent absolute direction. + absolute x Forward = dir x + absolute (IP {dir=N}) Lexer.Left = NW + absolute (IP {dir=N}) Lexer.Right = NE + absolute (IP {dir=NE}) Lexer.Left = N + absolute (IP {dir=NE}) Lexer.Right = E + absolute (IP {dir=E}) Lexer.Left = NE + absolute (IP {dir=E}) Lexer.Right = SE + absolute (IP {dir=SE}) Lexer.Left = E + absolute (IP {dir=SE}) Lexer.Right = S + absolute (IP {dir=S}) Lexer.Left = SE + absolute (IP {dir=S}) Lexer.Right = SW + absolute (IP {dir=SW}) Lexer.Left = S + absolute (IP {dir=SW}) Lexer.Right = W + absolute (IP {dir=W}) Lexer.Left = SW + absolute (IP {dir=W}) Lexer.Right = NW + absolute (IP {dir=NW}) Lexer.Left = W + absolute (IP {dir=NW}) Lexer.Right = N + + -- |Get the next lexeme at the current position. + parse :: IDT.Grid2D -- ^Line representation of current function. + -> IP -- ^Current instruction pointer. + -> (Maybe IDT.Lexeme, IP) -- ^Resulting lexeme (if any) and + -- the new instruction pointer. + parse code ip = junctioncheck $ case current code ip of + 'b' -> (Just Boom, ip) + 'e' -> (Just EOF, ip) + 'i' -> (Just Input, ip) + 'o' -> (Just Output, ip) + 'u' -> (Just Underflow, ip) + '?' -> (Just RType, ip) + 'a' -> (Just Add1, ip) + 'd' -> (Just Divide, ip) + 'm' -> (Just Multiply, ip) + 'r' -> (Just Remainder, ip) + 's' -> (Just Subtract, ip) + '0' -> (Just (Constant "0"), ip) + '1' -> (Just (Constant "1"), ip) + '2' -> (Just (Constant "2"), ip) + '3' -> (Just (Constant "3"), ip) + '4' -> (Just (Constant "4"), ip) + '5' -> (Just (Constant "5"), ip) + '6' -> (Just (Constant "6"), ip) + '7' -> (Just (Constant "7"), ip) + '8' -> (Just (Constant "8"), ip) + '9' -> (Just (Constant "9"), ip) + 'c' -> (Just Cut, ip) + 'p' -> (Just Append, ip) + 'z' -> (Just Size, ip) + 'n' -> (Just Nil, ip) + ':' -> (Just Cons, ip) + '~' -> (Just Breakup, ip) + 'f' -> (Just (Constant "0"), ip) + 't' -> (Just (Constant "1"), ip) + 'g' -> (Just Greater, ip) + 'q' -> (Just Equal, ip) + '$' -> (Just Start, ip) + '#' -> (Just Finish, ip) + '.' -> (Just NOP, ip) + 'v' -> (Just (Junction 0), ip) + '^' -> (Just (Junction 0), ip) + '>' -> (Just (Junction 0), ip) + '<' -> (Just (Junction 0), ip) + '[' -> let (string, newip) = readconstant code tempip '[' ']' in (Just (Constant string), newip) + ']' -> let (string, newip) = readconstant code tempip ']' '[' in (Just (Constant string), newip) + '{' -> let (string, newip) = stepwhile code tempip (/= '}') in (Just (Call string), newip) + '}' -> let (string, newip) = stepwhile code tempip (/= '{') in (Just (Call string), newip) + '(' -> let (string, newip) = stepwhile code tempip (/= ')') in (pushpop string, newip) + ')' -> let (string, newip) = stepwhile code tempip (/= '(') in (pushpop string, newip) + _ -> (Nothing, turn (current code ip) ip) + where + junctioncheck (Nothing, ip) + | current code ip `elem` "+x*" && next code ip `elem` "v^<>" = (Nothing, crash) + | forward == ' ' && (left == current code ip || right == current code ip) = (Nothing, crash) + | forward == ' ' && (left `elem` "v^<>+x*" || right `elem` "v^<>+x*") = (Nothing, crash) + | otherwise = (Nothing, ip) + where + (left, forward, right) = adjacent code ip + junctioncheck (lexeme, ip) + | next code ip `elem` "v^<>" = (lexeme, crash) + | otherwise = (lexeme, ip) + turn '@' ip = turnaround ip + turn '|' ip + | dir ip `elem` [NW, N, NE] = ip{dir = N} + | dir ip `elem` [SW, S, SE] = ip{dir = S} + turn '/' ip + | dir ip `elem` [N, NE, E] = ip{dir = NE} + | dir ip `elem` [S, SW, W] = ip{dir = SW} + turn '-' ip + | dir ip `elem` [NE, E, SE] = ip{dir = E} + | dir ip `elem` [SW, S, NW] = ip{dir = W} + turn '\\' ip + | dir ip `elem` [W, NW, N] = ip{dir = NW} + | dir ip `elem` [E, SE, S] = ip{dir = SE} + turn _ ip = ip + tempip = move ip Forward + pushpop string + | string == "" = Just (Push string) + | head string == '!' && last string == '!' = Just (Pop (tail $ init string)) + | otherwise = Just (Push string) + + -- |Get ID of the node that has been already visited using the current IP + -- (direction and coordinates). + visited :: [[PreLexNode]] -- ^List of nodes to check. + -> IP -- ^Instruction pointer to use. + -> Int -- ^ID of visited node or 0 if none. + visited [] _ = 0 + visited (x:xs) ip = let res = helper x ip in if res > 0 then res else visited xs ip + where + helper [] _ = 0 + helper ((id, _, _, (x, y, d)):xs) ip + | x == posx ip && y == posy ip && d == dir ip = id + | otherwise = helper xs ip + + -- |Convert a list of 'PreLexNode's into a list of 'IDT.LexNode's. + finalize :: [PreLexNode] -- ^'PreLexNode's to convert. + -> [IDT.LexNode] -- ^Accumulator. Initialize with @[]@. + -> [IDT.LexNode] -- ^Resulting list of 'IDT.PreLexNode's. + finalize [] result = result + finalize ((node, lexeme, following, _):xs) result = finalize xs ((node, lexeme, following):result) + + -- |Initial value for the instruction pointer at the start of a function. + start :: IP + start = IP 0 0 0 SE Forward + + -- |An instruction pointer representing a "crash" (fatal error). + crash :: IP + crash = IP 0 (-1) (-1) NW Forward + + -- what is the primary rail for the given direction? + -- mainly used to check if junctions turn away correctly + primary :: IP -> Char + primary ip + | dir ip `elem` [N, S] = '|' + | dir ip `elem` [E, W] = '-' + | dir ip `elem` [NE, SW] = '/' + | dir ip `elem` [NW, SE] = '\\' + + -- |Return valid chars for movement depending on the current direction. + valids :: IDT.Grid2D -- ^Line representation of current function. + -> IP -- ^Current instruction pointer. + -> (String, String, String) -- ^Tuple consisting of: + -- + -- * Valid characters for movement to the (relative) left. + -- * Valid characters for movement in the (relative) forward direction. + -- * Valid characters for movement to the (relative) right. + valids code ip = tripleinvert (commandchars ++ dirinvalid ip ++ finvalid ip{dir = absolute ip Lexer.Left}, finvalid ip, commandchars ++ dirinvalid ip ++ finvalid ip{dir = absolute ip Lexer.Right}) + where + tripleinvert (l, f, r) = (filter (`notElem` l) everything, filter (`notElem` f) everything, filter (`notElem` r) everything) + finvalid ip = dirinvalid ip ++ crossinvalid ip -- illegal to move forward + dirinvalid ip -- illegal without crosses + | dir ip `elem` [E, W] = "|" + | dir ip `elem` [NE, SW] = "\\" + | dir ip `elem` [N, S] = "-" + | dir ip `elem` [NW, SE] = "/" + | otherwise = "" + crossinvalid ip -- illegal crosses + | dir ip `elem` [N, E, S, W] = "x" + | otherwise = "+" + cur = current code ip + everything = "+\\/x|-" ++ always + always = "^v<>*@{}[]()" ++ commandchars + + -- list of chars that are commands in rail + commandchars :: String + commandchars = "abcdefgimnopqrstuz:~0123456789?#" + + -- list of chars which do not allow any turning + turnblocked :: String + turnblocked = "$*+x" ++ commandchars + + -- |Convert a graph/AST into a portable text representation. + -- See also 'fromGraph'. + fromAST :: IDT.Lexer2SynAna -- ^Input graph/AST/forest. + -> String -- ^Portable text representation of the AST: + -- + -- Each function is represented by its own section. A section has a header + -- and content; it continues either until the next section, a blank line or + -- the end of the file, whichever comes first. + -- + -- A section header consists of a single line containing the name of the function, + -- enclosed in square brackets, e. g. @[function_name]@. There cannot be any whitespace + -- before the opening bracket. + -- + -- The section content consists of zero or more non-blank lines containing exactly + -- three records delimited by a semicolon @;@. Each line describes a node and contains + -- the following records, in this order: + -- + -- * The node ID (numeric), e. g. @1@. + -- * The Rail lexeme, e. g. @o@ or @[constant]@ etc. Note that track lexemes like + -- @-@ or @+@ are not included in the graph. Multi-character lexemes like constants + -- may include semicolons, so you need to parse them correctly! In other words, you need + -- to take care of lines like @1;[some ; constant];2@. + -- * Node ID of the follower node, e. g. @2@. May be @0@ if there is no next node. + fromAST (IDT.ILS graph) = unlines $ map fromGraph graph + + -- |Convert a portable text representation of a graph into a concrete graph representation. + -- See also 'toGraph'. See 'fromAST' for a specification of the portable text representation. + toAST :: String -- ^Portable text representation. See 'fromAST'. + -> IDT.Lexer2SynAna -- ^Output graph. + toAST input = IDT.ILS (map toGraph $ splitfunctions input) + + -- |Convert an 'IDT.Graph' for a single function to a portable text representation. + -- See 'fromAST' for a specification of the representation. + -- + -- TODO: Currently, this apparently crashes the program on invalid input. More sensible error handling? + -- At least a nice error message would be nice. + fromGraph :: IDT.Graph -- ^Input graph. + -> String -- ^Text representation. + fromGraph (funcname, nodes) = unlines $ ("["++funcname++"]"):tail (map (fromLexNode . offset (-1)) nodes) + where + fromLexNode :: IDT.LexNode -> String + fromLexNode (id, lexeme, follower) = show id ++ ";" ++ fromLexeme lexeme ++ ";" ++ show follower ++ optional lexeme + fromLexeme :: IDT.Lexeme -> String + fromLexeme Boom = "b" + fromLexeme EOF = "e" + fromLexeme Input = "i" + fromLexeme Output = "o" + fromLexeme Underflow = "u" + fromLexeme RType = "?" + fromLexeme (Constant string) = "["++string++"]" + fromLexeme (Push string) = "("++string++")" + fromLexeme (Pop string) = "(!"++string++"!)" + fromLexeme (Call string) = "{"++string++"}" + fromLexeme Add1 = "a" + fromLexeme Divide = "d" + fromLexeme Multiply = "m" + fromLexeme Remainder = "r" + fromLexeme Subtract = "s" + fromLexeme Cut = "c" + fromLexeme Append = "p" + fromLexeme Size = "z" + fromLexeme Nil = "n" + fromLexeme Cons = ":" + fromLexeme Breakup = "~" + fromLexeme Greater = "g" + fromLexeme Equal = "q" + fromLexeme Start = "$" + fromLexeme Finish = "#" + fromLexeme (Junction _) = "v" + fromLexeme NOP = "." + optional (Junction follow) = ';' : show follow + optional _ = ";0" + + -- |Split a portable text representation of multiple function graphs (a forest) into separate + -- text representations of each function graph. + splitfunctions :: String -- ^Portable text representation of the forest. + -> [[String]] -- ^List of lists, each being a list of lines making up a separate function graph. + splitfunctions = groupBy (\_ y -> null y || head y /= '[') . filter (not . null) . lines + + -- |Convert a portable text representation of a single function into an 'IDT.Graph'. + -- Raises 'error's on invalid input (see 'ErrorHandling'). + toGraph :: [String] -- ^List of lines making up the text representation of the function. + -> IDT.Graph -- ^Graph describing the function. + toGraph lns = (init $ tail $ head lns, (1, Start, 2):map (offset 1) (nodes $ tail lns)) + where + nodes [] = [] + nodes (ln:lns) = (read id, fixedlex, read follower):nodes lns + where + (id, other) = span (/=';') ln + (lex, ip) = parse [other] $ IP 0 1 0 E Forward + (follower, attribute) = span (/=';') (drop (2 + posx ip) other) + fixedlex + | isJunction lex = Junction (read $ tail attribute) + | otherwise = fromJust lex + fromJust Nothing = error $ printf EH.shrLineNoLexeme ln + fromJust (Just x) = x + isJunction (Just (Junction _)) = True + isJunction _ = False + +-- vim:ts=2 sw=2 et diff --git a/src/RailCompiler/Main.hs b/src/RailCompiler/Main.hs new file mode 100644 --- /dev/null +++ b/src/RailCompiler/Main.hs @@ -0,0 +1,117 @@ +{- | +Module : Main.hs +Description : . +Maintainer : (c) Christopher Pockrandt, Nicolas Lehmann, Tobias Kranz +License : MIT + +Stability : stable + +Entrypoint of the rail2llvm-compiler. Contains main-function. + +See also: +--https://www.haskell.org/ghc/docs/7.8.2/html/libraries/base-4.7.0.0/System-Console-GetOpt.html +--http://leiffrenzel.de/papers/commandline-options-in-haskell.html (Outdated!) + +-} +module Main( main ) where + +-- imports -- +import System.Environment +import System.Exit +import System.Console.GetOpt +import Data.Maybe( fromMaybe ) +import InterfaceDT as IDT +import qualified Preprocessor as PreProc +import qualified Lexer +import qualified SyntacticalAnalysis as SynAna +import qualified SemanticalAnalysis as SemAna +import qualified IntermediateCode as InterCode +import qualified CodeOptimization as CodeOpt +import qualified Backend + +-- defining the option settings for the main-function +data Options = Options { + optInput :: IO String, + optOutput :: String -> IO (), + optASTOutput :: String -> IO (), + compile :: Bool, + impAST :: Bool, + expAST :: Bool + } + +-- default Options +defaultOptions :: Options +defaultOptions = Options { + optInput = getContents, + optOutput = putStr, + optASTOutput = putStr, + compile = False, + impAST = False, + expAST = False + + } + +-- usageInfo +options :: [OptDescr (Options -> IO Options)] +options = [ + --Option ['V'] ["version"] (NoArg showVersion) "show version number", + Option "h" ["help" ] (NoArg showHelp ) "display Help Text", + Option "i" ["input" ] (ReqArg setInput "FILE" ) "input file (don't set to use stdin')", + Option "o" ["output" ] (ReqArg setOutput "FILE" ) "output file (don't set to use stdout')", + Option "c" ["compile" ] (NoArg setCompile ) "compile 'rail' to 'llvm'", + Option [ ] ["exportAST"] (OptArg setExpAST "FILE" ) "export frontend AST (don't offer a File to use stdout) \n(dont set with --importAST)", + Option [ ] ["importAST"] (NoArg setImpAST ) "import frontend AST and compile to llvm\nautosets -c \n(set input via -i; (dont set with --exportAST)\n\nset -c with --exportAST and get both: the AST and the llvm code" + ] + +-- output for the help-function +showHelp _ = do + putStrLn "rail2llvm--haskell-compiler (development version)" + putStr "https://github.com/SWP-Ubau-SoSe2014-Haskell/SWPSoSe14\n\n" + putStr $ usageInfo "Usage: main [OPTION...]" options + exitSuccess + +-- options-getter for optional output for exprotAST +getOut (Just arg) = writeFile arg +getOut Nothing = putStr + +-- options-setters +setInput arg opt = return opt { optInput = readFile arg } +setOutput arg opt = return opt { optOutput = writeFile arg } +setExpAST arg opt = return opt { optASTOutput = getOut arg, expAST = True} +setImpAST opt = return opt { impAST = True, compile = True } +setCompile opt = return opt { compile = True } + +-- main-function -- +main = do args <- getArgs + let (actions,nonOpts,msgs) = getOpt RequireOrder options args + -- intercept errors + if msgs /= [] + then error $ concat msgs ++ usageInfo "Usage: main [OPTION...]" options + -- unrecognized arguments error + else if nonOpts /= [] + then error $ "unrecognized arguments: " ++ unwords nonOpts ++ "\nUsage: For basic information, try the `--help' option." + else do opts <- foldl (>>=) (return defaultOptions) actions + -- option aliases + let Options { optInput = input, optOutput = output, optASTOutput = outputAST, compile = cmpl, impAST = imp, expAST = exp} = opts + inputWithoutIO <- input + -- importAST and exportAST can't be set together (error) + if imp && exp + then do error "No export of the imported AST (Usage: For basic information, try the `--help' option.)'" + exitSuccess + -- compile a file + else if cmpl + then do let transform (IBO x) = x + -- compile an imported AST to a LLVM-file + if imp + then transform (Backend.process . CodeOpt.process . InterCode.process . SemAna.process . SynAna.process . Lexer.toAST $ inputWithoutIO) >>= output + -- compile a RAIL-file to an AST as an export-file + else if exp + then do outputAST (Lexer.fromAST . Lexer.process . PreProc.process $ IIP inputWithoutIO) + transform (Backend.process . CodeOpt.process . InterCode.process . SemAna.process . SynAna.process . Lexer.process . PreProc.process $ IIP inputWithoutIO) >>= output + -- compile a RAIL-file to a LLVM-file + else transform (Backend.process . CodeOpt.process . InterCode.process . SemAna.process . SynAna.process . Lexer.process . PreProc.process $ IIP inputWithoutIO) >>= output + -- exportAST (without compiling it to llvm) + else if exp + then outputAST (Lexer.fromAST . Lexer.process . PreProc.process $ IIP inputWithoutIO) + -- missing argument error + else error "Error. Set atleast -c or --importAST or --exportAST." diff --git a/src/RailCompiler/Preprocessor.hs b/src/RailCompiler/Preprocessor.hs new file mode 100644 --- /dev/null +++ b/src/RailCompiler/Preprocessor.hs @@ -0,0 +1,46 @@ +{- | +Module : Preprocessor.hs +Description : . +Maintainer : (c) Christopher Pockrandt, Nicolas Lehmann +License : MIT + +Stability : stable + +Preprocessor gets the content of the input file and puts each rail function +into a list of strings such that the first character of the first line is a +dollar sign. Leading lines without a dollar sign in the input file are removed. +-} + +module Preprocessor ( + process -- main function of the module "Preprocessor" + ) + where + + -- imports -- + import InterfaceDT as IDT + import ErrorHandling as EH + import Data.List + + -- functions -- + process :: IDT.Input2PreProc -> IDT.PreProc2Lexer + process (IDT.IIP input) = IDT.IPL output + where + output = (groupFunctionsToGrid2Ds . removeLines . lines) input + + -- |Return False iff the first character is a dollar sign. + notStartingWithDollar :: String -> Bool + notStartingWithDollar x = null x || head x /= '$' + + -- |Removes all leading strings from list until first string begins with a + -- dollar sign. + removeLines :: Grid2D -> Grid2D + removeLines grid + | null result = error noStartSymbolFound + | otherwise = result + where + result = dropWhile notStartingWithDollar grid + + -- |Puts every rail function/program into its on grid such that the dollar + -- sign is the first character in the first line. + groupFunctionsToGrid2Ds :: Grid2D -> [Grid2D] + groupFunctionsToGrid2Ds = groupBy (\_ y -> notStartingWithDollar y) diff --git a/src/RailCompiler/SemanticalAnalysis.hs b/src/RailCompiler/SemanticalAnalysis.hs new file mode 100644 --- /dev/null +++ b/src/RailCompiler/SemanticalAnalysis.hs @@ -0,0 +1,49 @@ +{- | +Module : SemanticalAnalysis.hs +Description : . +Maintainer : Christopher Pockrandt +License : MIT + +There is no need for a semantical analysis at this time, therefore the function +`process` equals the identity function + +-} +module SemanticalAnalysis ( + process -- main function of the module "SemanticalAnalysis" + ) + where + + -- imports -- + import InterfaceDT as IDT + import ErrorHandling as EH + + -- functions -- + process :: IDT.SynAna2SemAna -> IDT.SemAna2InterCode + process (IDT.ISS input) + | nomain input = error EH.strMainMissing + | otherwise = IDT.ISI (map check input) + + -- looking for a main function + nomain :: [IDT.AST] -> Bool + nomain [] = True + nomain ((name, _):xs) + | name == "main" = False + | otherwise = nomain xs + + -- this will return the exact same input if it's valid and will error otherwise + check :: IDT.AST -> IDT.AST + check (name, nodes) = (name, map checknode nodes) + + -- this will return the exact same input if it's valid and will error otherwise + checknode :: (Int, [Lexeme], Int) -> (Int, [Lexeme], Int) + checknode (id, lexeme, following) + | following == 0 && not (last lexeme `elem` [Finish, Boom] || isvalidjunction (last lexeme)) = error EH.strInvalidMovement + | otherwise = (id, map checklexeme lexeme, following) + where + isvalidjunction (Junction x) = x /= 0 + isvalidjunction _ = False + + -- this will return the exact same input if it's valid and will error otherwise + checklexeme :: Lexeme -> Lexeme + checklexeme (Junction 0) = error EH.strInvalidMovement + checklexeme lexeme = lexeme diff --git a/src/RailCompiler/SyntacticalAnalysis.hs b/src/RailCompiler/SyntacticalAnalysis.hs new file mode 100644 --- /dev/null +++ b/src/RailCompiler/SyntacticalAnalysis.hs @@ -0,0 +1,69 @@ +{- | +Module : SyntacticalAnalysis.hs +Description : . +Copyright : (c) Kristin Knorr, Marcus Hoffmann +License : MIT + +Stability : stable + +SyntacticalAnalysis receives output of Lexer and turns each rail function graph +into a list of paths. Each path is a triple and contains a Path-ID, a list of +lexemes and a Path-ID of the path that follows. Those lexemes are executed in +order and sequentially. +-} +module SyntacticalAnalysis ( + process -- main function of the module "SyntacticalAnalysis" + ) + where + -- imports -- + import InterfaceDT as IDT + import ErrorHandling as EH + + -- functions -- + process :: IDT.Lexer2SynAna -> IDT.SynAna2SemAna + process (IDT.ILS input) = IDT.ISS output + where + output = map (\(x, y)->(x, pathes y (startNodes y))) input + + -- |generates all pathes of a graph + pathes :: [IDT.LexNode] -> [Int] -> [(Int, [Lexeme], Int)] + pathes xs ys = map (\x-> findPath x xs ys) ys + + -- |generates one path depending on initial node + findPath :: Int -> [IDT.LexNode] -> [Int] -> (Int, [Lexeme], Int) + findPath x xs ys = genPath x (generate x xs) + where + genPath :: Int -> [(Lexeme, Int)] -> (Int, [Lexeme], Int) + genPath pathID leFoList = (pathID, map fst leFoList, (snd.last) leFoList) + generate :: Int -> [IDT.LexNode] -> [(Lexeme, Int)] + generate v = genElem . head . filter (\y -> fst' y == v) + genElem :: IDT.LexNode -> [(Lexeme, Int)] + genElem (nodeID, lex, fol) + |elem fol ys || fol==0 = [(lex, fol)] + |otherwise = (lex, fol) : generate fol xs + + -- |generates a list of all nodes, which are needed to be initial nodes of path: + -- 1 as functionstart; conditional jmp; indegree > 1 + startNodes :: [IDT.LexNode] -> [Int] + startNodes [] = [] + startNodes xs = 1:[x | x <- [2..(length xs)], isJunct0 x xs || (inDeg x xs > 1) || isJunct1 x xs] + where + isJunct0 :: Int -> [IDT.LexNode] -> Bool + isJunct0 x = any (\y -> Junction x == snd' y) + isJunct1 :: Int -> [IDT.LexNode] -> Bool + isJunct1 x = any (\y -> isJunct (snd' y) && x == trd' y) + isJunct :: Lexeme -> Bool + isJunct (Junction x) = True + isJunct _ = False + inDeg :: Int -> [IDT.LexNode] -> Int + inDeg x = length . filter (\y-> trd' y==x) + + -- |fetch triple components + fst' :: (a, b, c) -> a + fst' (x, _, _) = x + + snd' :: (a, b, c) -> b + snd' (_, x, _) = x + + trd' :: (a, b, c) -> c + trd' (_, _, x) = x diff --git a/src/RailCompiler/stack.ll b/src/RailCompiler/stack.ll new file mode 100644 --- /dev/null +++ b/src/RailCompiler/stack.ll @@ -0,0 +1,1398 @@ +@stack = global [1000 x i8*] undef ; stack containing pointers to i8 +@sp = global i64 0 ; global stack pointer (or rather: current number of elements) +@lookahead = global i32 -1 ; current lookahead for input from stdin. + ; -1 means no lookahead done yet. + + +; Constants +@to_str = private unnamed_addr constant [3 x i8] c"%i\00" +@true = global [2 x i8] c"1\00" +@false = global [2 x i8] c"0\00" +@printf_str_fmt = private unnamed_addr constant [3 x i8] c"%s\00" +@crash_cust_str_fmt = private unnamed_addr constant [24 x i8] c"Crash: Custom error: %s\00" +@err_stack_underflow = private unnamed_addr constant [18 x i8] c"Stack underflow!\0A\00" +@err_eof = private unnamed_addr constant [9 x i8] c"At EOF!\0A\00" +@err_type = private unnamed_addr constant [14 x i8] c"Invalid type!\00" +@err_zero = private unnamed_addr constant [18 x i8] c"Division by zero!\00" + + +; External declarations +%FILE = type opaque + +@stderr = external global %FILE* + +declare signext i32 @atol(i8*) +declare i64 @strtol(i8*, i8**, i32 ) +declare signext i32 @snprintf(i8*, ...) +declare signext i32 @printf(i8*, ...) +declare signext i32 @fprintf(%FILE*, i8*, ...) +declare float @strtof(i8*, i8**) +declare signext i32 @getchar() +declare i8* @malloc(i16 zeroext) ; void *malloc(size_t) and size_t is 16 bits long (SIZE_MAX) +declare i8* @calloc(i16 zeroext, i16 zeroext) +declare void @exit(i32 signext) + + +; Debugging stuff +@pushing = private unnamed_addr constant [14 x i8] c"Pushing [%s]\0A\00" +@popped = private unnamed_addr constant [13 x i8] c"Popped [%s]\0a\00" +@msg = private unnamed_addr constant [5 x i8] c"msg\0a\00" + + +@int_to_str = private unnamed_addr constant [3 x i8] c"%i\00" +@float_to_str = private unnamed_addr constant [3 x i8] c"%f\00" + +;typedef enum {INT = 1, FLOAT = 2, STRING = 3} elem_type; +;struct stack_elem { +; elem_type type; +; union { +; int ival; +; float fval; +; char *sval; +; }; +;}; +%struct.stack_elem = type { i32, %union.anon } +%union.anon = type { i8* } + + +@.str = private unnamed_addr constant [33 x i8] c"call int add with a=%i and b=%i\0A\00", align 1 +@.str1 = private unnamed_addr constant [35 x i8] c"call float add with a=%f and b=%f\0A\00", align 1 +@.str2 = private unnamed_addr constant [15 x i8] c"failed to add\0A\00", align 1 + + + +; Function definitions + +; Get number of element on the stack +define i64 @stack_get_size() { + %sp = load i64* @sp + ret i64 %sp +} + +; Push the stack size onto the stack +define void @underflow_check() { + %stack_size = call i64 @stack_get_size() + call void @push_int(i64 %stack_size) + ret void +} + +; Exit the program if stack is empty (prints error to stderr). +define void @underflow_assert() { + %stack_size = call i64 @stack_get_size() + %stack_empty = icmp eq i64 %stack_size, 0 + br i1 %stack_empty, label %uas_crash, label %uas_okay + +uas_crash: + %err = getelementptr [18 x i8]* @err_stack_underflow, i8 0, i8 0 + %stderr = load %FILE** @stderr + call i32(%FILE*, i8*, ...)* @fprintf(%FILE* %stderr, i8* %err) + call void @exit(i32 1) + + ret void + +uas_okay: + ret void +} + +; Pop stack and print result string +define void @print() { + ; TODO: Check if the top stack element is a string and crash if it is not. + call void @underflow_assert() + + %fmt = getelementptr [3 x i8]* @printf_str_fmt, i8 0, i8 0 + %val = call i8* @pop() + call i32(i8*, ...)* @printf(i8* %fmt, i8* %val) + + ret void +} + +; Pop stack, print result string to stderr and exit the program. +define void @crash(i1 %is_custom_error) { + ; TODO: Check if the top stack element is a string and crash if it is not. + call void @underflow_assert() + + br i1 %is_custom_error, label %custom_error, label %raw_error + +custom_error: + %cust_fmt = getelementptr [24 x i8]* @crash_cust_str_fmt, i8 0, i8 0 + br label %end + +raw_error: + %raw_fmt = getelementptr [3 x i8]* @printf_str_fmt, i8 0, i8 0 + br label %end + +end: + %fmt = phi i8* [%raw_fmt, %raw_error], [%cust_fmt, %custom_error] + %val = call i8* @pop() + %stderr = load %FILE** @stderr + call i32(%FILE*, i8*, ...)* @fprintf(%FILE* %stderr, i8* %fmt, i8* %val) + + ; Now, crash! + call void @exit(i32 1) + + ret void +} + +; Get a byte of input from stdin and push it. +; Crashes the program on errors. +define void @input() { + %read = call i32 @input_get() + %err = icmp slt i32 %read, 0 + br i1 %err, label %error, label %push + +error: + %at_eof = getelementptr [9 x i8]* @err_eof, i64 0, i64 0 + call void @push(i8* %at_eof) + call void @crash(i1 0) + ret void + +push: + %byte = trunc i32 %read to i8 + %buffer_addr = call i8* @calloc(i16 1, i16 2) + store i8 %byte, i8* %buffer_addr + call void @push(i8* %buffer_addr) + + ret void +} + +; Get a byte of input from stdin. Returns < 0 on error. +; This can be used together with input_peek(). +define i32 @input_get() { + %lookahead = load i32* @lookahead + %need_read = icmp slt i32 %lookahead, 0 + br i1 %need_read, label %ig_read, label %ig_lookahead + +ig_lookahead: + store i32 -1, i32* @lookahead + ret i32 %lookahead + +ig_read: + %read = call i32 @getchar() + ret i32 %read +} + +; Peek a byte of input from stdin. Returns < 0 on error. +; Successive calls to this function without interspersed calls +; to input_read() return the same value. +define i32 @input_peek() { + %read = call i32 @input_get() + store i32 %read, i32* @lookahead + ret i32 %read +} + +; If stdin is at EOF, push 1, else 0. +define void @eof_check() { + %peek = call i32 @input_peek() + %is_eof = icmp slt i32 %peek, 0 + br i1 %is_eof, label %at_eof, label %not_at_eof + +at_eof: + %true = getelementptr [2 x i8]* @true, i8 0, i8 0 + call void @push(i8* %true) + ret void + +not_at_eof: + %false = getelementptr [2 x i8]* @false, i8 0, i8 0 + call void @push(i8* %false) + + ret void +} + +define void @push(i8* %str_ptr) { + ; dereferencing @sp by loading value into memory + %sp = load i64* @sp + + ; get position on the stack, the stack pointer points to. this is the top of + ; the stack. + ; nice getelementptr FAQ: http://llvm.org/docs/GetElementPtr.html + ; value of pointer type, index, field + %top = getelementptr [1000 x i8*]* @stack, i8 0, i64 %sp + + ; the contents of memory are updated to contain %str_ptr at the location + ; specified by the %addr operand + store i8* %str_ptr, i8** %top + + ; increase stack pointer to point to new free, top of stack + %newsp = add i64 %sp, 1 + store i64 %newsp, i64* @sp + + ret void +} + +; pops element from stack and converts in integer +; returns the element, in case of error undefined +define i64 @pop_int(){ + ; pop + %top = call i8* @pop() + + ; convert to int, check for error + %top_int0 = call i32 @atol(i8* %top) + %top_int1 = sext i32 %top_int0 to i64 + + ; return + ret i64 %top_int1 +} + +define void @push_float(double %top_float) +{ + ; allocate memory to store string in + ; TODO: Make sure this is free()'d at _some_ point during + ; program execution. + %buffer_addr = call i8* @malloc(i16 128) + %to_str_ptr = getelementptr [3 x i8]* @float_to_str, i64 0, i64 0 + + ; convert to string + call i32(i8*, ...)* @snprintf( + i8* %buffer_addr, i16 128, i8* %to_str_ptr, double %top_float) + + ; push on stack + call void(i8*)* @push(i8* %buffer_addr) + + ret void +} + +define void @push_int(i64 %top_int) +{ + ; allocate memory to store string in + ; TODO: Make sure this is free()'d at _some_ point during + ; program execution. + %buffer_addr = call i8* @malloc(i16 128) + %to_str_ptr = getelementptr [3 x i8]* @int_to_str, i64 0, i64 0 + + ; convert to string + call i32(i8*, ...)* @snprintf( + i8* %buffer_addr, i16 128, i8* %to_str_ptr, i64 %top_int) + + ; push on stack + call void(i8*)* @push(i8* %buffer_addr) + + ret void +} + +define i32 @mult() { + ; return value of this function + %func_result = alloca i32, align 4 + + ; allocate memory on stack to hold our structures that contains the type + ; of stack element and its casted value + %new_elem_a = alloca %struct.stack_elem, align 8 + %new_elem_b = alloca %struct.stack_elem, align 8 + + ; get top of stack + call void @underflow_assert() + %number_a = call i8* @pop() + + ; get second top of stack + call void @underflow_assert() + %number_b = call i8* @pop() + + ; get type of number_a + %ret_a = call i32 @get_stack_elem(i8* %number_a, %struct.stack_elem* %new_elem_a) + %is_zero_a = icmp slt i32 %ret_a, 0 + br i1 %is_zero_a, label %exit_with_failure, label %get_type_b + +;############################################################################## +; integer multiplication +;############################################################################## + +get_type_b: + ; get type of number_b + %ret_b = call i32 @get_stack_elem(i8* %number_b, %struct.stack_elem* %new_elem_b) + %is_zero_b = icmp slt i32 %ret_b, 0 + br i1 %is_zero_b, label %exit_with_failure, label %type_check_a_int + +type_check_a_int: + ; first, load the new_elem_a.type element. check whether it is 1 (aka INT). + %type_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 0 + %type_a = load i32* %type_a_ptr, align 4 + %is_int_a = icmp eq i32 %type_a, 1 + br i1 %is_int_a, label %type_check_b_int, label %type_check_a_float + +type_check_b_int: + ; first, load the new_elem_b.type element. check whether it is 1 (aka INT). + %type_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 0 + %type_b = load i32* %type_b_ptr, align 4 + %is_int_b = icmp eq i32 %type_b, 1 + br i1 %is_int_b, label %add_int, label %type_check_a_float + +add_int: + ; get new_elem_a.ival that contains the casted integer value + %ival_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 1 + %ival_a_cast = bitcast %union.anon* %ival_a_ptr to i64* + %ival_a = load i64* %ival_a_cast, align 4 + + ; get new_elem_b.ival that contains the casted integer value + %ival_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 1 + %ival_b_cast = bitcast %union.anon* %ival_b_ptr to i64* + %ival_b = load i64* %ival_b_cast, align 4 + + ; add the two integers and store result on the stack + %ires = mul i64 %ival_a, %ival_b + call void(i64)* @push_int(i64 %ires) + br label %exit_with_success + +;############################################################################## +; floating point multiplication +;############################################################################## + +type_check_a_float: + %ftype_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 0 + %ftype_a = load i32* %ftype_a_ptr, align 4 + %is_float_a = icmp eq i32 %ftype_a, 2 + br i1 %is_float_a, label %type_check_b_float, label %exit_with_invalid_type + +type_check_b_float: + %ftype_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 0 + %ftype_b = load i32* %ftype_b_ptr, align 4 + %is_float_b = icmp eq i32 %ftype_b, 2 + br i1 %is_float_b, label %mult_float, label %exit_with_invalid_type + +mult_float: + ; get new_elem_a.fval that contains the float value + %fval_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 1 + %fval_a_cast = bitcast %union.anon* %fval_a_ptr to float* + %fval_a = load float* %fval_a_cast, align 4 + %fval_a_d = fpext float %fval_a to double + + ; get new_elem_b.fval that contains the float value + %fval_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 1 + %fval_b_cast = bitcast %union.anon* %fval_b_ptr to float* + %fval_b = load float* %fval_b_cast, align 4 + %fval_b_d = fpext float %fval_b to double + + ; sub the two floats and store result on the stack + %fres= fmul double %fval_a_d, %fval_b_d + call void(double)* @push_float(double %fres) + br label %exit_with_success + +exit_with_success: + store i32 0, i32* %func_result + br label %exit + +exit_with_invalid_type: + call void(i8*)* @push(i8* getelementptr inbounds( + [14 x i8]* @err_type, i64 0, i64 0)) + br label %exit_with_failure + +exit_with_failure: + store i32 -1, i32* %func_result + br label %exit + +exit: + %result = load i32* %func_result + ret i32 %result +} + +define i32 @rem() { + ; return value of this function + %func_result = alloca i32, align 4 + + ; allocate memory on stack to hold our structures that contains the type + ; of stack element and its casted value + %new_elem_a = alloca %struct.stack_elem, align 8 + %new_elem_b = alloca %struct.stack_elem, align 8 + + ; get top of stack + call void @underflow_assert() + %number_a = call i8* @pop() + + ; get second top of stack + call void @underflow_assert() + %number_b = call i8* @pop() + + ; get type of number_a + %ret_a = call i32 @get_stack_elem(i8* %number_a, %struct.stack_elem* %new_elem_a) + %is_zero_a = icmp slt i32 %ret_a, 0 + br i1 %is_zero_a, label %exit_with_failure, label %get_type_b + +;############################################################################## +; integer remainder +;############################################################################## + +get_type_b: + ; get type of number_b + %ret_b = call i32 @get_stack_elem(i8* %number_b, %struct.stack_elem* %new_elem_b) + %is_zero_b = icmp slt i32 %ret_b, 0 + br i1 %is_zero_b, label %exit_with_failure, label %type_check_a_int + +type_check_a_int: + ; first, load the new_elem_a.type element. check whether it is 1 (aka INT). + %type_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 0 + %type_a = load i32* %type_a_ptr, align 4 + %is_int_a = icmp eq i32 %type_a, 1 + br i1 %is_int_a, label %type_check_b_int, label %type_check_a_float + +type_check_b_int: + ; first, load the new_elem_b.type element. check whether it is 1 (aka INT). + %type_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 0 + %type_b = load i32* %type_b_ptr, align 4 + %is_int_b = icmp eq i32 %type_b, 1 + br i1 %is_int_b, label %rem_int, label %type_check_a_float + +rem_int: + ; get new_elem_a.ival that contains the casted integer value + %ival_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 1 + %ival_a_cast = bitcast %union.anon* %ival_a_ptr to i32* + %ival_a = load i32* %ival_a_cast, align 4 + + ; get new_elem_b.ival that contains the casted integer value + %ival_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 1 + %ival_b_cast = bitcast %union.anon* %ival_b_ptr to i32* + %ival_b = load i32* %ival_b_cast, align 4 + + ; add the two integers and store result on the stack + %ires = srem i32 %ival_a, %ival_b + %lres = sext i32 %ires to i64 + call void(i64)* @push_int(i64 %lres) + br label %exit_with_success + +;############################################################################## +; floating point remainder +;############################################################################## + +type_check_a_float: + %ftype_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 0 + %ftype_a = load i32* %ftype_a_ptr, align 4 + %is_float_a = icmp eq i32 %ftype_a, 2 + br i1 %is_float_a, label %type_check_b_float, label %exit_with_invalid_type + +type_check_b_float: + %ftype_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 0 + %ftype_b = load i32* %ftype_b_ptr, align 4 + %is_float_b = icmp eq i32 %ftype_b, 2 + br i1 %is_float_b, label %rem_float, label %exit_with_invalid_type + +rem_float: + ; get new_elem_a.fval that contains the float value + %fval_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 1 + %fval_a_cast = bitcast %union.anon* %fval_a_ptr to float* + %fval_a = load float* %fval_a_cast, align 4 + %fval_a_d = fpext float %fval_a to double + + ; get new_elem_b.fval that contains the float value + %fval_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 1 + %fval_b_cast = bitcast %union.anon* %fval_b_ptr to float* + %fval_b = load float* %fval_b_cast, align 4 + %fval_b_d = fpext float %fval_b to double + + ; sub the two floats and store result on the stack + %fres= frem double %fval_a_d, %fval_b_d + call void(double)* @push_float(double %fres) + br label %exit_with_success + +exit_with_success: + store i32 0, i32* %func_result + br label %exit + +exit_with_invalid_type: + call void(i8*)* @push(i8* getelementptr inbounds( + [14 x i8]* @err_type, i64 0, i64 0)) + br label %exit_with_failure + +exit_with_failure: + store i32 -1, i32* %func_result + br label %exit + +exit: + %result = load i32* %func_result + ret i32 %result +} + +define i32 @sub() { + ; return value of this function + %func_result = alloca i32, align 4 + + ; allocate memory on stack to hold our structures that contains the type + ; of stack element and its casted value + %new_elem_a = alloca %struct.stack_elem, align 8 + %new_elem_b = alloca %struct.stack_elem, align 8 + + ; get top of stack + call void @underflow_assert() + %number_a = call i8* @pop() + + ; get second top of stack + call void @underflow_assert() + %number_b = call i8* @pop() + + ; get type of number_a + %ret_a = call i32 @get_stack_elem(i8* %number_a, %struct.stack_elem* %new_elem_a) + %is_zero_a = icmp slt i32 %ret_a, 0 + br i1 %is_zero_a, label %exit_with_failure, label %get_type_b + +;############################################################################## +; integer subtraction +;############################################################################## + +get_type_b: + ; get type of number_b + %ret_b = call i32 @get_stack_elem(i8* %number_b, %struct.stack_elem* %new_elem_b) + %is_zero_b = icmp slt i32 %ret_b, 0 + br i1 %is_zero_b, label %exit_with_failure, label %type_check_a_int + +type_check_a_int: + ; first, load the new_elem_a.type element. check whether it is 1 (aka INT). + %type_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 0 + %type_a = load i32* %type_a_ptr, align 4 + %is_int_a = icmp eq i32 %type_a, 1 + br i1 %is_int_a, label %type_check_b_int, label %type_check_a_float + +type_check_b_int: + ; first, load the new_elem_b.type element. check whether it is 1 (aka INT). + %type_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 0 + %type_b = load i32* %type_b_ptr, align 4 + %is_int_b = icmp eq i32 %type_b, 1 + br i1 %is_int_b, label %sub_int, label %type_check_a_float + +sub_int: + ; get new_elem_a.ival that contains the casted integer value + %ival_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 1 + %ival_a_cast = bitcast %union.anon* %ival_a_ptr to i64* + %ival_a = load i64* %ival_a_cast, align 4 + + ; get new_elem_b.ival that contains the casted integer value + %ival_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 1 + %ival_b_cast = bitcast %union.anon* %ival_b_ptr to i64* + %ival_b = load i64* %ival_b_cast, align 4 + + ; add the two integers and store result on the stack + %ires = sub i64 %ival_a, %ival_b + call void(i64)* @push_int(i64 %ires) + br label %exit_with_success + +;############################################################################## +; floating point subtraction +;############################################################################## + +type_check_a_float: + %ftype_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 0 + %ftype_a = load i32* %ftype_a_ptr, align 4 + %is_float_a = icmp eq i32 %ftype_a, 2 + br i1 %is_float_a, label %type_check_b_float, label %exit_with_invalid_type + +type_check_b_float: + %ftype_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 0 + %ftype_b = load i32* %ftype_b_ptr, align 4 + %is_float_b = icmp eq i32 %ftype_b, 2 + br i1 %is_float_b, label %sub_float, label %exit_with_invalid_type + +sub_float: + ; get new_elem_a.fval that contains the float value + %fval_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 1 + %fval_a_cast = bitcast %union.anon* %fval_a_ptr to float* + %fval_a = load float* %fval_a_cast, align 4 + %fval_a_d = fpext float %fval_a to double + + ; get new_elem_b.fval that contains the float value + %fval_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 1 + %fval_b_cast = bitcast %union.anon* %fval_b_ptr to float* + %fval_b = load float* %fval_b_cast, align 4 + %fval_b_d = fpext float %fval_b to double + + ; sub the two floats and store result on the stack + %fres= fsub double %fval_a_d, %fval_b_d + call void(double)* @push_float(double %fres) + br label %exit_with_success + +exit_with_success: + store i32 0, i32* %func_result + br label %exit + +exit_with_invalid_type: + call void(i8*)* @push(i8* getelementptr inbounds( + [14 x i8]* @err_type, i64 0, i64 0)) + br label %exit_with_failure + +exit_with_failure: + store i32 -1, i32* %func_result + br label %exit + +exit: + %result = load i32* %func_result + ret i32 %result +} + +define i32 @add() { + ; return value of this function + %func_result = alloca i32, align 4 + + ; allocate memory on stack to hold our structures that contains the type + ; of stack element and its casted value + %new_elem_a = alloca %struct.stack_elem, align 8 + %new_elem_b = alloca %struct.stack_elem, align 8 + + ; get top of stack + call void @underflow_assert() + %number_a = call i8* @pop() + + ; get second top of stack + call void @underflow_assert() + %number_b = call i8* @pop() + + ; get type of number_a + %ret_a = call i32 @get_stack_elem(i8* %number_a, %struct.stack_elem* %new_elem_a) + %is_zero_a = icmp slt i32 %ret_a, 0 + br i1 %is_zero_a, label %exit_with_failure, label %get_type_b + +;############################################################################## +; integer addition +;############################################################################## + +get_type_b: + ; get type of number_b + %ret_b = call i32 @get_stack_elem(i8* %number_b, %struct.stack_elem* %new_elem_b) + %is_zero_b = icmp slt i32 %ret_b, 0 + br i1 %is_zero_b, label %exit_with_failure, label %type_check_a_int + +type_check_a_int: + ; first, load the new_elem_a.type element. check whether it is 1 (aka INT). + %type_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 0 + %type_a = load i32* %type_a_ptr, align 4 + %is_int_a = icmp eq i32 %type_a, 1 + br i1 %is_int_a, label %type_check_b_int, label %type_check_a_float + +type_check_b_int: + ; first, load the new_elem_b.type element. check whether it is 1 (aka INT). + %type_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 0 + %type_b = load i32* %type_b_ptr, align 4 + %is_int_b = icmp eq i32 %type_b, 1 + br i1 %is_int_b, label %add_int, label %type_check_a_float + +add_int: + ; get new_elem_a.ival that contains the casted integer value + %ival_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 1 + %ival_a_cast = bitcast %union.anon* %ival_a_ptr to i64* + %ival_a = load i64* %ival_a_cast, align 4 + + ; get new_elem_b.ival that contains the casted integer value + %ival_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 1 + %ival_b_cast = bitcast %union.anon* %ival_b_ptr to i64* + %ival_b = load i64* %ival_b_cast, align 4 + + ; add the two integers and store result on the stack + %ires = add i64 %ival_a, %ival_b + call void(i64)* @push_int(i64 %ires) + br label %exit_with_success + +;############################################################################## +; floating point addition +;############################################################################## + +type_check_a_float: + %ftype_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 0 + %ftype_a = load i32* %ftype_a_ptr, align 4 + %is_float_a = icmp eq i32 %ftype_a, 2 + br i1 %is_float_a, label %type_check_b_float, label %exit_with_invalid_type + +type_check_b_float: + %ftype_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 0 + %ftype_b = load i32* %ftype_b_ptr, align 4 + %is_float_b = icmp eq i32 %ftype_b, 2 + br i1 %is_float_b, label %add_float, label %exit_with_invalid_type + +add_float: + ; get new_elem_a.fval that contains the float value + %fval_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 1 + %fval_a_cast = bitcast %union.anon* %fval_a_ptr to float* + %fval_a = load float* %fval_a_cast, align 4 + %fval_a_d = fpext float %fval_a to double + + ; get new_elem_b.fval that contains the float value + %fval_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 1 + %fval_b_cast = bitcast %union.anon* %fval_b_ptr to float* + %fval_b = load float* %fval_b_cast, align 4 + %fval_b_d = fpext float %fval_b to double + + ; add the two floats and store result on the stack + %fres= fadd double %fval_a_d, %fval_b_d + call void(double)* @push_float(double %fres) + br label %exit_with_success + +exit_with_success: + store i32 0, i32* %func_result + br label %exit + +exit_with_invalid_type: + call void(i8*)* @push(i8* getelementptr inbounds( + [14 x i8]* @err_type, i64 0, i64 0)) + br label %exit_with_failure + +exit_with_failure: + store i32 -1, i32* %func_result + br label %exit + +exit: + %result = load i32* %func_result + ret i32 %result +} + +define void @sub_int() { + ; get top of stack + %top_1 = call i64()* @pop_int() + + ; get second top of stack + %top_2 = call i64()* @pop_int() + + ; sub the two values + %res = sub i64 %top_1, %top_2 + + ; store result on stack + call void(i64)* @push_int(i64 %res) + + ret void +} + +define i32 @div() { + ; return value of this function + %func_result = alloca i32, align 4 + + ; allocate memory on stack to hold our structures that contains the type + ; of stack element and its casted value + %new_elem_a = alloca %struct.stack_elem, align 8 + %new_elem_b = alloca %struct.stack_elem, align 8 + + ; get top of stack + call void @underflow_assert() + %number_a = call i8* @pop() + + ; get second top of stack + call void @underflow_assert() + %number_b = call i8* @pop() + + ; get type of number_a + %ret_a = call i32 @get_stack_elem(i8* %number_a, %struct.stack_elem* %new_elem_a) + %is_zero_a = icmp slt i32 %ret_a, 0 + br i1 %is_zero_a, label %exit_with_failure, label %get_type_b + +;############################################################################## +; integer division +;############################################################################## + +get_type_b: + ; get type of number_b + %ret_b = call i32 @get_stack_elem(i8* %number_b, %struct.stack_elem* %new_elem_b) + %is_zero_b = icmp slt i32 %ret_b, 0 + br i1 %is_zero_b, label %exit_with_failure, label %type_check_a_int + +type_check_a_int: + ; first, load the new_elem_a.type element. check whether it is 1 (aka INT). + %type_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 0 + %type_a = load i32* %type_a_ptr, align 4 + %is_int_a = icmp eq i32 %type_a, 1 + br i1 %is_int_a, label %type_check_b_int, label %type_check_a_float + +type_check_b_int: + ; first, load the new_elem_b.type element. check whether it is 1 (aka INT). + %type_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 0 + %type_b = load i32* %type_b_ptr, align 4 + %is_int_b = icmp eq i32 %type_b, 1 + br i1 %is_int_b, label %div_int, label %type_check_a_float + +div_int: + ; get new_elem_a.ival that contains the casted integer value + %ival_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 1 + %ival_a_cast = bitcast %union.anon* %ival_a_ptr to i32* + %ival_a = load i32* %ival_a_cast, align 4 + + ; get new_elem_b.ival that contains the casted integer value + %ival_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 1 + %ival_b_cast = bitcast %union.anon* %ival_b_ptr to i32* + %ival_b = load i32* %ival_b_cast, align 4 + + ; prevent division by zero + %div_by_zero = icmp eq i32 %ival_b, 0 + br i1 %div_by_zero, label %exit_with_zero, label %div_int_ok + +div_int_ok: + ; divide the two integers and store result on the stack + %ires = sdiv i32 %ival_a, %ival_b + %lres = sext i32 %ires to i64 + + call void(i64)* @push_int(i64 %lres) + br label %exit_with_success + +;############################################################################## +; floating point division +;############################################################################## + +type_check_a_float: + %ftype_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 0 + %ftype_a = load i32* %ftype_a_ptr, align 4 + %is_float_a = icmp eq i32 %ftype_a, 2 + br i1 %is_float_a, label %type_check_b_float, label %exit_with_invalid_type + +type_check_b_float: + %ftype_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 0 + %ftype_b = load i32* %ftype_b_ptr, align 4 + %is_float_b = icmp eq i32 %ftype_b, 2 + br i1 %is_float_b, label %div_float, label %exit_with_invalid_type + +div_float: + ; get new_elem_a.fval that contains the float value + %fval_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 1 + %fval_a_cast = bitcast %union.anon* %fval_a_ptr to float* + %fval_a = load float* %fval_a_cast, align 4 + %fval_a_d = fpext float %fval_a to double + + ; get new_elem_b.fval that contains the float value + %fval_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 1 + %fval_b_cast = bitcast %union.anon* %fval_b_ptr to float* + %fval_b = load float* %fval_b_cast, align 4 + + ; prevent division by zero + %div_by_zero_f = fcmp oeq float %fval_b, 0.0 + br i1 %div_by_zero_f, label %exit_with_zero, label %div_float_ok + +div_float_ok: + ; divide the two floats and store result on the stack + %fval_b_d = fpext float %fval_b to double + %fres= fdiv double %fval_a_d, %fval_b_d + call void(double)* @push_float(double %fres) + br label %exit_with_success + +exit_with_success: + store i32 0, i32* %func_result + br label %exit + +exit_with_zero: + call void(i8*)* @push(i8* getelementptr inbounds( + [18 x i8]* @err_zero, i64 0, i64 0)) + br label %exit_with_failure + +exit_with_invalid_type: + call void(i8*)* @push(i8* getelementptr inbounds( + [14 x i8]* @err_type, i64 0, i64 0)) + br label %exit_with_failure + +exit_with_failure: + store i32 -1, i32* %func_result + br label %exit + +exit: + %result = load i32* %func_result + ret i32 %result +} + + + +@main.number_a = private unnamed_addr constant [4 x i8] c"-57\00" +@main.number_b = private unnamed_addr constant [4 x i8] c"-58\00" + +define i32 @main_div() { + ; push two numbers on the stack + %number0 = getelementptr [4 x i8]* @main.number_a, i64 0, i64 0 + %number1 = getelementptr [4 x i8]* @main.number_b, i64 0, i64 0 + + call void(i8*)* @push(i8* %number0) + call void(i8*)* @push(i8* %number1) + + call i32 @div() + %result = call i8* @pop() + call i32 (i8*, ...)* @printf(i8* getelementptr inbounds ([13 x i8]* + @popped, i32 0, i32 0), i8* %result) + + ret i32 0 +} + +define i32 @main_equal() { + ; push two numbers on the stack + %number0 = getelementptr [4 x i8]* @main.number_a, i64 0, i64 0 + %number1 = getelementptr [4 x i8]* @main.number_b, i64 0, i64 0 + + call void(i8*)* @push(i8* %number0) + call void(i8*)* @push(i8* %number1) + + call i32 @equal() + %result = call i8* @pop() + call i32 (i8*, ...)* @printf(i8* getelementptr inbounds ([13 x i8]* + @popped, i32 0, i32 0), i8* %result) + + ret i32 0 +} + + +define i8* @peek() { + %sp = load i64* @sp + %top_of_stack = sub i64 %sp, 1 + %addr = getelementptr [1000 x i8*]* @stack, i8 0, i64 %top_of_stack + %val = load i8** %addr + ret i8* %val +} + +define i8* @pop() { + %val = call i8*()* @peek() + %sp = load i64* @sp + %top_of_stack = sub i64 %sp, 1 + store i64 %top_of_stack, i64* @sp + ret i8* %val +} + +; TODO: free alloated space of input strings +define void @strapp() { +entry: + %str2 = call i8*()* @pop() + %str1 = call i8*()* @pop() + + ; compute length of input strings (TODO: maybe isolate strlen function for this purpose) + call void(i8*)* @push(i8* %str1) + call void()* @strlen() + %len_str1 = call i64()* @pop_int() + call void(i8*)* @push(i8* %str2) + call void()* @strlen() + %len_str2 = call i64()* @pop_int() + + ; allocate space for result string + %len_result_1 = add i64 %len_str1, %len_str2 + %len_result_2 = add i64 %len_result_1, 1 + %len_result_3 = trunc i64 %len_result_2 to i16 + %result = call i8* @malloc(i16 %len_result_3) + + ; copy first string + br label %loop1 +loop1: + %i = phi i64 [0, %entry], [ %next_i, %loop1 ] + %next_i = add i64 %i, 1 + %addr = getelementptr i8* %str1, i64 %i + %c = load i8* %addr + %result_addr = getelementptr i8* %result, i64 %i + store i8 %c, i8* %result_addr + %cond = icmp eq i8 %c, 0 + br i1 %cond, label %finished, label %loop1 +finished: + ; copy second string + br label %loop2 +loop2: + %j = phi i64 [0, %finished], [ %next_j, %loop2 ] + %next_j = add i64 %j, 1 + %addr2 = getelementptr i8* %str2, i64 %j + %c2 = load i8* %addr2 + %k = add i64 %j, %len_str1 + %result_addr2 = getelementptr i8* %result, i64 %k + store i8 %c2, i8* %result_addr2 + %cond2 = icmp eq i8 %c2, 0 + br i1 %cond2, label %finished2, label %loop2 +finished2: + call void(i8*)* @push(i8* %result) + ret void +} + +define void @strlen() { +entry: + %str = call i8*()* @pop() + br label %loop +loop: + %i = phi i64 [1, %entry ], [ %next_i, %loop ] + %next_i = add i64 %i, 1 + %addr = getelementptr i8* %str, i64 %i + %c = load i8* %addr + %cond = icmp eq i8 %c, 0 + br i1 %cond, label %finished, label %loop +finished: + call void(i64)* @push_int(i64 %i) + ret void +} + +define void @streq() { +entry: + %str1 = call i8*()* @pop() + %str2 = call i8*()* @pop() + br label %loop +loop: + ; the phi instruction says that coming from the 'entry' label i is 1 + ; otherwise (coming from 'cont') i will be 'next_i' + %i = phi i64 [ 1, %entry ], [ %next_i, %cont ] + + ; the the actual character + %addr1 = getelementptr i8* %str1, i64 %i + %addr2 = getelementptr i8* %str2, i64 %i + %c1 = load i8* %addr1 + %c2 = load i8* %addr2 + + ; if equal, jump to next character otherwise jump to 'fail' + %cond = icmp eq i8 %c1, %c2 + br i1 %cond, label %cont, label %fail + +cont: + %next_i = add i64 %i, 1 + %cond2 = icmp eq i8 %c1, 0 + br i1 %cond2, label %success, label %loop +success: + %t = getelementptr [2 x i8]* @true, i64 0, i64 0 + call void(i8*)* @push(i8* %t) + ret void +fail: + %f = getelementptr [2 x i8]* @false, i64 0, i64 0 + call void(i8*)* @push(i8* %f) + ret void +} + +define i32 @finish(){ + ret i32 0 +} + +;############################################################################## +; equal +;############################################################################## + +define i32 @equal(){ + ; return value of this function + %func_result = alloca i32, align 4 + + %new_elem_a = alloca %struct.stack_elem, align 8 + %new_elem_b = alloca %struct.stack_elem, align 8 + + ; get top + call void @underflow_assert() + %number_a = call i8* @pop() + + ; get top-1 + call void @underflow_assert() + %number_b = call i8* @pop() + + ; get type of number_a + %ret_a = call i32 @get_stack_elem(i8* %number_a, %struct.stack_elem* %new_elem_a) + %is_zero_a = icmp slt i32 %ret_a, 0 + br i1 %is_zero_a, label %exit_with_failure, label %get_type_b + +get_type_b: + ; get type of number_b + %ret_b = call i32 @get_stack_elem(i8* %number_b, %struct.stack_elem* %new_elem_b) + %is_zero_b = icmp slt i32 %ret_b, 0 + br i1 %is_zero_b, label %exit_with_failure, label %type_check_a_int + +type_check_a_int: + ; first, load the new_elem_a.type element. check whether it is 1 (aka INT). + %type_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 0 + %type_a = load i32* %type_a_ptr, align 4 + %is_int_a = icmp eq i32 %type_a, 1 + br i1 %is_int_a, label %type_check_b_int, label %type_check_a_float + +type_check_b_int: + ; first, load the new_elem_b.type element. check whether it is 1 (aka INT). + %type_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 0 + %type_b = load i32* %type_b_ptr, align 4 + %is_int_b = icmp eq i32 %type_b, 1 + br i1 %is_int_b, label %cmp_int, label %type_check_a_float + +cmp_int: + ; get new_elem_a.ival that contains the casted integer value + %ival_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 1 + %ival_a_cast = bitcast %union.anon* %ival_a_ptr to i32* + %ival_a = load i32* %ival_a_cast, align 4 + + ; get new_elem_b.ival that contains the casted integer value + %ival_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 1 + %ival_b_cast = bitcast %union.anon* %ival_b_ptr to i32* + %ival_b = load i32* %ival_b_cast, align 4 + + ; the actual comparison + %equal_int = icmp eq i32 %ival_a, %ival_b + br i1 %equal_int, label %exit_with_true, label %exit_with_false + +type_check_a_float: + %ftype_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 0 + %ftype_a = load i32* %ftype_a_ptr, align 4 + %is_float_a = icmp eq i32 %ftype_a, 2 + br i1 %is_float_a, label %type_check_b_float, label %exit_with_invalid_type + +type_check_b_float: + %ftype_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 0 + %ftype_b = load i32* %ftype_b_ptr, align 4 + %is_float_b = icmp eq i32 %ftype_b, 2 + br i1 %is_float_b, label %cmp_float, label %exit_with_invalid_type + +cmp_float: + ; get new_elem_a.fval that contains the float value + %fval_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 1 + %fval_a_cast = bitcast %union.anon* %fval_a_ptr to float* + %fval_a = load float* %fval_a_cast, align 4 + + ; get new_elem_b.fval that contains the float value + %fval_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 1 + %fval_b_cast = bitcast %union.anon* %fval_b_ptr to float* + %fval_b = load float* %fval_b_cast, align 4 + + ; prevent division by zero + %equal_float = fcmp oeq float %fval_a, %fval_b + br i1 %equal_float, label %exit_with_true, label %exit_with_false + + +exit_with_invalid_type: + call void(i8*)* @push(i8* getelementptr inbounds( + [14 x i8]* @err_type, i64 0, i64 0)) + br label %exit_with_failure + +exit_with_true: + call void(i8*)* @push(i8* getelementptr inbounds( + [2 x i8]* @true, i64 0, i64 0)) + br label %exit_with_success + +exit_with_false: + call void(i8*)* @push(i8* getelementptr inbounds( + [2 x i8]* @false, i64 0, i64 0)) + br label %exit_with_success + +exit_with_failure: + store i32 -1, i32* %func_result + br label %exit + +exit_with_success: + store i32 0, i32* %func_result + br label %exit + +exit: + %result = load i32* %func_result + ret i32 %result + +} + +;############################################################################## +; greater +;############################################################################## + +define i32 @greater(){ + ; return value of this function + %func_result = alloca i32, align 4 + + %new_elem_a = alloca %struct.stack_elem, align 8 + %new_elem_b = alloca %struct.stack_elem, align 8 + + ; get top + call void @underflow_assert() + %number_a = call i8* @pop() + + ; get top-1 + call void @underflow_assert() + %number_b = call i8* @pop() + + ; get type of number_a + %ret_a = call i32 @get_stack_elem(i8* %number_a, %struct.stack_elem* %new_elem_a) + %is_zero_a = icmp slt i32 %ret_a, 0 + br i1 %is_zero_a, label %exit_with_failure, label %get_type_b + +get_type_b: + ; get type of number_b + %ret_b = call i32 @get_stack_elem(i8* %number_b, %struct.stack_elem* %new_elem_b) + %is_zero_b = icmp slt i32 %ret_b, 0 + br i1 %is_zero_b, label %exit_with_failure, label %type_check_a_int + +type_check_a_int: + ; first, load the new_elem_a.type element. check whether it is 1 (aka INT). + %type_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 0 + %type_a = load i32* %type_a_ptr, align 4 + %is_int_a = icmp eq i32 %type_a, 1 + br i1 %is_int_a, label %type_check_b_int, label %type_check_a_float + +type_check_b_int: + ; first, load the new_elem_b.type element. check whether it is 1 (aka INT). + %type_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 0 + %type_b = load i32* %type_b_ptr, align 4 + %is_int_b = icmp eq i32 %type_b, 1 + br i1 %is_int_b, label %cmp_int, label %type_check_a_float + +cmp_int: + ; get new_elem_a.ival that contains the casted integer value + %ival_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 1 + %ival_a_cast = bitcast %union.anon* %ival_a_ptr to i32* + %ival_a = load i32* %ival_a_cast, align 4 + + ; get new_elem_b.ival that contains the casted integer value + %ival_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 1 + %ival_b_cast = bitcast %union.anon* %ival_b_ptr to i32* + %ival_b = load i32* %ival_b_cast, align 4 + + ; the actual comparison + %greater_int = icmp sgt i32 %ival_a, %ival_b + br i1 %greater_int, label %exit_with_true, label %exit_with_false + +type_check_a_float: + %ftype_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 0 + %ftype_a = load i32* %ftype_a_ptr, align 4 + %is_float_a = icmp eq i32 %ftype_a, 2 + br i1 %is_float_a, label %type_check_b_float, label %exit_with_invalid_type + +type_check_b_float: + %ftype_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 0 + %ftype_b = load i32* %ftype_b_ptr, align 4 + %is_float_b = icmp eq i32 %ftype_b, 2 + br i1 %is_float_b, label %cmp_float, label %exit_with_invalid_type + +cmp_float: + ; get new_elem_a.fval that contains the float value + %fval_a_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_a, i32 0, i32 1 + %fval_a_cast = bitcast %union.anon* %fval_a_ptr to float* + %fval_a = load float* %fval_a_cast, align 4 + + ; get new_elem_b.fval that contains the float value + %fval_b_ptr = getelementptr inbounds %struct.stack_elem* %new_elem_b, i32 0, i32 1 + %fval_b_cast = bitcast %union.anon* %fval_b_ptr to float* + %fval_b = load float* %fval_b_cast, align 4 + + ; prevent division by zero + %greater_float = fcmp ogt float %fval_a, %fval_b + br i1 %greater_float, label %exit_with_true, label %exit_with_false + + +exit_with_invalid_type: + call void(i8*)* @push(i8* getelementptr inbounds( + [14 x i8]* @err_type, i64 0, i64 0)) + br label %exit_with_failure + +exit_with_true: + call void(i8*)* @push(i8* getelementptr inbounds( + [2 x i8]* @true, i64 0, i64 0)) + br label %exit_with_success + +exit_with_false: + call void(i8*)* @push(i8* getelementptr inbounds( + [2 x i8]* @false, i64 0, i64 0)) + br label %exit_with_success + +exit_with_failure: + store i32 -1, i32* %func_result + br label %exit + +exit_with_success: + store i32 0, i32* %func_result + br label %exit + +exit: + %result = load i32* %func_result + ret i32 %result + +} + + +; Popping a pointer from the stack into a variable +define void @pop_into(i8** %var_ptr) { + call void @underflow_assert() + %val_ptr = call i8* @pop() + store i8* %val_ptr, i8** %var_ptr + ret void +} + +; Pushing a pointer from a variable onto the stack +define void @push_from(i8** %var_ptr) { + %val = load i8** %var_ptr + call void @push (i8* %val) + ret void +} + +; Function Attrs: nounwind uwtable +; Takes a string, determines the type it is representing and returns the +; corresponding stack element structure. +define i32 @get_stack_elem(i8* %string, %struct.stack_elem* %elem) #0 { + %1 = alloca i32, align 4 + %2 = alloca i8*, align 8 + %3 = alloca %struct.stack_elem*, align 8 + %pEnd = alloca i8*, align 8 + %new_long = alloca i64, align 8 + %new_float = alloca float, align 4 + store i8* %string, i8** %2, align 8 + store %struct.stack_elem* %elem, %struct.stack_elem** %3, align 8 + %4 = load i8** %2, align 8 + %5 = call i64 @strtol(i8* %4, i8** %pEnd, i32 10) #2 + store i64 %5, i64* %new_long, align 8 + %6 = load i8** %pEnd, align 8 + %7 = load i8* %6, align 1 + %8 = sext i8 %7 to i32 + %9 = icmp eq i32 %8, 0 + br i1 %9, label %10, label %18 + +;