rail-compiler-editor (empty) → 0.2.0.0

raw patch · 29 files changed

+5295/−0 lines, 29 filesdep +HUnitdep +basedep +containerssetup-changed

Dependencies added: HUnit, base, containers, gtk, llvm-general, llvm-general-pure, mtl, process, transformers

Files

• LICENSE +21/−0
• README.md +151/−0
• Setup.hs +2/−0
• rail-compiler-editor.cabal +66/−0
• src/RailCompiler/Backend.hs +45/−0
• src/RailCompiler/CodeOptimization.hs +23/−0
• src/RailCompiler/ErrorHandling.hs +41/−0
• src/RailCompiler/InterfaceDT.hs +43/−0
• src/RailCompiler/IntermediateCode.hs +693/−0
• src/RailCompiler/Lexer.hs +659/−0
• src/RailCompiler/Main.hs +117/−0
• src/RailCompiler/Preprocessor.hs +46/−0
• src/RailCompiler/SemanticalAnalysis.hs +49/−0
• src/RailCompiler/SyntacticalAnalysis.hs +69/−0
• src/RailCompiler/stack.ll +1398/−0
• src/RailEditor/EditorBackend.hs +279/−0
• src/RailEditor/Execute.hs +13/−0
• src/RailEditor/Main.hs +192/−0
• src/RailEditor/Menu.hs +174/−0
• src/RailEditor/TextArea.hs +614/−0
• tests/Main.hs +39/−0
• tests/TBackend.hs +19/−0
• tests/TCodeOpt.hs +19/−0
• tests/TInterCode.hs +69/−0
• tests/TLexer.hs +40/−0
• tests/TPreProc.hs +19/−0
• tests/TSemAna.hs +20/−0
• tests/TSynAna.hs +32/−0
• tests/integration_tests +343/−0

@@ -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.

@@ -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 <Source.rail> -o output`+- You still need to link the stack manually if you want to have executables:+  `llvm-link <compiled.ll> 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

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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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)

@@ -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

@@ -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

@@ -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."

@@ -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)

@@ -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

@@ -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

@@ -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++; <label>:10                                      ; preds = %0+  %11 = load %struct.stack_elem** %3, align 8+  %12 = getelementptr inbounds %struct.stack_elem* %11, i32 0, i32 0+  store i32 1, i32* %12, align 4+  %13 = load i64* %new_long, align 8+  %14 = trunc i64 %13 to i32+  %15 = load %struct.stack_elem** %3, align 8+  %16 = getelementptr inbounds %struct.stack_elem* %15, i32 0, i32 1+  %17 = bitcast %union.anon* %16 to i32*+  store i32 %14, i32* %17, align 4+  store i32 0, i32* %1+  br label %39++; <label>:18                                      ; preds = %0+  %19 = load i8** %2, align 8+  %20 = call float @strtof(i8* %19, i8** %pEnd) #2+  store float %20, float* %new_float, align 4+  %21 = load i8** %pEnd, align 8+  %22 = load i8* %21, align 1+  %23 = sext i8 %22 to i32+  %24 = icmp eq i32 %23, 0+  br i1 %24, label %25, label %32++; <label>:25                                      ; preds = %18+  %26 = load %struct.stack_elem** %3, align 8+  %27 = getelementptr inbounds %struct.stack_elem* %26, i32 0, i32 0+  store i32 2, i32* %27, align 4+  %28 = load float* %new_float, align 4+  %29 = load %struct.stack_elem** %3, align 8+  %30 = getelementptr inbounds %struct.stack_elem* %29, i32 0, i32 1+  %31 = bitcast %union.anon* %30 to float*+  store float %28, float* %31, align 4+  store i32 0, i32* %1+  br label %39++; <label>:32                                      ; preds = %18+  %33 = load %struct.stack_elem** %3, align 8+  %34 = getelementptr inbounds %struct.stack_elem* %33, i32 0, i32 0+  store i32 3, i32* %34, align 4+  %35 = load i8** %2, align 8+  %36 = load %struct.stack_elem** %3, align 8+  %37 = getelementptr inbounds %struct.stack_elem* %36, i32 0, i32 1+  %38 = bitcast %union.anon* %37 to i8**+  store i8* %35, i8** %38, align 8+  store i32 0, i32* %1+  br label %39++; <label>:39                                      ; preds = %32, %25, %10+  %40 = load i32* %1+  ret i32 %40+}++@number2 = private unnamed_addr constant [2 x i8] c"5\00"+@number3 = private unnamed_addr constant [2 x i8] c"2\00"++define i32 @main_() {+ %pushingptr = getelementptr [14 x i8]* @pushing, i64 0, i64 0+ %poppedptr = getelementptr [13 x i8]* @popped, i64 0, i64 0++ call void @eof_check()+ %i1 = call i8*()* @pop()+ call i32(i8*, ...)* @printf(i8* %poppedptr, i8* %i1)++ call void @input()+ %i0 = call i8*()* @pop()+ call i32(i8*, ...)* @printf(i8* %poppedptr, i8* %i0)++ call void @input()+ %i2 = call i8*()* @pop()+ call i32(i8*, ...)* @printf(i8* %poppedptr, i8* %i2)++ ; push two numbers on the stack+ %number2 = getelementptr [2 x i8]* @number2, i64 0, i64 0+ %number3 = getelementptr [2 x i8]* @number3, i64 0, i64 0++ call i32(i8*, ...)* @printf(i8* %pushingptr, i8* %number2)+ call void(i8*)* @push(i8* %number2)++ call i32(i8*, ...)* @printf(i8* %pushingptr, i8* %number3)+ call void(i8*)* @push(i8* %number3)++ call void @underflow_check()+ %size0 = call i8*()* @pop()+ call i32(i8*, ...)* @printf(i8* %poppedptr, i8* %size0)++ call void @sub_int()+ %sum  = call i8*()* @pop()+ call i32(i8*, ...)* @printf(i8* %poppedptr, i8* %sum)++ call void @underflow_check()+ %size1 = call i8*()* @pop()+ call i32(i8*, ...)* @printf(i8* %poppedptr, i8* %size1)++ ret i32 0+}++; vim:sw=2 ts=2 et

@@ -0,0 +1,279 @@+{-# LANGUAGE DeriveDataTypeable#-}+module EditorBackend where++import Data.Typeable (Typeable)+import Data.List.Split (split,keepDelimsL,whenElt,splitWhen)+import Data.Data (Data,toConstr)+import Data.Maybe++-- !!!please dont create dependencies to this module without an announcement, because it is still in the creating and refactoring process!!!++-- Represents a charakter of a programm with the charakter (Char), his coordinate inside the function relative to the $ charakter and a Bool (for determine in the parsing process, whether the process already visited the field)+data Field = Field HighlightChar Bool deriving (Show,Eq)+-- Represents a function, with the name (String) and the Code ([[Field]])+data Function = Function String [[Field]] deriving (Show,Eq)+-- Represents a Programm, which is a set of Functions+data Programm = Programm [Function] deriving (Show,Eq)+-- Represents the next move of the 'train'+data Move = Allowed (Int,Int) | Forbidden (Int,Int) deriving (Show,Eq)+-- Represents the direction of the 'train'+data Direction = North | South | West | East | NorthWest | NorthEast | SouthWest | SouthEast deriving (Show,Eq)+-- Define Highlighting Classes for making highlight with an xml-config file possible in a later version (e.g. <MathOp color=#FF0011> ...)+data HighlightChar =  Undefined Char | MathOp Char | StringOp Char | Misc Char | Constant Char | FunctionUse Char | SystemOp Char | VariableOp Char | ListOp Char | Conditional Char | Rail Char | Cross Char | If Char | Mixed Char deriving (Show, Eq, Data, Typeable)++--begin: HighlightChar operations+fromHighlightChar :: HighlightChar -> Char+fromHighlightChar (Undefined c) = c+fromHighlightChar (MathOp c) = c+fromHighlightChar (StringOp c) = c+fromHighlightChar (Misc c) = c+fromHighlightChar (Constant c) = c+fromHighlightChar (FunctionUse c) = c+fromHighlightChar (SystemOp c) = c+fromHighlightChar (VariableOp c) = c+fromHighlightChar (ListOp c) = c+fromHighlightChar (Conditional c) = c+fromHighlightChar (Rail c) = c+fromHighlightChar (Cross c) = c+fromHighlightChar (If c) = c+fromHighlightChar (Mixed c) = c+--end: HighlightChar operations++--begin: Field operations+getFieldChar :: Field -> Char+getFieldChar (Field  hChar _) = fromHighlightChar hChar++getFieldVisited :: Field -> Bool+getFieldVisited (Field _ visited) = visited+--end: Field operations++--begin: Function operations+getFunctionFields :: Function -> [[Field]]+getFunctionFields (Function _ fields) = fields++getFunctionName :: Function -> String+getFunctionName (Function name _) = name+--end: Function operations++--begin: Programm operations+getProgrammFunctions :: Programm -> [Function]+getProgrammFunctions (Programm functions) = functions+--end: Programm operations++--begin: Move operations+isAllowed :: Move -> Bool+isAllowed (Forbidden _) = False+isAllowed (Allowed _) = True++fromAllowed :: Move -> (Int,Int)+fromAllowed (Allowed coord) = coord+--end: Move operations++--begin: Operations for converting code - Strings to the ADT 'Programm'+codeToProgramm :: [String] -> Programm+codeToProgramm content = Programm $ map getFunctionByContentChunk $ splitContentInChunks content++splitContentInChunks :: [String] -> [[String]]+splitContentInChunks content = filterEmptyElements $ (split . keepDelimsL . whenElt) isStartSymbol content+    where isStartSymbol line | null line = False+                             | otherwise = (\(x:xs) -> x == '$') line++filterEmptyElements :: [[String]] -> [[String]]+filterEmptyElements = map (filter (/="")).filter (/=[])++getFunctionByContentChunk :: [String] -> Function+getFunctionByContentChunk functionCode@(x:xs) = Function functioName $ readFunctionCodeToAdtFunction functionCode 0+    where functioName = splitWhen (=='\'') x !! 1++readFunctionCodeToAdtFunction :: [String] -> Int -> [[Field]]+readFunctionCodeToAdtFunction [] _ = []+readFunctionCodeToAdtFunction (e:es) lineCount = readStringToFieldList e (0,lineCount) :  readFunctionCodeToAdtFunction es (succ lineCount)++readStringToFieldList :: String -> (Int,Int) -> [Field]+readStringToFieldList [] _ = []+readStringToFieldList (e:es) (x,y) = Field (Undefined e) False : readStringToFieldList es (succ x,y)+--end: Operations for converting code - Strings to the ADT 'Programm'+--begin: Operations for modify and access 'Field' in a structure+getFieldByCoord :: [[Field]] -> (Int,Int) -> Field+getFieldByCoord fields (x,y) = (fields !! y) !! x++isVisited :: (Int,Int) -> Function -> Bool+isVisited (x,y) (Function _ fields) = b +           where (Field _ b) = getFieldByCoord fields (x,y)+++markAsVisited :: (Int,Int) -> Function -> Function+markAsVisited (x,y) (Function n fields) = Function n $ up ++ ((left ++ [Field e True] ++ tail right) : tail down)+           where (up,down) = splitAt y fields+                 (left,right) = splitAt x (head down)+                 (Field e _) = head right++setFieldAt :: Move -> Function -> Field -> Function+setFieldAt (Allowed (x,y)) (Function n fields) field = Function n $ up ++ ((left ++ [field] ++ tail right) : tail down)+           where (up,down) = splitAt y fields+                 (left,right) = splitAt x (head down)++--end: Operations for modify and access 'Field' in a structure+--begin: Functions to decide how the train will move+getNextMove :: (Int,Int) -> Direction -> Function -> Bool -> Move+getNextMove (x,y) direction (Function name fields) includeSecondaryBranch = case direction of+                North      -> getNorthMove (x,y) fields includeSecondaryBranch+                South      -> getSouthMove (x,y) fields includeSecondaryBranch+                West       -> getWestMove (x,y) fields includeSecondaryBranch+                East       -> getEastMove (x,y) fields includeSecondaryBranch+                NorthWest  -> getNorthWestMove (x,y) fields includeSecondaryBranch+                NorthEast  -> getNorthEastMove (x,y) fields includeSecondaryBranch+                SouthWest  -> getSouthWestMove (x,y) fields includeSecondaryBranch+                SouthEast  -> getSouthEastMove (x,y) fields includeSecondaryBranch++getNorthMove :: (Int,Int) -> [[Field]] -> Bool -> Move+getNorthMove (x,0) _ includeSecondaryBranch= Forbidden (x,0)+getNorthMove (x,1) _ includeSecondaryBranch= Forbidden (x,1)+getNorthMove (x,y) fields includeSecondaryBranch= Allowed (x,pred y)++getSouthMove :: (Int,Int) -> [[Field]] -> Bool -> Move+getSouthMove (x,y) fields includeSecondaryBranch+        | length fields <= y' = Forbidden (x,y)+        | otherwise = Allowed (x,y')+            where y' = succ y++getEastMove :: (Int,Int) -> [[Field]] -> Bool -> Move+getEastMove (x,y) fields includeSecondaryBranch+        | length (fields !! y) <= x' = Forbidden (x,y)+        | otherwise = Allowed (succ x,y)+            where x' = succ x++getWestMove :: (Int,Int) -> [[Field]] -> Bool -> Move+getWestMove (0,y) _ includeSecondaryBranch = Forbidden (0,y)+getWestMove (x,y) _ includeSecondaryBranch = Allowed (pred x,y)++{-+        Primary:    Secondary:      Secondary2:+          \            --\              |+           \                            \+-}+getNorthWestMove :: (Int,Int) -> [[Field]] -> Bool -> Move+getNorthWestMove (x,y) fields includeSecondaryBranch+        | primary /= ' ' = Allowed (x',y')+        | includeSecondaryBranch && (secondary `xor` secondary2) = Allowed (getSecondary secondary (x',y) secondary2 (x,y'))+        | otherwise = Forbidden (x,y)+            where x' = pred x+                  y' = pred y+                  primary | x <= 0 || y <= 1 || length (fields !! y') <= x' = ' '+                          | otherwise =getFieldChar $ getFieldByCoord fields (x',y')+                  secondary = secondaryChar == '-'+                  secondary2 = secondaryChar2 == '|'+                  secondaryChar | x == 0 = ' '+                            	| otherwise = getFieldChar $ getFieldByCoord fields (x',y)+                  secondaryChar2 | y <= 1 || length (fields !! y') <= x = ' '+                             	 | otherwise = getFieldChar $ getFieldByCoord fields (x,y')++{-+        Primary:     Secondary:      Secondary2:+           /             /-              |+          /                              /+-}++getNorthEastMove :: (Int,Int) -> [[Field]] -> Bool -> Move+getNorthEastMove (x,y) fields includeSecondaryBranch+        | primary /= ' ' = Allowed (x',y')+        | includeSecondaryBranch && (secondary `xor` secondary2) = Allowed (getSecondary secondary (x',y) secondary2 (x,y'))+        | otherwise = Forbidden (x,y)+            where x' = succ x+                  y' = pred y+                  primary | y <= 1 || length (fields !! y') <= x' = ' '+                          | otherwise = getFieldChar $ getFieldByCoord fields (x',y')+                  secondary = secondaryChar == '-'+                  secondary2 = secondaryChar2 == '|'+                  secondaryChar | length (fields !! y) <= x' = ' '+                            | otherwise = getFieldChar $ getFieldByCoord fields (x',y)+                  secondaryChar2 | y <= 1 || length (fields !! y') <= x = ' '+                             | otherwise = getFieldChar $ getFieldByCoord fields (x,y')+{-+     Primary:       Secondary:      Secondary2:+       /               -/               /+      /                                 |+-}++getSouthWestMove :: (Int,Int) -> [[Field]] -> Bool -> Move+getSouthWestMove (x,y) fields includeSecondaryBranch+        | primary /= ' ' = Allowed (x',y')+        | includeSecondaryBranch && (secondary `xor` secondary2) = Allowed (getSecondary secondary (x',y) secondary2 (x,y'))+        | otherwise = Forbidden (x,y)+           where x' = pred x+                 y' = succ y+                 primary | length fields <= y' || x == 0 = ' '+                         | otherwise = getFieldChar $ getFieldByCoord fields (x',y')+                 secondary = secondaryChar == '-'+                 secondary2 = secondaryChar2 == '|'+                 secondaryChar2 | length fields <= y' || length (fields !! y') <= x = ' '+                                | otherwise = getFieldChar $ getFieldByCoord fields (x,y')+                 secondaryChar | x == 0 = ' '+                               | otherwise = getFieldChar $ getFieldByCoord fields (x',y)++{-+    Primary:     Seondary:      Secondary2:+    \               \-              \+     \                              |+-}+getSouthEastMove :: (Int,Int) -> [[Field]] -> Bool -> Move+getSouthEastMove (x,y) fields includeSecondaryBranch+        | primary /= ' ' = Allowed (x',y')+        | includeSecondaryBranch && (secondary `xor` secondary2) = Allowed (getSecondary secondary (x',y) secondary2 (x,y'))+        | otherwise = Forbidden (x,y)+           where x' = succ x+                 y' = succ y+                 primary | length fields <= y' || length (fields !! y') <= x' = ' '+                         | otherwise = getFieldChar $ getFieldByCoord fields (x',y')+                 secondary = secondaryChar == '-'+                 secondary2 = secondaryChar2 == '|'+                 secondaryChar | length (fields !! y) <= x' = ' '+                               | otherwise = getFieldChar $ getFieldByCoord fields (x',y)+                 secondaryChar2 | length fields <= y' || (length (fields !! y') <= x) = ' '+                                | otherwise = getFieldChar $ getFieldByCoord fields (x,y')++getSecondary :: Bool -> (Int,Int) -> Bool -> (Int,Int) -> (Int,Int)+getSecondary secondary1 coord1 secondary2 coord2 +        | secondary1  = coord1+        | otherwise = coord2++getNewDirection :: Char -> Direction -> Direction+getNewDirection newChar oldDir+        | isJust newDir = fromJust newDir+        | otherwise = oldDir+    where dirMap = [((SouthEast,'-'),East),+                    ((SouthWest,'-'),West),+                    ((East,'/'),NorthEast),+                    ((West,'\\'),NorthWest),+                    ((East,'\\'),SouthEast),+                    ((West,'/'),SouthWest),+                    ((SouthEast,'|'),South),+                    ((NorthEast,'|'),North),+                    ((SouthWest,'|'),South),+                    ((NorthWest,'|'),North),+                    ((South,'/'),SouthWest),+                    ((South,'\\'),SouthEast),+                    ((North,'\\'),NorthWest),+                    ((North,'/'),NorthEast)]+          newDir = lookup (oldDir,newChar) dirMap++--end: Functions to decide how the train will move+xor :: Bool -> Bool -> Bool+xor a b = a /= b++goStep :: Move -> Function -> Direction -> (Move,Function,Direction)+goStep (Forbidden a) function dir  = (Forbidden a,function,dir)+goStep (Allowed (x,y)) function@(Function _ fields) dir = (nextCoord,visitedFunction,newDir)+            where visitedFunction = markAsVisited (x,y) function+                  nextCoord = getNextMove (x,y) dir visitedFunction True+                  newDir | isAllowed nextCoord = getNewDirection (getFieldChar(getFieldByCoord fields ( fromAllowed nextCoord))) dir+                         | otherwise = dir++exCode3 = ["$ 'main'"," \\","  \\","   \\----\\","         \\","         |","     #---/"]+exFunction3 = getFunction exCode3++exCode2 = ["$ 'main'"," \\ /----\\","  \\     |","   \\----/"]+exFunction2 = getFunction exCode2+getFunction code = e+    where (Programm (e:es)) = codeToProgramm code+

@@ -0,0 +1,13 @@+module Execute where++import Graphics.UI.Gtk+import System.Process+import System.Exit++-- Compiles the open file+compile :: Window --Main Window which contain the path to the open File+  -> IO (ExitCode,String,String)+compile window = do+  path <- get window windowTitle+  readProcessWithExitCode "dist/build/RailCompiler/RailCompiler" +    ["-c","-i",path,"-o",((reverse.(takeWhile(/='/')).reverse)path)] ""

@@ -0,0 +1,192 @@+module Main where++import Graphics.UI.Gtk+import Data.Map as Map+import Control.Monad.Trans (liftIO)+import Data.IORef+import Data.Maybe+import Menu+import TextArea+import Control.Concurrent++main :: IO()+main = do+    initGUI+    splashScreen <- getSplashScreen+    window <- windowNew+    label <- labelNewWithMnemonic "Hi" ++    bufferIn <- textBufferNew Nothing+    bufferOut <- textBufferNew Nothing+    bufferStackFunc <- textBufferNew Nothing+    bufferStackVar <- textBufferNew Nothing++    labelIn <- labelNewWithMnemonic "Input:"+    viewIn <- textViewNewWithBuffer bufferIn+    labelOut <- labelNewWithMnemonic "Output:"+    viewOut <- textViewNewWithBuffer bufferOut+    labelStackFunc <- labelNewWithMnemonic "Functionstack"+    viewStackFunc <- textViewNewWithBuffer bufferStackFunc+    labelStackVar <- labelNewWithMnemonic "Variablestack"+    viewStackVar <- textViewNewWithBuffer bufferStackVar++    buttonPopUpIn <- buttonNewWithLabel ""+    setButtonProps buttonPopUpIn+    buttonPopUpOut <- buttonNewWithLabel ""+    setButtonProps buttonPopUpOut+    buttonPopUpStackF <- buttonNewWithLabel ""+    setButtonProps buttonPopUpStackF+    buttonPopUpStackV <- buttonNewWithLabel ""+    setButtonProps buttonPopUpStackV++    layout <- layoutNew Nothing Nothing+    lwin <- scrolledWindowNew Nothing Nothing+    scrolledWindowSetPolicy lwin PolicyAutomatic PolicyAutomatic+    containerAdd lwin layout+    textArea <- textAreaNew layout 10 10++    onClicked buttonPopUpIn $ postGUIAsync $ textViewWindowShow bufferIn "Input"+    onClicked buttonPopUpOut $ postGUIAsync $ textViewWindowShow bufferOut "Output"+    onClicked buttonPopUpStackF $ postGUIAsync $ textViewWindowShow bufferStackFunc "Function-Stack"+    onClicked buttonPopUpStackV $ postGUIAsync $ textViewWindowShow bufferStackVar "Variable-Stack"++    hboxLabelButtonIn <- hBoxNew False 0+    boxPackStart hboxLabelButtonIn labelIn PackNatural 1+    boxPackEnd hboxLabelButtonIn buttonPopUpIn PackNatural 0++    hboxLabelButtonOut <- hBoxNew False 0+    boxPackStart hboxLabelButtonOut labelOut PackNatural 1+    boxPackEnd hboxLabelButtonOut buttonPopUpOut PackNatural 0++    hboxInfoLine <- hBoxNew False 0+    modeLabel <- labelNew $ Just "Mode: Replace"+    currentLabel <- labelNew $ Just "(0,0)"+    boxPackEnd hboxInfoLine currentLabel PackNatural 3+    boxPackStart hboxInfoLine modeLabel PackNatural 3++    boxStackFunc <- vBoxNew False 0+    hboxLabelButtonFunc <- hBoxNew False 0+    boxPackStart hboxLabelButtonFunc labelStackFunc PackNatural 0+    boxPackEnd hboxLabelButtonFunc buttonPopUpStackF PackNatural 10+    boxPackStart boxStackFunc hboxLabelButtonFunc PackNatural 0+    swinStackF  <- scrolledWindowNew Nothing Nothing+    scrolledWindowSetPolicy swinStackF PolicyAutomatic PolicyAutomatic+    containerAdd swinStackF viewStackFunc+    boxPackStart boxStackFunc swinStackF PackGrow 0++    boxStackVar <- vBoxNew False 0+    hboxLabelButtonVar <- hBoxNew False 0+    boxPackStart hboxLabelButtonVar labelStackVar PackNatural 0+    boxPackEnd hboxLabelButtonVar buttonPopUpStackV PackNatural 10+    boxPackStart boxStackVar hboxLabelButtonVar PackNatural 0+    swinStackV <- scrolledWindowNew Nothing Nothing+    scrolledWindowSetPolicy swinStackV PolicyAutomatic PolicyAutomatic+    containerAdd swinStackV viewStackVar+    boxPackStart boxStackVar swinStackV PackGrow 0++    boxStack <- hBoxNew True 0+    boxPackStart boxStack boxStackFunc PackGrow 2+    boxPackStart boxStack boxStackVar PackGrow 2++    boxView <- vBoxNew False 0+    boxLay <- hBoxNew False 0+    boxPackStart boxView hboxLabelButtonIn PackNatural 2+    swinIn <- scrolledWindowNew Nothing Nothing+    scrolledWindowSetPolicy swinIn PolicyAutomatic PolicyAutomatic+    containerAdd swinIn viewIn+    boxPackStart boxView swinIn PackGrow 0+    inSap <- hSeparatorNew+    boxPackStart boxView inSap PackNatural 2+    boxPackStart boxView hboxLabelButtonOut PackNatural 2+    swinOut <- scrolledWindowNew Nothing Nothing+    scrolledWindowSetPolicy swinOut PolicyAutomatic PolicyAutomatic+    containerAdd swinOut viewOut+    boxPackStart boxView swinOut PackGrow 1+    outSap <- hSeparatorNew+    boxPackStart boxView outSap PackNatural 2+    boxPackStart boxView boxStack PackGrow 1+    boxPackStart boxLay lwin PackGrow 1+    vSep <- vSeparatorNew+    boxPackStart boxLay vSep PackNatural 2+    boxPackEnd boxLay boxView PackNatural 1++    table <- tableNew 5 1 False++    menuBar <- createMenu window textArea bufferOut+    extraBar <- createExtraBar++    vSepa <- hSeparatorNew++    tableAttach table menuBar 0 1 0 1 [Fill] [Fill] 0 0+    tableAttach table extraBar 0 1 1 2 [Fill] [Fill] 0 0+    tableAttach table boxLay 0 1 2 3 [Expand,Fill] [Expand,Fill] 0 0+    tableAttach table vSepa 0 1 3 4 [Fill] [Fill] 0 0+    tableAttach table hboxInfoLine 0 1 4 5 [Fill] [Fill] 2 2++    set window [containerChild := table, windowDefaultHeight := 550, windowDefaultWidth := 850, windowWindowPosition := WinPosCenter]+    onDestroy window mainQuit+    widgetShowAll window+    widgetDestroy splashScreen+    mainGUI+    return ()++createExtraBar = do+    extraBar <- menuBarNew++    image <- imageNewFromStock stockExecute IconSizeMenu+    run <- imageMenuItemNewWithLabel ""+    imageMenuItemSetImage run image+    menuShellAppend extraBar run+    imageD <- imageNewFromStock stockGoForward IconSizeMenu++    debugg <- imageMenuItemNewWithLabel ""+    imageMenuItemSetImage debugg imageD+    menuShellAppend extraBar debugg++    mode <- menuNew+    replaceMode <- radioMenuItemNewWithLabel "replace"+    insertMode <- radioMenuItemNewWithLabelFromWidget replaceMode "insert"+    smartMode <- radioMenuItemNewWithLabelFromWidget replaceMode "smart"++    modeItem <- menuItemNewWithLabel "mode"+    menuItemSetSubmenu modeItem mode++    menuShellAppend extraBar modeItem++    menuShellAppend mode replaceMode+    menuShellAppend mode insertMode+    menuShellAppend mode smartMode+++    return extraBar++setButtonProps button = do+    image <- imageNewFromFile "full.png"+    buttonSetImage button image+    buttonSetImagePosition button PosRight++textViewWindowShow textBuffer title = do+    window <- windowNew+    windowSetDefaultSize window 400 300+    windowSetPosition window WinPosCenter+    swin <- scrolledWindowNew Nothing Nothing+    scrolledWindowSetPolicy swin PolicyAutomatic PolicyAutomatic+    textView <- textViewNewWithBuffer textBuffer+    containerAdd swin textView+    set window [containerChild := swin, windowTitle := title]+    widgetShowAll window+    return ()++getSplashScreen :: IO Window+getSplashScreen = do+    splashScreen <- windowNew+    set splashScreen [windowDefaultHeight := 200, windowDefaultWidth := 400, windowWindowPosition := WinPosCenter, windowTitle := "Starting Editor"]+    windowSetDefaultSize splashScreen 400 200 +    windowSetPosition splashScreen WinPosCenter+    layout <- layoutNew Nothing Nothing+    label <- labelNewWithMnemonic "Rail Editor starting ..."+    layoutPut layout label 30 30+    set splashScreen [containerChild := layout]+    widgetShowAll splashScreen+    return splashScreen+

@@ -0,0 +1,174 @@+module Menu where++import TextArea+import Execute+import Graphics.UI.Gtk+import qualified Control.Exception as Exc+import System.Exit+import Data.Maybe+import Control.Monad.IO.Class+import Data.List++{-TODO Refactor text to an 'link' to the entry text+  for the ability to save files+Handels the button press and open or saves a file+-}+fileChooserEventHandler :: Window +  -> TextArea+  -> FileChooserDialog +  -> ResponseId+  -> String+  -> IO()+fileChooserEventHandler window area fileChooser response mode+  |response == ResponseOk = do+    dir <- fileChooserGetFilename fileChooser+    let path = fromJust dir+    set window[windowTitle := path] +    case mode of+      "OpenFile" -> do+        content <- readFile path+        deserializeTextArea area content+        syntaxHighlighting area+        widgetDestroy fileChooser+        return()+      "SaveFile" -> do+        code <- (serializeTextAreaContent area)+        writeFile path code+        widgetDestroy fileChooser+        return()+  |response == ResponseCancel = do+    widgetDestroy fileChooser+    return ()+  |otherwise = return ()+  +--checking for a legal path in window title to save whitout dialog+saveFile :: Window -> TextArea -> IO Bool+saveFile window area = do+  code <- serializeTextAreaContent area +  dir <- get window windowTitle+  if "/" `isInfixOf` dir && not("/" `isSuffixOf` dir)+  then do+    writeFile dir code+    return True+  else fileDialog window area "SaveFile" >> return True++{-+TODO Refactor text to an 'link' to the entry text+for the ability to save files+Passes the enventhandler for fileDialog and starts it+-}+runFileChooser :: Window+  -> TextArea+  -> FileChooserDialog+  -> String+  -> IO()+runFileChooser window area fileChooser mode = do+  on fileChooser response hand+  dialogRun fileChooser+  return()+  where +    hand resp = fileChooserEventHandler window area fileChooser resp mode++{-+Setup a file chooser with modes OpenFile and SaveFile+TODO Refactor text to an 'link' to the entry text+for the ability to save files+-}+fileDialog :: Window+  -> TextArea+  -> String+  -> IO()+fileDialog window area mode = do+  case mode of+    "OpenFile" -> do+      fileChooser <- fileChooserDialogNew +        (Just mode)+        (Just window)+        FileChooserActionOpen+        [("open",ResponseOk),("cancel",ResponseCancel)]+      runFileChooser window area fileChooser mode+    "SaveFile" -> do+      fileChooser <- fileChooserDialogNew+        (Just mode)+        (Just window)+        FileChooserActionSave+        [("save",ResponseOk),("cancel",ResponseCancel)]+      fileChooserSetDoOverwriteConfirmation fileChooser True+      runFileChooser window area fileChooser mode+  return ()+  ++{-+TODO Refactor text to an 'link' to the entry text+for the ability to save files+Setups the menu+-}+createMenu :: Window+  -> TextArea+  -> TextBuffer+  -> IO MenuBar+createMenu window area output= do+  menuBar <- menuBarNew-- container for menus++  menuFile <- menuNew+  menuHelp <- menuNew++  menuFileItem <- menuItemNewWithLabel "File"+  menuOpenItem <- menuItemNewWithLabel "open crtl+o"+  menuSaveItem <- menuItemNewWithLabel "save ctrl+s"+  menuCloseItem <- menuItemNewWithLabel "quit ctrl+s"+  menuCompileItem <- menuItemNewWithLabel "compile ctrl+F5"+  menuHelpItem <- menuItemNewWithLabel "Help"+  menuAboutItem <- menuItemNewWithLabel "About"+  --Bind the subemenu to menu+  menuItemSetSubmenu menuFileItem menuFile+  menuItemSetSubmenu menuHelpItem menuHelp+  --File and Help menu+  menuShellAppend menuBar menuFileItem+  menuShellAppend menuBar menuHelpItem+  --Insert items in menus+  menuShellAppend menuFile menuOpenItem+  menuShellAppend menuFile menuSaveItem+  menuShellAppend menuFile menuCloseItem+  menuShellAppend menuFile menuCompileItem+  menuShellAppend menuHelp menuAboutItem+  --setting actions for the menu+  on menuOpenItem menuItemActivate (fileDialog +    window +    area+    "OpenFile")+  on menuSaveItem menuItemActivate (saveFile+    window+    area >> return())+  on menuCloseItem menuItemActivate mainQuit+  on menuCompileItem menuItemActivate +    (compileOpenFile window area output >> return ())+  --setting shortcuts in relation to menuBar+  on window keyPressEvent $ do+    modi <- eventModifier+    key <- eventKeyName+    liftIO $ case modi of+      [Control] -> case key of+        "q" -> mainQuit >> return True+        "s" -> saveFile window area  >> return True+        "o" -> fileDialog+          window+          area+          "OpenFile" >> return True+        "F5" -> compileOpenFile window area output+        _ -> return False+      _ -> return False+  return menuBar++compileOpenFile ::Window+  -> TextArea+  -> TextBuffer +  -> IO Bool+compileOpenFile window area output = do+  textBufferSetText output "Compiling Execute"+  (exitCode,out,err) <-compile window+  if exitCode == (ExitSuccess)+  then textBufferSetText output "Compiling succsessful"+  else textBufferSetText output ("Compiling failed: "++['\n']++err)+  return True+

@@ -0,0 +1,614 @@+module TextArea where++import Lexer+import Preprocessor as Pre+import InterfaceDT as IDT+import Graphics.UI.Gtk+import Data.Map as Map+import Control.Monad.Trans (liftIO)+import qualified Control.Exception as Exc+import System.IO+import Data.IORef+import Data.Maybe+import Data.Either++data EntryMode = LeftToRight | UpToDown | Smart deriving (Eq)+--textArea is a pointer to: +data TextArea = TextArea +  Layout +  (IORef (Int,Int)) --pointer to current selected entry+  (IORef (Map.Map (Int,Int) Entry)) {-pointer to hashmap of entrys with +  (x,y) coords as key starting by (0,0)-}+  (IORef (Int,Int)) --pointer to the  size of the textArea++--returns the layout+getLayout (TextArea layout _ _ _) = layout++--returns a point to the current selected entry+getPointerToCurrentInFocus (TextArea _ current _ _) = current++--returns a pointer to hashmap of entrys+getPointerToEntryMap (TextArea _ _ map _) = map+--returns a pointer to the textArea size+getPointerToSize (TextArea _ _ _ size) = size++--returns the grid2D from a IDT.IPL grid2D+getGrid2dFromPreProc2Lexer(IDT.IPL grid2D) = grid2D++-- creates a new textArea+textAreaNew :: Layout  -- the layout which entrys would be placed on+  -> Int --number of entrys in width+  -> Int --numer of entry in height+  -> IO TextArea --A textArea ready for writing+textAreaNew layout x y = do+  currentInFocus <- newIORef (0,0)+  hashMap <- newIORef Map.empty+  size <- newIORef (0,0)+  let area =  TextArea layout currentInFocus hashMap size+  createTextArea area x y+  return area++--Subfunction of textAreaNew which invokes the entry-creation+createTextArea :: TextArea --the empty textArea+  -> Int --number of entrys in width+  -> Int --numer of entry in height+  -> IO()+createTextArea area@(TextArea layout current hmap size) x y = do+  createTextAreaH area 0 (pred x) 0 (pred y)+  writeIORef size (x-1,y-1)+  return ()++--Subfunction of createTextArea. This fct creates the lines of textArea+createTextAreaH :: TextArea+  -> Int--current x coord in textArea+  -> Int--max x coord in textArea+  -> Int--current y coord in textArea+  -> Int--max y coord in textArea+  -> IO()+createTextAreaH area@(TextArea _ _ _ size) xnr xnrS ynr ynrS = do+  (maxX,maxY) <- readIORef size+  if xnr == xnrS && ynr == ynrS+  then entryInsert area xnrS xnrS+  else if xnr == xnrS && ynr < ynrS+  then do+    entryInsert area  xnr ynr--inserts the textEntry+    createTextAreaH area 0 xnrS (succ ynr) ynrS+  else do+    entryInsert area xnr ynr--inserts the textEntry+    createTextAreaH area (succ xnr) xnrS ynr ynrS++--function to react on a "Return" keypress+handleReturn area@(TextArea layout current hMap size)x y = do+  hmap <- readIORef hMap+  let nextEntry = Map.lookup (0,y+1) hmap+  if isNothing nextEntry+  then do+    (xm,ym) <- readIORef size+    expandYTextArea area xm ym+    hmap <- readIORef hMap+    let nEntry = fromJust $ Map.lookup (0,y+1) hmap+    widgetGrabFocus nEntry+    return True+  else do+    let nEntry = fromJust nextEntry+    widgetGrabFocus nEntry+    return True++--function to react on a "Left-Arrow" keypress+handleLeft area@(TextArea layout current hMap size)x y = do+  hmap <- readIORef hMap+  let prevEntry = Map.lookup (x-1,y) hmap+  if isJust prevEntry+  then do+    widgetGrabFocus (fromJust prevEntry)+    return True+  else do+    (xm,ym) <- readIORef size+    if y>0+    then do+      widgetGrabFocus $ fromJust $ Map.lookup (xm, y-1) hmap+      return True+    else return False++--function to react on a "Right-Arrow" keypress+handleRight area@(TextArea layout current hMap size)x y = do+  hmap <- readIORef hMap+  let nextEntry = Map.lookup (x+1,y) hmap+  if isJust nextEntry+  then do+    widgetGrabFocus $ fromJust nextEntry+    return True+  else do+    (xm,ym) <- readIORef size+    if y<ym+    then do+      widgetGrabFocus $ fromJust $ Map.lookup (0, y+1) hmap+      return True+    else return False++--function to react on a "Up-Arrow" keypress+handleUp area@(TextArea layout current hMap size) x y = do+  hmap <- readIORef hMap+  let nextEntry = Map.lookup (x,y-1) hmap+  if isJust nextEntry+  then do+    widgetGrabFocus $ fromJust nextEntry+    return True+  else return False++--function to react on a "Down-Arrow" keypress+handleDown area@(TextArea layout current hMap size) x y = do+  hmap <- readIORef hMap+  let nextEntry = Map.lookup (x,y+1) hmap+  if isJust nextEntry+  then do+    widgetGrabFocus $ fromJust nextEntry+    return True+  else return False++--function to react on a "Tab" keypress+handleTab area@(TextArea layout current hMap size)x y = do+  hmap <- readIORef hMap+  let nextEntry = Map.lookup (x+4,y) hmap+  if isNothing nextEntry+  then do+    (xm,ym) <- readIORef size+    expandXTextAreaN area xm ym 4+    hmap <- readIORef hMap+    let nEntry = fromJust $ Map.lookup (x+4,y) hmap+    widgetGrabFocus nEntry+    return True+  else do+    let nEntry = fromJust nextEntry+    widgetGrabFocus nEntry+    return True++--function to react on a "Backspace" keypress    +handleBackspace area@(TextArea layout current hMap size) entry x y = do+  hmap <- readIORef hMap+  let prevEntry = Map.lookup (x-1,y) hmap+  thisChar <- entryGetText entry+  if thisChar /= ""+  then do+    set entry [entryText := ""]+    return False+  else+    if isJust prevEntry+    then do+      entrySetText (fromJust prevEntry) ""+      widgetGrabFocus (fromJust prevEntry)+      return True+    else do+      (xm,ym) <- readIORef size+      if y>0+      then do+        widgetGrabFocus $ fromJust $ Map.lookup (xm, y-1) hmap+        return True+      else return False++--Inserts a new entry to the textArea and sets up its keypressHandler+entryInsert :: TextArea+  -> Int --x coord to insert+  -> Int --y coord to insert+  -> IO()+entryInsert area@(TextArea layout current hMap size) x y = do+  --creation and config and insert+  entry <- entryNew+  set entry [entryWidthChars := 1, entryText := " "]+  entrySetMaxLength entry 1+  entrySetHasFrame entry False+  layoutPut layout entry (x*12) (18*y+20)+  hamp <- readIORef hMap+  let hMapN = Map.insert (x,y) entry hamp+  writeIORef hMap hMapN+  --Handler setup+  entry `on` focusInEvent $ tryEvent $ liftIO $ writeIORef current (x,y)+  --KeyEventHandler gets a anonymus function+  on entry keyPressEvent $ do +    key <- eventKeyName+    val <- eventKeyVal+    liftIO $ do+      --Just keyhandling and expanding the entry if full+      if isJust (keyToChar val)+      then do+        set entry [entryText := (+          if isNothing (keyToChar val)+          then "" +          else [fromJust $ keyToChar val])]+        hmap <- readIORef hMap+        let nextEntry = Map.lookup (x+1,y) hmap+        if isNothing nextEntry+        then do+          (xm,ym) <- readIORef size+          expandXTextArea area xm ym+          hmap <- readIORef hMap+          let nEntry = fromJust $ Map.lookup (x+1,y) hmap+          widgetGrabFocus nEntry+          return True+        else do+          let nEntry = fromJust nextEntry+          widgetGrabFocus nEntry+          return True+        else case key of+          "Return" -> handleReturn area x y+          "Left" -> handleLeft area x y+          "Right" -> handleRight area x y+          "Tab" -> handleTab area x y+          "BackSpace" -> handleBackspace area entry x y+          "Up" -> handleUp area x y+          "Down" -> handleDown area x y+          _ -> return False+      --Syntaxhighlighting starts here+      syntaxHighlighting area+      return True   +  return ()++--Handler to catch errors from Preprocessor.hs+handler :: Exc.ErrorCall -> IO ()+handler _ = putStrLn "No main function"++syntaxHighlighting area@(TextArea layout current hMap size) = do+  (code,indexes) <- serializeIt area (0,0) ("",[])+  Exc.catch (do+    let grid2D = getGrid2dFromPreProc2Lexer $ Pre.process  (IIP code)+    (xm,ym) <- readIORef size+    paintItRed area 0 0 xm ym+    changeColorOfCurrentEntry area (Color 65535 0 0)+    --print"new Lexerturn"+    highlightFcts area grid2D indexes +    return ()) handler++-- this is needed to clear the textArea+clearTextArea area = do+    hmap <- readIORef $ getPointerToEntryMap area+    let list = toList hmap+    mapM_ (\(_,entry) -> set entry [entryText := ""]) list+    return ()++-- maps string to textArea content+deserializeTextArea area string = do+    clearTextArea area+    expandTextAreaTo area newX newY+    readStringListInEntryMap (getPointerToEntryMap area) lined (0,0)+    where newX = maximum $ Prelude.map length lined+          newY = length lined+          lined = lines string++-- help function for deserialization+readStringListInEntryMap _ [] _ = return ()+readStringListInEntryMap hmap (e:es) (x,y) = do+    readStringInEntryMap hmap e (0,y)+    readStringListInEntryMap hmap es (0,(y+1));++-- help function for deserialization+readStringInEntryMap _ [] _ = return ()+readStringInEntryMap hmap (s:ss) (x,y) = do+    entryMap <- readIORef hmap+    let entry = fromJust $ Map.lookup (x,y) entryMap+    set entry [entryText := [s]]+    readStringInEntryMap hmap ss (succ x,y)++-- this is needed to expand the textArea to x y+expandTextAreaTo area newX newY = do+    let sizePtr = getPointerToSize area+    (x,y) <- readIORef sizePtr+    let xDelta = newX-x+    let yDelta = newY-y+    expandXTextAreaN area x y xDelta+    expandYTextAreaN area x y yDelta++--this is needed to expand the textArea in y n times(#line times) +expandYTextAreaN area oldX oldY n+  | n <= 0 = return ()+  | otherwise = do+    expandYTextArea area oldX oldY+    expandYTextAreaN area oldX (succ oldY) (n-1)++--this is needed to expand the textArea in x n times(#line times) +expandXTextAreaN area oldX oldY n+  | n == 0 = return ()+  | otherwise = do+    expandXTextArea area oldX oldY+    expandXTextAreaN area (succ oldX) oldY (n-1)++--Subfunction of expandXTextAreaN +expandXTextArea area@(TextArea layout current hMap size) oldX oldY= do+  expandXTextAreaH area oldX oldY+  (xmax,ymax) <- readIORef size+  writeIORef size (succ xmax,ymax)++--insert the new entrys at the end of a line+expandXTextAreaH area@(TextArea _ _ hMap _) oldX oldY = +  if oldY == 0+  then do+    entryInsert area (succ oldX) 0+    hmap <- readIORef hMap+    let newEntry = fromJust $ Map.lookup (succ oldX,oldY) hmap+    widgetShow newEntry+  else do+    entryInsert area (succ oldX) oldY+    hmap <- readIORef hMap+    let newEntry = fromJust $ Map.lookup (succ oldX,oldY) hmap+    widgetShow newEntry+    expandXTextAreaH area oldX (pred oldY)++--this is needed to expand the textArea in y (newline)+expandYTextArea area@(TextArea layout current hMap size) oldX oldY= do+  expandYTextAreaH area oldX oldY+  (xmax,ymax) <- readIORef size+  writeIORef size (xmax,succ ymax)++--Insert a new line+expandYTextAreaH area@(TextArea _ _ hMap _) oldX oldY = +  if oldX == 0+  then do+    entryInsert area 0 (succ oldY)+    hmap <- readIORef hMap+    let newEntry = fromJust $ Map.lookup (oldX,succ oldY) hmap+    widgetShow newEntry+  else do+    entryInsert area oldX (succ oldY)+    hmap <- readIORef hMap+    let newEntry = fromJust $ Map.lookup (oldX,succ oldY) hmap+    widgetShow newEntry+    expandYTextAreaH area (pred oldX) oldY++--This overwrites the entry text with "" at (x,y)+clearEntryByCoord :: TextArea+  -> (Int,Int)--coord+  -> IO()+clearEntryByCoord (TextArea _ _ hMap _) (x,y) = do+  hashMap <- readIORef hMap+  let mayEntry = Map.lookup (x,y) hashMap+  if isJust mayEntry+  then do+    let entry = fromJust mayEntry+    set entry [entryText := ""]+  else return ()+--This overwrites the current entry text with ""+clearCurrentEntry :: TextArea -> IO()+clearCurrentEntry (TextArea _ current hMap _) = do+  currentCoord <- readIORef current+  hashMap <- readIORef hMap+  let currentEntry = fromJust $ Map.lookup currentCoord hashMap+  set currentEntry [entryText := ""]++--changes the foreground color of the entry at (x,y) in textArea+changeColorOfEntryByCoord :: TextArea +  -> (Int,Int)--coord+  -> Color--r g b range from 0 (low -)to 65535 (highest intensity)+  -> IO()+changeColorOfEntryByCoord (TextArea _ _ hMap _) (x,y) color = do+  hashMap <- readIORef hMap+  let mayEntry = Map.lookup (x,y) hashMap+  if isJust mayEntry+  then do+    let entry = fromJust mayEntry+    widgetModifyText entry StateNormal color+  else return ()++--changes the foreground color of the current entry in textArea+changeColorOfCurrentEntry :: TextArea +  -> Color--r g b range from 0 (low -)to 65535 (highest intensity)+  -> IO()+changeColorOfCurrentEntry (TextArea _ current hMap _) color = do+  currentCoord <- readIORef current+  hashMap <- readIORef hMap+  let currentEntry = fromJust $ Map.lookup currentCoord hashMap+  widgetModifyText currentEntry StateNormal color++-- colors all entry red in a rect from x,y to xMax,yMax+-- This function is needed to recolor after editing+paintItRed :: TextArea +  -> Int-- x coord start+  -> Int--y coord str+  -> Int--x coord end+  -> Int--y coord end+  -> IO()+paintItRed textArea x y xMax yMax= do+  map <- readIORef $ getPointerToEntryMap textArea+  let entry = Map.lookup (x,y) map+  case entry of+    Nothing -> return ()+    _ ->+      if x == (xMax-1) && y == (yMax-1)+      then do+        widgetModifyText (fromJust entry) StateNormal red+        return ()+      else+        if x == (xMax-1)+        then do+          widgetModifyText (fromJust entry) StateNormal red+          paintItRed textArea 0 (y+1) xMax yMax+        else do+          widgetModifyText (fromJust entry) StateNormal red+          paintItRed textArea (x+1) y xMax yMax+  return ()+  where red = Color 65535 0 0+  +-- highlight all rail-functions+highlightFcts :: TextArea+  -> [Grid2D]-- List of funtions in line-representation  +  -> [Int]-- start indexes of function(y coord of textArea) +  -> IO IP+highlightFcts area [] _ = return crash+highlightFcts area _ [] = return crash+highlightFcts area (x:xs) (y:ys) = do+  highlight area x start y+  highlightFcts area xs ys+  +{- to do different colors+ main highlighting process which highlights a single rail-function.+ Colors:+   comments : red+   $ : orange+   rails : black+   built in function blue+   constans green+-}+highlight :: TextArea+  -> Grid2D+  -> IP+  -> Int+  -> IO IP+highlight _ [] _ _ = return crash+highlight textArea grid2D ip yOffset = do+  print "step"+  print $ show ip+  case ip == crash of+   True -> return ip+   _ -> do+    (lex, parseIP)<- return $ parse grid2D ip+    print "parsedIp"+    print (show parseIP)+    case lex of+      Just NOP              -> changeColorOfEntryByCoord textArea (xC,yC) blue+      Just Boom             -> changeColorOfEntryByCoord textArea (xC,yC) blue+      Just EOF              -> changeColorOfEntryByCoord textArea (xC,yC) blue+      Just Input            -> changeColorOfEntryByCoord textArea (xC,yC) blue+      Just Output           -> changeColorOfEntryByCoord textArea (xC,yC) blue+      Just IDT.Underflow    -> changeColorOfEntryByCoord textArea (xC,yC) blue+      Just RType            -> changeColorOfEntryByCoord textArea (xC,yC) blue+      Just (Constant str)    -> do+        if [(current grid2D parseIP)] == "]" || +          [(current grid2D parseIP)] == "["+        then do+          colorMoves textArea grid2D (length str+2)+            (turnaround parseIP) green+          highlight textArea grid2D (step grid2D parseIP)yOffset+        else do+          changeColorOfEntryByCoord textArea (xC,yC) green+          highlight textArea grid2D (step grid2D parseIP)yOffset+       +        return ()+      Just (Push str)-> do+        colorMoves textArea grid2D (length str+2)+          (turnaround parseIP) blue+        highlight textArea grid2D (step grid2D parseIP)yOffset+        return ()+      Just (Pop str) -> do+        colorMoves textArea grid2D (length str+4)+          (turnaround parseIP) blue+        highlight textArea grid2D (step grid2D parseIP)yOffset+        return ()+      Just (Call str) -> do+        colorMoves textArea grid2D (length str+2)+          (turnaround parseIP) blue+        highlight textArea grid2D (step grid2D parseIP)yOffset+        return ()+      Just Add1             -> changeColorOfEntryByCoord textArea (xC,yC) blue+      Just Divide           -> changeColorOfEntryByCoord textArea (xC,yC) blue+      Just Multiply         -> changeColorOfEntryByCoord textArea (xC,yC) blue+      Just Subtract         -> changeColorOfEntryByCoord textArea (xC,yC) blue+      Just Remainder        -> changeColorOfEntryByCoord textArea (xC,yC) blue+      Just Cut              -> changeColorOfEntryByCoord textArea (xC,yC) blue+      Just Append           -> changeColorOfEntryByCoord textArea (xC,yC) blue+      Just Size             -> changeColorOfEntryByCoord textArea (xC,yC) blue+      Just Nil              -> changeColorOfEntryByCoord textArea (xC,yC) blue+      Just Cons             -> changeColorOfEntryByCoord textArea (xC,yC) blue+      Just Breakup          -> changeColorOfEntryByCoord textArea (xC,yC) blue+      Just Greater          -> changeColorOfEntryByCoord textArea (xC,yC) blue+      Just Equal            -> changeColorOfEntryByCoord textArea (xC,yC) blue+      Just Start            -> changeColorOfEntryByCoord textArea (xC,yC) gold+      Just Finish           -> changeColorOfEntryByCoord textArea (xC,yC) gold+      Just (Junction _) -> do+        changeColorOfEntryByCoord textArea (xC,yC) gold+        (falseIP,trueIP) <- return $ junctionturns grid2D parseIP+        print "junction"+        print(show falseIP)+        print(show trueIP)+        highlight textArea grid2D falseIP yOffset+        highlight textArea grid2D trueIP yOffset+        return ()+      Nothing               -> changeColorOfEntryByCoord textArea (xC,yC) black+    case lex of+      Just (Junction 0) -> return crash+      Just (Push _) -> return crash+      Just (Pop _) -> return crash+      Just (Call _) -> return crash+      Just (Constant _) -> return crash +      _ -> do+        let nexIP = step grid2D parseIP+        highlight textArea grid2D nexIP yOffset+    where+      xC = posx ip+      yC = posy ip+yOffset+      blue = Color 2478 13810 63262+      green = Color 3372 62381 5732+      gold = Color 65535 30430 0+      black = Color 0 0 0+      {- moves the grid and colors the entrys used to handel Push Pop+        and Call+      -}+      colorMoves :: TextArea -> Grid2D -> Int -> IP -> Color -> IO IP+      colorMoves _ _ 0  _ _ = return crash+      colorMoves area grid2D stepsBack ip color = do+        changeColorOfEntryByCoord area (posx ip,posy ip+yOffset) color+        colorMoves area grid2D (stepsBack-1) (move ip Forward) color+        return crash+        +++{-Serializes the code and delets whitespaces at the end of lines.+  It also returns the y coord of $ of functions+-}+serializeIt :: TextArea +  -> (Int,Int)+  -> (String,[Int])+  -> IO(String,[Int])+serializeIt textArea (w,h) (code,indexes) = do+  (x,y) <-  readIORef $ getPointerToSize textArea+  if h > y then return (code, indexes) else+    (do+      map <- readIORef $ getPointerToEntryMap textArea+      line <- serializeItHelp map (w,h) (x,y) ""+      let clearLine = (reverse.dropWhile(==' ').reverse) line+      serializeIt textArea (0, h + 1)+        (if not (Prelude.null clearLine) && head clearLine == '$' then+            (code ++ (line ++ "\n"), indexes ++ [h]) else+            (code ++ (line ++ "\n"), indexes)))++serializeItHelp :: Map (Int,Int) Entry+  -> (Int,Int)+  -> (Int,Int)+  -> String+  -> IO String+serializeItHelp map (w,h) (xMax,yMax) line = +  if w >= xMax then return line else+    (do+      let elem = Map.lookup (w,h) map+      if isNothing elem then+        serializeItHelp map (w+1,h) (xMax,yMax) (line++" ") else+        (do+          let entry = fromJust elem+          content <- entryGetText entry+          serializeItHelp map (w+1,h) (xMax,yMax) (line++content)))++serializeTextAreaContent area@(TextArea layout current hMap size) = do+  hmap <- readIORef hMap+  let list = toList hmap+  let sortedList = quicksort list+  result <- listToString sortedList [] 0+  let rightOrder = unlines $ Prelude.filter (/="") $ Prelude.map (reverse . dropWhile (== ' ') . reverse) (lines $ reverse result)+  return rightOrder+    where+      quicksort :: [((Int,Int),Entry)] -> [((Int,Int),Entry)]+      quicksort [] = []+      quicksort (x:xs) = quicksort [a | a <- xs, before a x] ++ [x] ++ quicksort [a | a <- xs, not $ before a x]++      listToString :: [((Int,Int),Entry)] -> String -> Int -> IO String+      listToString list akku beforeY = +        if Prelude.null list+        then return akku+        else do+          text <- entryGetText (snd $ head list)+          let (x,y) = fst $ head list+          if y > beforeY+          then listToString (tail list) (headE text : '\n' : akku) y+          else listToString (tail list) (headE text : akku) y++      headE a | length a == 0 = ' '+              | otherwise = head a++      before :: ((Int,Int),Entry) -> ((Int,Int),Entry) -> Bool+      before ((a,b),_) ((c,d),_) = b < d || (b == d && a <= c)

@@ -0,0 +1,39 @@+module Main(main) where++-- imports --+import Test.HUnit+import InterfaceDT                   as IDT+import qualified TPreProc+import qualified TLexer+import qualified TSynAna+import qualified TSemAna+import qualified TInterCode+import qualified TCodeOpt+import qualified TBackend++import System.Exit+import System.Process++-- returns an appropriate ExitCode+getExitCode :: Counts -> ExitCode+getExitCode Counts { errors = 0, failures = 0 } = ExitSuccess+getExitCode _ = ExitFailure 1++main :: IO ()+main = do+  counts <- runTestTT $ TestList (+    TPreProc.testModule +++    TLexer.testModule +++    TSynAna.testModule +++    TSemAna.testModule +++    TInterCode.testModule +++    TCodeOpt.testModule +++    TBackend.testModule+    )+  testexit <- system "tests/integration_tests"+  exitWith $ addexits testexit $ getExitCode counts++addexits :: ExitCode -> ExitCode -> ExitCode+addexits ExitSuccess ExitSuccess = ExitSuccess+addexits _ (ExitFailure _) = ExitFailure 1+addexits (ExitFailure _) _ = ExitFailure 1

@@ -0,0 +1,19 @@+module TBackend (+                    testModule     -- tests the module Backend+                   )+ where++ -- imports --+ import Test.HUnit+ import InterfaceDT                   as IDT+ import qualified Backend++ -- functions --+ -- testBackend01 = "Backend: " ~: (erwarteter wert) @=? (Backend.process eingabe)+ -- testBackend02 = "Backend: " ~: (erwarteter wert) @=? (Backend.process eingabe)+ -- testBackend03 = "Backend: " ~: (erwarteter wert) @=? (Backend.process eingabe)+ -- testBackend04 = "Backend: " ~: (erwarteter wert) @=? (Backend.process eingabe)+ -- testBackend05 = "Backend: " ~: (erwarteter wert) @=? (Backend.process eingabe)+ -- ...+ + testModule = [] -- [testBackend01,testBackend02,testBackend03,testBackend04,testBackend05]

@@ -0,0 +1,19 @@+module TCodeOpt (+                    testModule     -- tests the module CodeOptimization+                   )+ where++ -- imports --+ import Test.HUnit+ import InterfaceDT                   as IDT+ import qualified CodeOptimization    as CodeOpt++ -- functions --+ -- testCodeOpt01 = "CodeOptimization: " ~: (erwarteter wert) @=? (CodeOpt.process eingabe)+ -- testCodeOpt02 = "CodeOptimization: " ~: (erwarteter wert) @=? (CodeOpt.process eingabe)+ -- testCodeOpt03 = "CodeOptimization: " ~: (erwarteter wert) @=? (CodeOpt.process eingabe)+ -- testCodeOpt04 = "CodeOptimization: " ~: (erwarteter wert) @=? (CodeOpt.process eingabe)+ -- testCodeOpt05 = "CodeOptimization: " ~: (erwarteter wert) @=? (CodeOpt.process eingabe)+ -- ...+ + testModule = [] -- [testCodeOpt01,testCodeOpt02,testCodeOpt03,testCodeOpt04,testCodeOpt05]

@@ -0,0 +1,69 @@+module TInterCode (testModule) where++ -- imports --+import Test.HUnit+import InterfaceDT                   as IDT+import qualified IntermediateCode    as InterCode++-- exmaple test function --+-- testInterCode01 = "IntermediateCode: " ~: (expected value) @=? (InterCode.process input)++-- working "Hello World" program+input01 = ISI [("main", [(1,[Start, Constant "Hello World!", Output, Finish],0)])]++-- NEGATIVE++-- empty path+input02 = ISI []+-- points to non-existent path+input03 = ISI [("main", [(1,[Start, Finish],99)])]+-- wrong starting ID+input04 = ISI [("main", [(99,[Start, Finish],0)])]+-- empty string as function name+input05 = ISI [("", [(1,[Start, Finish],0)])]+-- circle: 1 > 2 > 1+input06 = ISI [("main", [(1,[Start, Finish],2)]),("foo", [(2,[Start, Finish],1)])]++-- POSITIVE++-- empty main function+input07 = ISI [("main", [(1,[Start, Finish],0)])]++-- outputs +output = ISI []++-- incorrect output to produce failures and be able to view the actual output of the module+testInterCode01 = "IntermediateCode: " ~:+  InterCode.process input01 @=? InterCode.process input01++testInterCode02 = "IntermediateCode: " ~:+  InterCode.process output @=? InterCode.process input02++testInterCode03 = "IntermediateCode: " ~:+  InterCode.process output @=? InterCode.process input03++testInterCode04 = "IntermediateCode: " ~:+  InterCode.process output @=? InterCode.process input04++testInterCode05 = "IntermediateCode: " ~:+  InterCode.process output @=? InterCode.process input05++testInterCode06 = "IntermediateCode: " ~:+  InterCode.process output @=? InterCode.process input06++testInterCode07 = "IntermediateCode: " ~:+  InterCode.process output @=? InterCode.process input07++--testModule = []+testModule = [+        TestLabel "Hello World" testInterCode01,+        TestLabel "empty path" testInterCode02+-- TODO: Are these really our responsibility?+--        TestLabel "non-existent path" testInterCode03,+--        TestLabel "wrong start ID" testInterCode04,+--        TestLabel "empty function name" testInterCode05,+--+-- TODO: Fix expected results.+--        TestLabel "circle" testInterCode06,+--        TestLabel "empty main" testInterCode07+    ]

@@ -0,0 +1,40 @@+module TLexer (+               testModule     -- tests the module Lexer+              )+ where++ -- imports --+ import Test.HUnit+ import InterfaceDT                   as IDT+ import qualified Lexer++ -- functions --+ testLexer01 = "Proper turning: " ~: res [Constant "1"] @=? run [" \\", "  \\   /-t-#", "   ---/--f-#"]+ testLexer02 = "Reflection: " ~: res [Constant "1"] @=? run [" \\", "  \\   #  #  #", "   \\   f f f", "    \\   \\|/", " #t-------@-f#", "         /|\\", "        f f f", "       #  #  #"]+ testLexer03 = "Rail crash: " ~: crash @=? run [" /", "#"]+ testLexer04 = "One liner: " ~: crash @=? run []+ testLexer05 = "Endless loop: " ~: IDT.ILS [("main",[(1,Start,2),(2,Constant "1",3),(3,NOP,3)])] @=? run [" 1 ", "  \\", " @--@"]+ testLexer06 = "Junction test: " ~: IDT.ILS [("main", [(1, Start, 2), (2, Junction 3, 5), (3, Constant "1", 4), (4, Finish, 0), (5, Constant "0", 6), (6, Finish, 0)])] @=? run [" \\", "  \\  /-1#", "   -<", "     \\-0#"]+ testLexer07 = "Simple Junction test: " ~: crash @=? run [" *-1#"]+ testLexer08 = "Two Junctions: " ~: IDT.ILS [("main", [(1, Start, 2), (2, Junction 3, 5), (3, Junction 4, 5), (4, Finish, 0), (5, Constant "0", 6), (6, Finish, 0)])] @=? run [" \\    --\\     -#", "  \\  /   \\   /", "   -<     --<", "     \\       \\", "      ---------0#"]+ testLexer09 = "Merging Junctions: " ~: IDT.ILS [("main", [(1, Start, 2), (2, Junction 3, 3), (3, Finish, 0)])] @=? run [" \\    -\\", "  \\  /  \\", "   -<    -#", "     \\  /", "      -/"]+ testLexer10 = "Push and Pop: " ~: res [Constant "1", Pop "x", Push "x"] @=? run [" \\", "  --1(!x!)(x)#"]+ testLexer11 = "Illegal cross Junctions: " ~: crash @=? run [" \\", "  +-#"]+ testLexer12 = "While: " ~: IDT.ILS [("main", [(1, Start, 2), (2, EOF, 3), (3, Junction 2, 4), (4, Finish, 0)])] @=? run [" \\   /----\\", "  \\  |    |", "   \\ \\    /", "    ---e-<", "          \\-#"]+ testLexer13 = "Empty Junction ends: " ~: IDT.ILS [("main",[(1, Start, 2), (2, Junction 0, 3), (3, Junction 4, 0), (4, Junction 5, 6), (5, Finish, 0), (6, Finish, 0)])] @=? run [" \\", "  \\    /      /--\\   /-#", "   \\--<    --<    --<", "       \\--/   \\      \\-#"]+ testLexer14 = "Turning on Lexeme: " ~: crash @=? run [" \\", "  \\#"]++ -- helper functions+ run :: IDT.Grid2D -> IDT.Lexer2SynAna+ run grid = Lexer.process (IDT.IPL ["$ 'main'":grid])++ res :: [Lexeme] -> IDT.Lexer2SynAna+ res lexeme = IDT.ILS [("main", (1, Start, 2):nodes 2 lexeme)]+  where+   nodes i [] = [(i, Finish, 0)]+   nodes i (x:xs) = (i, x, i+1):nodes (i+1) xs++ crash :: IDT.Lexer2SynAna+ crash = IDT.ILS [("main", [(1, Start, 0)])]+ + testModule = [testLexer01, testLexer02, testLexer03, testLexer04, testLexer05, testLexer06, testLexer07, testLexer08, testLexer09, testLexer10, testLexer11, testLexer12, testLexer13, testLexer14]

@@ -0,0 +1,19 @@+module TPreProc (+                    testModule     -- tests the module Preprocessor+                   )+ where++ -- imports --+ import Test.HUnit+ import InterfaceDT                   as IDT+ import qualified Preprocessor        as PreProc+ + -- functions --+ --testPreProc01   = "PreProc: " ~: IDT.IPL [] @=? PreProc.process (IDT.IIP "")+ --testPreProc02   = "PreProc: " ~: IDT.IPL [] @=? PreProc.process (IDT.IIP "a\nb\n")+ testPreProc03   = "PreProc: " ~: IDT.IPL [["$1"], ["$2"]] @=? PreProc.process (IDT.IIP "$1\n$2\n")+ testPreProc04   = "PreProc: " ~: IDT.IPL [["$1"], ["$2", "", "", ""], ["$3", "", "", "", ""]] @=? PreProc.process (IDT.IIP "$1\n$2\n\n\n\n$3\n\n\n\n\n")+ --testPreProc05   = "PreProc: " ~: IDT.IPL [["$2"]] @=? PreProc.process (IDT.IIP " $1\n$2\n")+  + testModule = [testPreProc03,testPreProc04]+                        

@@ -0,0 +1,20 @@+module TSemAna (+                   testModule     -- tests the module SemanticalAnalysis+                  )+ where++ -- imports --+ import Test.HUnit+ import InterfaceDT                   as IDT+ import qualified SemanticalAnalysis  as SemAna+ + -- functions --+ -- testSemAna01 = "SemanticalAnalysis: " ~: (erwarteter wert) @=? (SemAna.process eingabe)+ -- testSemAna02 = "SemanticalAnalysis: " ~: (erwarteter wert) @=? (SemAna.process eingabe)+ -- testSemAna03 = "SemanticalAnalysis: " ~: (erwarteter wert) @=? (SemAna.process eingabe)+ -- testSemAna04 = "SemanticalAnalysis: " ~: (erwarteter wert) @=? (SemAna.process eingabe)+ -- testSemAna05 = "SemanticalAnalysis: " ~: (erwarteter wert) @=? (SemAna.process eingabe)+ -- ...+ + testModule = [] -- [testSemAna01,testSemAna02,testSemAna03,testSemAna04,testSemAna05]+                         

@@ -0,0 +1,32 @@+module TSynAna (+                   testModule     -- tests the module SyntacticalAnalysis+                  )+ where++ -- imports --+ import Test.HUnit+ import InterfaceDT                   as IDT+ import qualified SyntacticalAnalysis as SynAna++ -- functions --+ testSynAna01 = "SyntactiaclAnalysis: " ~: output1 @=? SynAna.process input1+ testSynAna02 = "SyntactiaclAnalysis: " ~: output2 @=? SynAna.process input2+ testSynAna03 = "SyntactiaclAnalysis: " ~: output3 @=? SynAna.process input3+ testSynAna04 = "SyntactiaclAnalysis: " ~: output4 @=? SynAna.process input4+ + input1  = ILS [("main", [(1,Start,2),(2, Constant "Hello World!", 3),(3, Output, 4),(4, Finish, 0)])]+ output1 = ISS [("main", [(1,[Start, Constant "Hello World!", Output, Finish],0)])]+ + input2  = ILS [("func", [(1,Start,2),(2,Constant "1",3),(3, Junction 4, 6),(4,Constant "2", 5), (5, Junction 3, 2),(6,Finish,0)])] + output2 = ISS [("func", [(1, [Start], 2), (2, [Constant "1"], 3), (3, [Junction 4], 6), (4, [Constant "2", Junction 3], 2),(6, [Finish], 0)])] + + input3  = ILS [("main", [(1,Start,2),(2, Call "fun", 3),(3, Output, 4),(4, Finish, 0)]),("fun", [(1,Start,2),(2, Constant "Hello World!", 3),(3, Finish, 0)])] + output3 = ISS [("main", [(1,[Start, Call "fun", Output, Finish],0)]),("fun", [(1,[Start, Constant "Hello World!", Finish],0)])]+ + input4  = ILS [("main",[])]+ output4 = ISS [("main",[])]++ -- testSynAna05 = "SyntactiaclAnalysis: " ~: (erwarteter wert) @=? (SynAna.process eingabe)+ -- ...+ + testModule = [testSynAna01,testSynAna02,testSynAna03,testSynAna04]

@@ -0,0 +1,343 @@+#!/bin/bash++### Usage info+function show_help {+cat << EOF+Usage: ${0##*/} [-hvl] [-e/d TEST] [TEST]...+Without arguments the script runs all enabled tests.+When a test name is given then run this test.++-h         Display this help and exit+-e/d TEST  Enable/Diasble the specified test.+-l         List all tests and their status.+-r         Run all not enabled tests.+-v         Verbose mode. Can be used multiple times for increased+           verbotisty.+EOF+}++### Function for reading in-/output files+function readtest {+  unset STDIN+  unset STDOUT+  unset STDERR++  FILE=$1+  i=0+  # 0=STDIN, 1=STDOUT, 2=STDERR+  mode=0++  while read -r line; do+    if [ "$line" = "#" ]; then+      # Next test case OR the stdout/stderr section of a test case.+      if [ $mode -gt 0 ]; then+        # Next test case.+        i=$(($i + 1))+        mode=0+        continue+      fi++      # Else $mode is 0. This means we are now reading the+      # stdout/stderr section of a test case. It consists+      # of two sections (for stdout and stderr), delimited+      # by a line containg a single percent symbol (%). The second+      # section (for stderr) and its leading "percent symbol line"+      # are optional for backward compatibility.+      mode=1+      continue+    elif [ "$line" = "%" ]; then+      # Now comes the stderr section.+      mode=2+      continue+    fi++    # Else this is a normal input/output line.+    case "$mode" in+      0)+        STDIN[$i]="${STDIN[$i]}${line}"+        ;;+      1)+        STDOUT[$i]="${STDOUT[$i]}${line}"+        ;;+      2)+        STDERR[$i]="${STDERR[$i]}${line}"+        ;;+    esac+   done < "$FILE"++   UNIT_TESTCASES=$(($i + 1))+}++### Function to get the correct test name for a file.+function get_name {+  filename="${1##*/}"+  filename="${filename%%.*}"+  echo "$filename"+}++### Get the filename to a given test name+function get_filename {+  name="$1"+  echo "$TESTDIR/$name.rail"+}++### Function to run a single test+function run_one {+  dontrun=false+  filename=$(get_name "$1")++  if [ -f "$TESTDIR/$filename$EXT" ]+    then+      readtest "$TESTDIR/$filename$EXT"+    else+      fail=$(($fail + 1))+      echo -e "`$red`ERROR`$NC` testing: \"$filename.rail\". $EXT-file is missing."+      return+  fi++  errormsg=$(dist/build/RailCompiler/RailCompiler -c -i "$1" -o "$TMPDIR/$filename.ll" 2>&1) \+    && llvm-link "$TMPDIR/$filename.ll" src/RailCompiler/stack.ll > "$TMPDIR/$filename" \+    && chmod +x "$TMPDIR/$filename" || {+      TOTAL_TESTCASES=$(($TOTAL_TESTCASES + 1))++      # Check STDOUT first for backward compatibility.+      if [[ "$errormsg" == "${STDOUT[0]}" || "$errormsg" == "${STDERR[0]}" ]]; then+        [ $verbose -gt 0 ] && echo -en "`$green`Passed`$NC` expected fail \"$filename.rail\"."+	if [ $verbose -gt 1 ]; then+          echo "  The error message was: \"$errormsg\""+        else+          [ $verbose -gt 0 ] && echo -ne "\n"+        fi+      else+        fail=$(($fail + 1))+        echo -e "`$red`ERROR`$NC` compiling/linking \"$filename.rail\" with error: \"$errormsg\""+      fi++      return+  }++  # Create temporary files for stdout and stderr.+  stdoutfile=$(mktemp --tmpdir="$TMPDIR" swp14_ci_stdout.XXXXX)+  if [ $? -gt 0 ]; then+    echo -e "`$red`ERROR`$NC` testing: \"$filename.rail\". Could not create temporary file for stdout."+    fail=$(($fail + 1))+    return+  fi++  stderrfile=$(mktemp --tmpdir="$TMPDIR" swp14_ci_stderr.XXXXX)+  if [ $? -gt 0 ]; then+    echo -e "`$red`ERROR`$NC` testing: \"$filename.rail\". Could not create temporary file for stderr."+    fail=$(($fail + 1))+    return+  fi++  for i in $(seq 0 $(($UNIT_TESTCASES - 1))); do+    TOTAL_TESTCASES=$(($TOTAL_TESTCASES + 1))++    # Execute the test!+    echo -ne "${STDIN[$i]}" | do_lli "$TMPDIR/$filename" 1>"$stdoutfile" 2>"$stderrfile"++    # Read stdout and stderr, while converting all actual newlines to \n.+    # Really ugly: bash command substitution eats trailing newlines so we+    # need to add a terminating character and then remove it again.+    stdout=$(cat "$stdoutfile"; echo x)+    stdout=${stdout%x}+    stdout=${stdout//$'\n'/\\n}++    stderr=$(cat "$stderrfile"; echo x)+    stderr=${stderr%x}+    stderr=${stderr//$'\n'/\\n}++    if [[ "$stdout" == "${STDOUT[$i]}" && "$stderr" == "${STDERR[$i]}" ]]; then+      [ $verbose -gt 0 ] && echo -n "`$green`Passed`$NC` \"$filename.rail\" with input \"${STDIN[$i]}\""+	if [ $verbose -gt 1 ]; then+          echo "  Got output: \"$stdout\". Stderr: \"$stderr\"."+        else+          [ $verbose -gt 0 ] && echo -ne "\n"+        fi+    else+      fail=$(($fail + 1))+      echo "`$red`ERROR`$NC` testing \"$filename.rail\" with input \"${STDIN[$i]}\"!" \+        "Expected \"${STDOUT[$i]}\" on stdin, got \"$stdout\";" \+        "expected \"${STDERR[$i]}\" on stderr, got \"$stderr\"."+    fi+  done+}++### Function to compile and run all .rail files+function run_all {+  for f in "$TESTDIR"/*.rail; do+    if [ "$reverse" = true ]; then+      if [ ! -f "$TESTDIR/run/$(get_name "$f").rail" ]; then +        run_one "$f"+      fi+    else+      run_one "$f"+    fi+  done+}++### Function to correctly call the LLVM interpreter+function do_lli {+  # On some platforms, the LLVM IR interpreter is not called "lli", but+  # something like "lli-x.y", where x.y is the LLVM version -- there may be+  # multiple such binaries for different LLVM versions.+  # Instead of trying to find the right version, we currently assume that+  # such platforms use binfmt_misc to execute LLVM IR files directly (e. g. Ubuntu).+  if command -v lli >/dev/null; then+      lli "$@"+  else+      "$@"+  fi+}+++### Directory magic, so our cwd is the project home directory.+OLDDIR=$(pwd)+unset CDPATH+SOURCE="${BASH_SOURCE[0]}"+while [ -h "$SOURCE" ]; do # resolve $SOURCE until the file is no longer a symlink+  DIR="$( cd -P "$( dirname "$SOURCE" )" && pwd )"+  SOURCE="$(readlink "$SOURCE")"+  [[ $SOURCE != /* ]] && SOURCE="$DIR/$SOURCE" # if $SOURCE was a relative symlink, we need to resolve it relative to the path where the symlink file was located+done+DIR="$( cd -P "$( dirname "$SOURCE" )" && pwd )"+cd "$DIR/.."++### Define Terminal Colours+red="eval tput setaf 1; tput bold"+green="eval tput setaf 2; tput bold"+NC="tput sgr 0" # No Color++### Parse commandline options.+verbose=0+test=""+enable=""+disable=""++OPTIND=1+while getopts "hvlre:d:" opt; do+  case "$opt" in+    h)+      show_help+      exit 0+      ;;+    v)+      verbose=$(($verbose + 1))+      ;;+    l)+      list=true+      ;;+    r)+      reverse=true+      ;;+    e)+      enable=$OPTARG+      ;;+    d)+      disable=$OPTARG+      ;;+    '?')+      show_help >&2+      exit 1+      ;;+  esac+done+shift "$((OPTIND-1))" # Shift off the options and optional --.+test="$1"++### Checking for incompatible options.+count=0+[[ -n $list ]] && count=$(($count + 1))+[[ -n "$disable" ]] && count=$(($count + 1))+[[ -n "$enable" ]] && count=$(($count + 1))+if (( $count > 1 )); then+  echo "Only specify one of -l, -e, -d."+  exit 1+fi++### Main function.+TOTAL_TESTCASES=0++if [ "$reverse" = true ]; then+  TESTDIR="integration-tests"+else+  TESTDIR="integration-tests/run"+fi+EXT=".io"+if [ -n "$disable" ];then+  rm "$TESTDIR"/"$disable".{rail,io}+  exit 0+fi+if [ -n "$enable" ];then+  ln -s -t "$TESTDIR" ../$enable.{rail,io}+  exit 0+fi+if [ -n "$list" ]; then+  echo -ne "`$green`Tests to run:`$NC`\n\n"+  for file in "$TESTDIR"/*.rail;do+    echo $(get_name $file)+  done+  echo -ne "\n\n`$red`Disabled tests:`$NC`\n\n"+  for file in "$TESTDIR"/../*.rail;do+    if [ ! -f "$TESTDIR"/`basename "$file"` ];then+      echo $(get_name $file)+    fi+  done+  exit 0+fi++TMPDIR=tests/tmp+mkdir -p $TMPDIR+fail=0+if [ -n "$test" ];then+  if [ "${test##*.}" == "rail" ]; then+    # Set the TESTDIR to the directory the .rail file is in.+    test="$OLDDIR"/"$test"+    TESTDIR=${test%/*}+  else+    TESTDIR="integration-tests"+    test=$(get_filename "$test") # Find the path to the specified test+  fi+  if [ -f "$test" ]; then+    run_one "$test"+  else+    echo "`$red`ERROR:`$NC` Test $test not found."+  fi+else+  run_all+fi+rm -r tests/tmp++echo+echo "RAN $TOTAL_TESTCASES TESTCASES IN TOTAL."+++if [ ! $fail -eq 0 ];then+  echo "`$red`FAILED`$NC` $fail test cases."+  exit 1+fi+echo "All testcases `$green`PASSED`$NC`."++### DEBUGGING:+function debugprint {+echo "STDIN"+for e in "${STDIN[@]}";do+  echo "$e"+done++echo "STDOUT"+for e in "${STDOUT[@]}";do+  echo "$e"+done++echo "STDERR"+for e in "${STDERR[@]}";do+  echo "$e"+done+}++#debugprint+++# vim:ts=2 sw=2 et