<commit_before>--
-- Copyright (c) 2009-2011, ERICSSON AB
-- All rights reserved.
-- 
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
-- 
--     * Redistributions of source code must retain the above copyright notice, 
--       this list of conditions and the following disclaimer.
--     * Redistributions in binary form must reproduce the above copyright
--       notice, this list of conditions and the following disclaimer in the
--       documentation and/or other materials provided with the distribution.
--     * Neither the name of the ERICSSON AB nor the names of its contributors
--       may be used to endorse or promote products derived from this software
--       without specific prior written permission.
-- 
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 
-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-- SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-- OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
--

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleInstances #-}

module Feldspar.Compiler.Backend.C.CodeGeneration where

import Feldspar.Compiler.Imperative.Representation
import Feldspar.Compiler.Error (handleError, ErrorClass(..))
import Feldspar.Compiler.Backend.C.Options
import Feldspar.Compiler.Imperative.Frontend (isNativeArray)

import Text.PrettyPrint

codeGenerationError :: ErrorClass -> String -> a
codeGenerationError = handleError "CodeGeneration"

data PrintEnv = PEnv
    { options :: Options
    }

compToCWithInfos :: Options -> Module () -> CompToCCoreResult ()
compToCWithInfos opts procedure =
  CompToCCoreResult { sourceCode  = render $ cgen (PEnv opts) procedure
                    , debugModule = procedure
                    }

class CodeGen a
  where
    cgen     :: PrintEnv -> a -> Doc
    cgenList :: PrintEnv -> [a] -> Doc

instance CodeGen (Module ())
  where
    cgen env Module{..} = cgenList env entities
    cgenList env = sep . map (cgen env)

instance CodeGen (Entity ())
  where
    cgen env StructDef{..} = text "struct"   <+> text structName     $+$ block env (cgenList env structMembers) <> semi
    cgen env TypeDef{..}   = text "typedef"  <+> cgen env actualType <+> text typeName <> semi
    cgen env ProcDef{..}   = text "void"     <+> text procName       <>  parens (pvars env $ inParams ++ outParams) $$ block env (cgen env procBody)
    cgen env ProcDecl{..}  = text "void"     <+> text procName       <>  parens (pvars env $ inParams ++ outParams) <> semi
    cgen env ValueDef{..}
      | NativeArray _ t <- typeof valVar
      = cgen env t <+> cgen env valVar <> brackets empty   <+> equals <+> cgen env valValue <> semi
      | otherwise = cgen env valVar <+> equals              <+> cgen env valValue <> semi

    cgenList env = vcat . punctuate (text "\n") . map (cgen env)

instance CodeGen (StructMember ())
  where
    cgen env StructMember{..} = cgen env structMemberType <+> text structMemberName <> sizeInBrackets structMemberType <> semi

    cgenList env = vcat . map (cgen env)

instance CodeGen (Block ())
  where
    cgen env Block{..} = sep [ cgenList env locals
                            , if null locals then empty else text ""
                            , cgen env blockBody
                            ]
    cgenList env = sep . punctuate (text "\n") . map (cgen env)

instance CodeGen (Declaration ())
  where
    cgen env Declaration{..} = pvar env declVar <+> nest (nestSize $ options env) init <> semi
      where
        init = case (initVal, varType declVar) of
                 (Just i, _)           -> equals <+> cgen env i
                 (_     , Pointer{})   -> equals <+> text "NULL"
                 _                     -> empty
    cgenList env = vcat . map (cgen env)

instance CodeGen (Program ())
  where
    cgen env Empty = empty
    cgen env Comment{..}
      | isBlockComment = blockComment $ map text $ lines commentValue
      | otherwise      = text "//" <+> text commentValue
    cgen env Assign{..} = cgen env lhs <+> equals <+> nest (nestSize $ options env) (cgen env rhs) <> semi
    cgen env ProcedureCall{..} = stmt $ call (text procCallName) (map (cgen env) procCallParams)
    cgen env Sequence{..} = cgenList env sequenceProgs
    cgen env Branch{..} =  text "if" <+> parens (cgen env branchCond)
                       $$ block env (cgen env thenBlock)
                       $$ text "else"
                       $$ block env (cgen env elseBlock)
    cgen env Switch{..} =  text "switch" <+> parens (cgen env scrutinee)
                       $$ block env (vcat [ cgen env p $$ nest (nestSize $ options env) (cgen env b) | (p, b) <- alts])
    cgen env SeqLoop{..} =  cgen env sLoopCondCalc
                        $$ text "while" <+> parens (cgen env sLoopCond)
                        $$ block env (cgen env sLoopBlock $+$ cgen env sLoopCondCalc)
    cgen env ParLoop{..} =  text "for" <+> parens (sep $ map (nest 4) $ punctuate semi [init, guard, next])
                        $$ block env (cgen env pLoopBlock)
      where
        ixd   = pvar env pLoopCounter
        ixv   = cgen env  pLoopCounter
        init  = ixd <+> equals    <+> int 0
        guard = ixv <+> char '<'  <+> cgen env pLoopBound
        next  = ixv <+> text "+=" <+> int pLoopStep

    cgen env BlockProgram{..} = block env (cgen env blockProgram)

    cgenList env = vcat . map (cgen env)

instance CodeGen (Pattern ())
  where
    cgen env PatDefault = text "default" <> colon
    cgen env (Pat c)    = cgen env c <> colon

    cgenList env = vcat . map (cgen env)

instance CodeGen (ActualParameter ())
  where
    cgen env In{..}                  = cgen env inParam
    cgen env Out{..}                 = cgen env outParam
    cgen env TypeParameter{..}       = cgen env typeParam
    cgen env FunParameter{..}        = text funParamName
    cgenList env = hsep . punctuate comma . map (cgen env)

instance CodeGen (Expression ())
  where
    cgen env VarExpr{..} = cgen env var
    cgen env e@ArrayElem{..}
     | isNativeArray $ typeof array
     , AddrOf c@ConstExpr{} <- array
     , (NativeArray _ t) <- typeof c
     = parens (parens (cgen env t <> brackets empty) <> cgen env c) <> brackets (cgen env arrayIndex)
     | isNativeArray $ typeof array
     , AddrOf arr <- array = cgen env arr <> brackets (cgen env arrayIndex)
     | otherwise = text "at" <> parens (hcat $ punctuate comma [ cgen env $ typeof e
                                                               , cgen env array
                                                               , cgen env arrayIndex
                                                               ])
    cgen env e@StructField{..} = parens (cgen env struct) <> char '.' <> text fieldName
    cgen env ConstExpr{..} = cgen env constExpr
    cgen env FunctionCall{..} | funName function == "!"   = call (text "at") $ map (cgen env) funCallParams
                             | funMode function == Infix
                             , [a,b] <- funCallParams    = parens (cgen env a <+> text (funName function) <+> cgen env b)
                             | otherwise                 = call (text $ funName function) $ map (cgen env) funCallParams
    cgen env Cast{..} = parens $ parens (cgen env castType) <> parens (cgen env castExpr)
    cgen env AddrOf{..} | VarExpr v@(Variable{..}) <- addrExpr
                        , Pointer t <- typeof addrExpr = cgen env (v{varType = t})
                        | otherwise                      = prefix <> cgen env addrExpr
     where
       prefix = case (addrExpr, typeof addrExpr) of
                 (ArrayElem e i, Pointer{}) -> empty -- Skip single level AddrOf
                 _                          -> text "&"
    cgen env SizeOf{..} = call (text "sizeof") [either (cgen env) (cgen env) sizeOf]

    cgenList env = sep . punctuate comma . map (cgen env)

instance CodeGen (Variable t)
  where
    cgen env v = go v
      where
        go v@Variable{..} = case varType of
                   Pointer t | NativeArray{} <- t -> go (v {varType = t})
                             | otherwise -> text "*" <> go (v {varType = t})-- char '*'
                   _         -> text varName

    cgenList env = hsep . punctuate comma . map (cgen env)

instance CodeGen (Constant ())
  where
    cgen env cnst@(IntConst c _)    = maybe (integer c) text $ transformConst env cnst<commit_msg>Handle AddrOf Pointer StructFields.<commit_after>--
-- Copyright (c) 2009-2011, ERICSSON AB
-- All rights reserved.
-- 
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
-- 
--     * Redistributions of source code must retain the above copyright notice, 
--       this list of conditions and the following disclaimer.
--     * Redistributions in binary form must reproduce the above copyright
--       notice, this list of conditions and the following disclaimer in the
--       documentation and/or other materials provided with the distribution.
--     * Neither the name of the ERICSSON AB nor the names of its contributors
--       may be used to endorse or promote products derived from this software
--       without specific prior written permission.
-- 
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 
-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-- SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-- OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
--

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleInstances #-}

module Feldspar.Compiler.Backend.C.CodeGeneration where

import Feldspar.Compiler.Imperative.Representation
import Feldspar.Compiler.Error (handleError, ErrorClass(..))
import Feldspar.Compiler.Backend.C.Options
import Feldspar.Compiler.Imperative.Frontend (isNativeArray)

import Text.PrettyPrint

codeGenerationError :: ErrorClass -> String -> a
codeGenerationError = handleError "CodeGeneration"

data PrintEnv = PEnv
    { options :: Options
    }

compToCWithInfos :: Options -> Module () -> CompToCCoreResult ()
compToCWithInfos opts procedure =
  CompToCCoreResult { sourceCode  = render $ cgen (PEnv opts) procedure
                    , debugModule = procedure
                    }

class CodeGen a
  where
    cgen     :: PrintEnv -> a -> Doc
    cgenList :: PrintEnv -> [a] -> Doc

instance CodeGen (Module ())
  where
    cgen env Module{..} = cgenList env entities
    cgenList env = sep . map (cgen env)

instance CodeGen (Entity ())
  where
    cgen env StructDef{..} = text "struct"   <+> text structName     $+$ block env (cgenList env structMembers) <> semi
    cgen env TypeDef{..}   = text "typedef"  <+> cgen env actualType <+> text typeName <> semi
    cgen env ProcDef{..}   = text "void"     <+> text procName       <>  parens (pvars env $ inParams ++ outParams) $$ block env (cgen env procBody)
    cgen env ProcDecl{..}  = text "void"     <+> text procName       <>  parens (pvars env $ inParams ++ outParams) <> semi
    cgen env ValueDef{..}
      | NativeArray _ t <- typeof valVar
      = cgen env t <+> cgen env valVar <> brackets empty   <+> equals <+> cgen env valValue <> semi
      | otherwise = cgen env valVar <+> equals              <+> cgen env valValue <> semi

    cgenList env = vcat . punctuate (text "\n") . map (cgen env)

instance CodeGen (StructMember ())
  where
    cgen env StructMember{..} = cgen env structMemberType <+> text structMemberName <> sizeInBrackets structMemberType <> semi

    cgenList env = vcat . map (cgen env)

instance CodeGen (Block ())
  where
    cgen env Block{..} = sep [ cgenList env locals
                            , if null locals then empty else text ""
                            , cgen env blockBody
                            ]
    cgenList env = sep . punctuate (text "\n") . map (cgen env)

instance CodeGen (Declaration ())
  where
    cgen env Declaration{..} = pvar env declVar <+> nest (nestSize $ options env) init <> semi
      where
        init = case (initVal, varType declVar) of
                 (Just i, _)           -> equals <+> cgen env i
                 (_     , Pointer{})   -> equals <+> text "NULL"
                 _                     -> empty
    cgenList env = vcat . map (cgen env)

instance CodeGen (Program ())
  where
    cgen env Empty = empty
    cgen env Comment{..}
      | isBlockComment = blockComment $ map text $ lines commentValue
      | otherwise      = text "//" <+> text commentValue
    cgen env Assign{..} = cgen env lhs <+> equals <+> nest (nestSize $ options env) (cgen env rhs) <> semi
    cgen env ProcedureCall{..} = stmt $ call (text procCallName) (map (cgen env) procCallParams)
    cgen env Sequence{..} = cgenList env sequenceProgs
    cgen env Branch{..} =  text "if" <+> parens (cgen env branchCond)
                       $$ block env (cgen env thenBlock)
                       $$ text "else"
                       $$ block env (cgen env elseBlock)
    cgen env Switch{..} =  text "switch" <+> parens (cgen env scrutinee)
                       $$ block env (vcat [ cgen env p $$ nest (nestSize $ options env) (cgen env b) | (p, b) <- alts])
    cgen env SeqLoop{..} =  cgen env sLoopCondCalc
                        $$ text "while" <+> parens (cgen env sLoopCond)
                        $$ block env (cgen env sLoopBlock $+$ cgen env sLoopCondCalc)
    cgen env ParLoop{..} =  text "for" <+> parens (sep $ map (nest 4) $ punctuate semi [init, guard, next])
                        $$ block env (cgen env pLoopBlock)
      where
        ixd   = pvar env pLoopCounter
        ixv   = cgen env  pLoopCounter
        init  = ixd <+> equals    <+> int 0
        guard = ixv <+> char '<'  <+> cgen env pLoopBound
        next  = ixv <+> text "+=" <+> int pLoopStep

    cgen env BlockProgram{..} = block env (cgen env blockProgram)

    cgenList env = vcat . map (cgen env)

instance CodeGen (Pattern ())
  where
    cgen env PatDefault = text "default" <> colon
    cgen env (Pat c)    = cgen env c <> colon

    cgenList env = vcat . map (cgen env)

instance CodeGen (ActualParameter ())
  where
    cgen env In{..}                  = cgen env inParam
    cgen env Out{..}                 = cgen env outParam
    cgen env TypeParameter{..}       = cgen env typeParam
    cgen env FunParameter{..}        = text funParamName
    cgenList env = hsep . punctuate comma . map (cgen env)

instance CodeGen (Expression ())
  where
    cgen env VarExpr{..} = cgen env var
    cgen env e@ArrayElem{..}
     | isNativeArray $ typeof array
     , AddrOf c@ConstExpr{} <- array
     , (NativeArray _ t) <- typeof c
     = parens (parens (cgen env t <> brackets empty) <> cgen env c) <> brackets (cgen env arrayIndex)
     | isNativeArray $ typeof array
     , AddrOf arr <- array = cgen env arr <> brackets (cgen env arrayIndex)
     | otherwise = text "at" <> parens (hcat $ punctuate comma [ cgen env $ typeof e
                                                               , cgen env array
                                                               , cgen env arrayIndex
                                                               ])
    cgen env e@StructField{..} = parens (cgen env struct) <> char '.' <> text fieldName
    cgen env ConstExpr{..} = cgen env constExpr
    cgen env FunctionCall{..} | funName function == "!"   = call (text "at") $ map (cgen env) funCallParams
                             | funMode function == Infix
                             , [a,b] <- funCallParams    = parens (cgen env a <+> text (funName function) <+> cgen env b)
                             | otherwise                 = call (text $ funName function) $ map (cgen env) funCallParams
    cgen env Cast{..} = parens $ parens (cgen env castType) <> parens (cgen env castExpr)
    cgen env AddrOf{..} | VarExpr v@(Variable{..}) <- addrExpr
                        , Pointer t <- typeof addrExpr = cgen env (v{varType = t})
                        | otherwise                      = prefix <> cgen env addrExpr
     where
       prefix = case (addrExpr, typeof addrExpr) of
                 (e, Pointer{}) | specialConstruct e -> empty -- Skip single level AddrOf
                   where specialConstruct ArrayElem{}   = True
                         specialConstruct StructField{} = True
                         specialConstruct _             = False

                 _                          -> text "&"
    cgen env SizeOf{..} = call (text "sizeof") [either (cgen env) (cgen env) sizeOf]

    cgenList env = sep . punctuate comma . map (cgen env)

instance CodeGen (Variable t)
  where
    cgen env v = go v
      where
        go v@Variable{..} = case varType of
                   Pointer t | NativeArray{} <- t -> go (v {varType = t})
                             | otherwise -> text "*" <> go (v {varType = t})-- char '*'
                   _         -> text varName

    cgenList env = hsep . punctuate comma . map (cgen env)

instance CodeGen (Constant ())
  where
    cgen env cnst@(IntConst c _)    = maybe (integer c) text $ transformConst env cnst
{'fraction_non_alphanumeric': 0.10102063213345039, 'fraction_numerical': 0.0010974539069359087, 'mean_word_length': 2.079067410035479, 'pattern_counts': {'":': 0, '<': 129, '<?xml version=': 0, '>': 141, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 20, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1555804', 'n_tokens_mistral': 5406, 'n_tokens_neox': 5095, 'n_words': 1941}