Negate integral expressions

1 files changed, 0 insertions, 311 deletions

diff --git a/lib/Language/Elna/Intermediate.hs b/lib/Language/Elna/Intermediate.hs
deleted file mode 100644
index 32c951e..0000000
--- a/lib/Language/Elna/Intermediate.hs
+++ /dev/null
@@ -1,311 +0,0 @@
-module Language.Elna.Intermediate
-    ( Operand(..)
-    , Quadruple(..)
-    {- , Label(..) -}
-    , Variable(..)
-    , intermediate
-    ) where
-
-import Data.Bifunctor (Bifunctor(..))
-import Data.HashMap.Strict (HashMap)
-import qualified Data.HashMap.Strict as HashMap
-import Data.Vector (Vector)
-import qualified Data.Vector as Vector
-import Data.Int (Int32)
-import Data.Word (Word32)
-import Data.Text (Text)
-import qualified Language.Elna.AST as AST
-import Language.Elna.SymbolTable (SymbolTable{-, Info(..) -})
-import Data.Foldable (Foldable(..))
-import Control.Monad.Trans.State (State, get, modify', runState)
-import Data.Maybe (catMaybes)
-
-newtype Variable = TempVariable Word32 -- | Variable Text
-    deriving Eq
-
-instance Show Variable
-  where
-    -- show (Variable variable) = '$' : Text.unpack variable
-    show (TempVariable variable) = '$' : show variable
-
-data Operand v
-    = IntOperand Int32
-    | VariableOperand v
-    deriving (Eq, Show)
-
-data Quadruple v
-    = StartQuadruple
-    | StopQuadruple
-    | ParameterQuadruple (Operand v)
-    | CallQuadruple Text Word32
-    | AddQuadruple (Operand v) (Operand v) v
-    | SubtractionQuadruple (Operand v) (Operand v) v
-    {-| GoToQuadruple Label
-    | AssignQuadruple Operand Variable
-    | ArrayQuadruple Variable Operand Variable
-    | ArrayAssignQuadruple Operand Operand Variable
-    | ProductQuadruple Operand Operand Variable
-    | DivisionQuadruple Operand Operand Variable
-    | NegationQuadruple Operand Variable
-    | EqualQuadruple Operand Operand Label
-    | NonEqualQuadruple Operand Operand Label
-    | LessQuadruple Operand Operand Label
-    | GreaterQuadruple Operand Operand Label
-    | LessOrEqualQuadruple Operand Operand Label
-    | GreaterOrEqualQuadruple Operand Operand Label
-    | LabelQuadruple Label -}
-    deriving (Eq, Show)
-
-newtype Intermediate a = Intermediate
-    { runIntermediate :: State Word32 a }
-
-instance Functor Intermediate
-  where
-    fmap f (Intermediate x) = Intermediate $ f <$> x
-
-instance Applicative Intermediate
-  where
-    pure = Intermediate . pure
-    (Intermediate f) <*> (Intermediate x) = Intermediate $ f <*> x
-
-instance Monad Intermediate
-  where
-    (Intermediate x) >>= f = Intermediate $ x >>= (runIntermediate . f)
-
-intermediate :: SymbolTable -> AST.Program -> HashMap AST.Identifier (Vector (Quadruple Variable))
-intermediate globalTable
-    = fst
-    . flip runState 0
-    . runIntermediate
-    . program globalTable
-
-program
-    :: SymbolTable
-    -> AST.Program
-    -> Intermediate (HashMap AST.Identifier (Vector (Quadruple Variable)))
-program globalTable (AST.Program declarations) = HashMap.fromList . catMaybes
-    <$> traverse (declaration globalTable) declarations
-
-declaration
-    :: SymbolTable
-    -> AST.Declaration
-    -> Intermediate (Maybe (AST.Identifier, Vector (Quadruple Variable)))
-declaration globalTable (AST.ProcedureDeclaration procedureName _ _ statements)
-    = Just
-    . (procedureName,)
-    . Vector.cons StartQuadruple
-    . flip Vector.snoc StopQuadruple
-    . fold
-    <$> traverse (statement globalTable) statements
--- declaration (AST.TypeDefinition _ _) accumulator = pure accumulator
-
-statement :: SymbolTable -> AST.Statement -> Intermediate (Vector (Quadruple Variable))
-statement _ AST.EmptyStatement = pure mempty
-statement localTable (AST.CallStatement (AST.Identifier callName) arguments) = do
-    visitedArguments <- traverse (expression localTable) arguments
-    let (parameterStatements, argumentStatements)
-            = bimap (Vector.fromList . fmap ParameterQuadruple) Vector.concat
-            $ unzip visitedArguments
-     in pure
-        $ Vector.snoc (argumentStatements <> parameterStatements)
-        $ CallQuadruple callName
-        $ fromIntegral
-        $ Vector.length argumentStatements
-{- statement localTable (AST.AssignmentStatement variableAccess' assignee) = do
-    (rhsOperand, rhsStatements) <- expression localTable assignee
-    let variableType' = variableType variableAccess' localTable
-    accessResult <- variableAccess localTable variableAccess' Nothing variableType' mempty
-    pure $ rhsStatements <> case accessResult of
-            (AST.Identifier identifier, Just accumulatedIndex, accumulatedStatements) ->
-                Vector.snoc accumulatedStatements
-                    $ ArrayAssignQuadruple rhsOperand accumulatedIndex
-                    $ Variable identifier
-            (AST.Identifier identifier, Nothing, accumulatedStatements) ->
-                Vector.snoc accumulatedStatements
-                    $ AssignQuadruple rhsOperand
-                    $ Variable identifier
-statement localTable (AST.IfStatement ifCondition ifStatement elseStatement) = do
-    (conditionStatements, jumpConstructor) <- condition localTable ifCondition
-    ifLabel <- createLabel
-    endLabel <- createLabel
-    ifStatements <- statement localTable ifStatement
-    possibleElseStatements <- traverse (statement localTable) elseStatement
-    pure $ conditionStatements <> case possibleElseStatements of
-        Just elseStatements -> Vector.cons (jumpConstructor ifLabel) elseStatements
-            <> Vector.fromList [GoToQuadruple endLabel, LabelQuadruple ifLabel]
-            <> Vector.snoc ifStatements (LabelQuadruple endLabel)
-        Nothing -> Vector.fromList [jumpConstructor ifLabel, GoToQuadruple endLabel, LabelQuadruple ifLabel]
-            <> Vector.snoc ifStatements (LabelQuadruple endLabel)
-statement localTable (AST.WhileStatement whileCondition whileStatement) = do
-    (conditionStatements, jumpConstructor) <- condition localTable whileCondition
-    startLabel <- createLabel
-    endLabel <- createLabel
-    conditionLabel <- createLabel
-    whileStatements <- statement localTable whileStatement
-    pure $ Vector.fromList [LabelQuadruple conditionLabel]
-        <> conditionStatements
-        <> Vector.fromList [jumpConstructor startLabel, GoToQuadruple endLabel, LabelQuadruple startLabel]
-        <> whileStatements
-        <> Vector.fromList [GoToQuadruple conditionLabel, LabelQuadruple endLabel]
-statement localTable (AST.CompoundStatement statements) =
-    fold <$> traverse (statement localTable) statements -}
-
-createTemporary :: Intermediate Variable
-createTemporary = do
-    currentCounter <- Intermediate get
-    Intermediate $ modify' (+ 1)
-    pure $ TempVariable currentCounter
-
-{-
-import Language.Elna.Types (Type(..))
-import qualified Language.Elna.SymbolTable as SymbolTable
-import GHC.Records (HasField(..))
-import qualified Data.Text.Lazy.Builder.Int as Text.Builder
-import qualified Data.Text.Lazy.Builder as Text.Builder
-import qualified Data.Text.Lazy as Text.Lazy
-
-newtype Label = Label Text
-    deriving Eq
-
-instance Show Label
-  where
-    show (Label label) = '.' : Text.unpack label
-
-createLabel :: Intermediate Label
-createLabel = do
-    currentCounter <- Intermediate $ gets labelCounter
-    Intermediate $ modify' modifier
-    pure
-        $ Label
-        $ Text.Lazy.toStrict
-        $ Text.Builder.toLazyText
-        $ Text.Builder.decimal currentCounter
-  where
-    modifier generator = generator
-        { labelCounter = getField @"labelCounter" generator + 1
-        }
-
-condition
-    :: SymbolTable
-    -> AST.Condition
-    -> Intermediate (Vector Quadruple, Label -> Quadruple)
-condition localTable (AST.EqualCondition lhs rhs) = do
-    (lhsOperand, lhsStatements) <- expression localTable lhs
-    (rhsOperand, rhsStatements) <- expression localTable rhs
-    pure
-        ( lhsStatements <> rhsStatements
-        , EqualQuadruple lhsOperand rhsOperand
-        )
-condition localTable (AST.NonEqualCondition lhs rhs) = do
-    (lhsOperand, lhsStatements) <- expression localTable lhs
-    (rhsOperand, rhsStatements) <- expression localTable rhs
-    pure
-        ( lhsStatements <> rhsStatements
-        , NonEqualQuadruple lhsOperand rhsOperand
-        )
-condition localTable (AST.LessCondition lhs rhs) = do
-    (lhsOperand, lhsStatements) <- expression localTable lhs
-    (rhsOperand, rhsStatements) <- expression localTable rhs
-    pure (lhsStatements <> rhsStatements, LessQuadruple lhsOperand rhsOperand)
-condition localTable (AST.GreaterCondition lhs rhs) = do
-    (lhsOperand, lhsStatements) <- expression localTable lhs
-    (rhsOperand, rhsStatements) <- expression localTable rhs
-    pure
-        ( lhsStatements <> rhsStatements
-        , GreaterQuadruple lhsOperand rhsOperand
-        )
-condition localTable (AST.LessOrEqualCondition lhs rhs) = do
-    (lhsOperand, lhsStatements) <- expression localTable lhs
-    (rhsOperand, rhsStatements) <- expression localTable rhs
-    pure
-        ( lhsStatements <> rhsStatements
-        , LessOrEqualQuadruple lhsOperand rhsOperand
-        )
-condition localTable (AST.GreaterOrEqualCondition lhs rhs) = do
-    (lhsOperand, lhsStatements) <- expression localTable lhs
-    (rhsOperand, rhsStatements) <- expression localTable rhs
-    pure
-        ( lhsStatements <> rhsStatements
-        , GreaterOrEqualQuadruple lhsOperand rhsOperand
-        )
-
-variableAccess
-    :: SymbolTable
-    -> AST.VariableAccess
-    -> Maybe Operand
-    -> Type
-    -> Vector Quadruple
-    -> Intermediate (AST.Identifier, Maybe Operand, Vector Quadruple)
-variableAccess _ (AST.VariableAccess identifier) accumulatedIndex _ accumulatedStatements =
-    pure (identifier, accumulatedIndex, accumulatedStatements)
-variableAccess localTable (AST.ArrayAccess access1 index1) Nothing (ArrayType _ baseType) _ = do
-    (indexPlace, statements) <- expression localTable index1
-    variableAccess localTable access1 (Just indexPlace) baseType statements
-variableAccess localTable (AST.ArrayAccess arrayAccess' arrayIndex) (Just baseIndex) (ArrayType arraySize baseType) statements = do
-    (indexPlace, statements') <- expression localTable arrayIndex
-    resultVariable <- createTemporary
-    let resultOperand = VariableOperand resultVariable
-        indexCalculation = Vector.fromList
-            [ ProductQuadruple (IntOperand $ fromIntegral arraySize) baseIndex resultVariable
-            , AddQuadruple indexPlace resultOperand resultVariable
-            ]
-     in variableAccess localTable arrayAccess' (Just resultOperand) baseType
-        $ statements <> indexCalculation <> statements'
-variableAccess _ _ _ _ _ = error "Array access operator doesn't match the type."
-
-variableType :: AST.VariableAccess -> SymbolTable -> Type
-variableType (AST.VariableAccess identifier) symbolTable
-    | Just (TypeInfo type') <- SymbolTable.lookup identifier symbolTable = type'
-    | otherwise = error "Undefined type."
-variableType (AST.ArrayAccess arrayAccess' _) symbolTable =
-    variableType arrayAccess' symbolTable
--}
-expression :: SymbolTable -> AST.Expression -> Intermediate (Operand Variable, Vector (Quadruple Variable))
-expression localTable = \case
-    (AST.LiteralExpression literal') -> pure (literal literal', mempty)
-    (AST.SumExpression lhs rhs) -> binaryExpression AddQuadruple lhs rhs
-    (AST.SubtractionExpression lhs rhs) ->
-        binaryExpression SubtractionQuadruple lhs rhs
-{-    (AST.VariableExpression variableExpression) -> do
-        let variableType' = variableType variableExpression localTable
-        variableAccess' <- variableAccess localTable variableExpression Nothing variableType' mempty
-        case variableAccess' of
-            (AST.Identifier identifier, Nothing, statements) ->
-                pure (VariableOperand (Variable identifier), statements)
-            (AST.Identifier identifier, Just operand, statements) -> do
-                arrayAddress <- createTemporary
-                let arrayStatement = ArrayQuadruple (Variable identifier) operand arrayAddress
-                pure
-                    ( VariableOperand arrayAddress
-                    , Vector.snoc statements arrayStatement
-                    )
-    (AST.NegationExpression negation) -> do
-        (operand, statements) <- expression localTable negation
-        tempVariable <- createTemporary
-        let negationQuadruple = NegationQuadruple operand tempVariable
-        pure
-            ( VariableOperand tempVariable
-            , Vector.snoc statements negationQuadruple
-            )
-    (AST.ProductExpression lhs rhs) ->
-        binaryExpression ProductQuadruple lhs rhs
-    (AST.DivisionExpression lhs rhs) ->
-        binaryExpression DivisionQuadruple lhs rhs -}
-  where
-    binaryExpression f lhs rhs = do
-        (lhsOperand, lhsStatements) <- expression localTable lhs
-        (rhsOperand, rhsStatements) <- expression localTable rhs
-        tempVariable <- createTemporary
-        let newQuadruple = f lhsOperand rhsOperand tempVariable
-        pure
-            ( VariableOperand tempVariable
-            , Vector.snoc (lhsStatements <> rhsStatements) newQuadruple
-            )
-
-literal :: AST.Literal -> Operand Variable
-literal (AST.IntegerLiteral integer) = IntOperand integer
-{-literal (AST.HexadecimalLiteral integer) = IntOperand integer
-literal (AST.CharacterLiteral character) = IntOperand $ fromIntegral character
-literal (AST.BooleanLiteral boolean)
-    | boolean = IntOperand 1
-    | otherwise = IntOperand 0 -}