module Feldspar.Compiler.Backend.C.Plugin.PrettyPrint where
import Feldspar.Transformation
import Feldspar.Compiler.Backend.C.CodeGeneration
import Feldspar.Compiler.Backend.C.Platforms
import Feldspar.Compiler.Backend.C.Options
import Feldspar.Compiler.Error
import qualified Data.List as List (last,find)
data DebugToC = DebugToC
data DebugToCSemanticInfo
instance Annotation DebugToCSemanticInfo Module where
type Label DebugToCSemanticInfo Module = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo Definition where
type Label DebugToCSemanticInfo Definition = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo Struct where
type Label DebugToCSemanticInfo Struct = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo Procedure where
type Label DebugToCSemanticInfo Procedure = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo StructMember where
type Label DebugToCSemanticInfo StructMember = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo Block where
type Label DebugToCSemanticInfo Block = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo Program where
type Label DebugToCSemanticInfo Program = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo Empty where
type Label DebugToCSemanticInfo Empty = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo Assign where
type Label DebugToCSemanticInfo Assign = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo ProcedureCall where
type Label DebugToCSemanticInfo ProcedureCall = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo Sequence where
type Label DebugToCSemanticInfo Sequence = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo Branch where
type Label DebugToCSemanticInfo Branch = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo SeqLoop where
type Label DebugToCSemanticInfo SeqLoop = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo ParLoop where
type Label DebugToCSemanticInfo ParLoop = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo ActualParameter where
type Label DebugToCSemanticInfo ActualParameter = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo Declaration where
type Label DebugToCSemanticInfo Declaration = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo Expression where
type Label DebugToCSemanticInfo Expression = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo FunctionCall where
type Label DebugToCSemanticInfo FunctionCall = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo SizeOf where
type Label DebugToCSemanticInfo SizeOf = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo ArrayElem where
type Label DebugToCSemanticInfo ArrayElem = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo StructField where
type Label DebugToCSemanticInfo StructField = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo Constant where
type Label DebugToCSemanticInfo Constant = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo IntConst where
type Label DebugToCSemanticInfo IntConst = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo FloatConst where
type Label DebugToCSemanticInfo FloatConst = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo BoolConst where
type Label DebugToCSemanticInfo BoolConst = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo ArrayConst where
type Label DebugToCSemanticInfo ArrayConst = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo ComplexConst where
type Label DebugToCSemanticInfo ComplexConst = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo Variable where
type Label DebugToCSemanticInfo Variable = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo UnionField where
type Label DebugToCSemanticInfo UnionField = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo Cast where
type Label DebugToCSemanticInfo Cast = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo SwitchCase where
type Label DebugToCSemanticInfo SwitchCase = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo Switch where
type Label DebugToCSemanticInfo Switch = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo Comment where
type Label DebugToCSemanticInfo Comment = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo UnionMember where
type Label DebugToCSemanticInfo UnionMember = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo GlobalVar where
type Label DebugToCSemanticInfo GlobalVar = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo Prototype where
type Label DebugToCSemanticInfo Prototype = ((Int, Int), (Int, Int))
instance Annotation DebugToCSemanticInfo Union where
type Label DebugToCSemanticInfo Union = ((Int, Int), (Int, Int))
instance Transformation DebugToC where
type From DebugToC = ()
type To DebugToC = DebugToCSemanticInfo
type Down DebugToC = (Options, Place, Int)
type Up DebugToC = String
type State DebugToC = (Int, Int)
instance Plugin DebugToC where
type ExternalInfo DebugToC = ((Options, Place), Int)
executePlugin DebugToC ((options, place), line) procedure =
result $ transform DebugToC (line, 0) (options, place, 0) procedure
compToC :: ((Options, Place), Int) -> Module () -> (String, (Int, Int))
compToC ((options, place), line) procedure = (up res, state res) where
res = transform DebugToC (line, 0) (options, place, 0) procedure
compToCWithInfos :: ((Options, Place), Int) -> Module () -> (Module DebugToCSemanticInfo, (String, (Int, Int)))
compToCWithInfos ((options, place), line) procedure = (result res, (up res, state res)) where
res = transform DebugToC (line, 0) (options, place, 0) procedure
instance Transformable DebugToC Variable where
transform t (line, col) (options, place, indent) x@(Variable name typ role inf) = Result (Variable name typ role newInf) (line, newCol) cRep where
newInf = ((line, col),(line, newCol))
newCol = col + length cRep
cRep = toC options place x
instance Transformable1 DebugToC [] Constant where
transform1 t (line, col) (options, place, indent) [] = Result1 [] (line, col) ""
transform1 t (line, col) (options, place, indent) (x:[]) = Result1 ((result newX):[]) (state newX) (up newX) where
newX = transform t (line, col) (options, place, indent) x
transform1 t (line, col) (options, place, indent) (x:xs) = Result1 ((result newX):(result1 newXs)) (state1 newXs) (up newX ++ ", " ++ up1 newXs) where
newX = transform t (line, col) (options, place, indent) x
(line2, col2) = state newX
newSt = (line2, col2 + length ", ")
newXs = transform1 t newSt (options, place, indent) xs
instance Transformable DebugToC Constant where
transform t (line, col) (options, place, indent) (ArrayConst list inf1 inf2) = Result (ArrayConst (result1 newList) newInf newInf) (line2, newCol) cRep where
newList = transform1 t (line, col + length "{") (options, place, indent) list
(line2, col2) = state1 newList
newCol = col2 + length "}"
newInf = ((line, col),(line, newCol))
cRep = "{" ++ up1 newList ++ "}"
transform t (line, col) (options, place, indent) const@(IntConst c inf1 inf2) = Result (IntConst c newInf newInf) (line, newCol) cRep where
newInf = ((line, col),(line, newCol))
newCol = col + length cRep
cRep = case (List.find (\(t',_) -> t' == typeof const) $ values $ platform options) of
Just (_,f) -> f const
Nothing -> show c
transform t (line, col) (options, place, indent) const@(FloatConst c inf1 inf2) = Result (FloatConst c newInf newInf) (line, newCol) cRep where
newInf = ((line, col),(line, newCol))
newCol = col + length cRep
cRep = case (List.find (\(t',_) -> t' == typeof const) $ values $ platform options) of
Just (_,f) -> f const
Nothing -> show c ++ "f"
transform t (line, col) (options, place, indent) const@(BoolConst False inf1 inf2) = Result (BoolConst False newInf newInf) (line, newCol) cRep where
newInf = ((line, col),(line, newCol))
newCol = col + length cRep
cRep = case (List.find (\(t',_) -> t' == typeof const) $ values $ platform options) of
Just (_,f) -> f const
Nothing -> "0"
transform t (line, col) (options, place, indent) const@(BoolConst True inf1 inf2) = Result (BoolConst True newInf newInf) (line, newCol) cRep where
newInf = ((line, col),(line, newCol))
newCol = col + length cRep
cRep = case (List.find (\(t',_) -> t' == typeof const) $ values $ platform options) of
Just (_,f) -> f const
Nothing -> "1"
transform t (line, col) (options, place, indent) const@(ComplexConst real im inf1 inf2)
= case (List.find (\(t',_) -> t' == typeof const) $ values $ platform options) of
Just (_,f) ->
Result (ComplexConst (result newReal) (result newIm) newInf newInf) (line, newCol) cRep where
newInf = ((line, col),(line, newCol))
newCol = col + length cRep
cRep = f const
newReal = transform t (line, col) (options, place, indent) real
newIm = transform t (line, col) (options, place, indent) im
Nothing ->
Result (ComplexConst (result newReal) (result newIm) newInf newInf) (line3, newCol) cRep where
newReal = transform t (line, col + length "complex(") (options, place, indent) real
(line2, col2) = state newReal
newIm = transform t (line2, col2 + length ",") (options, place, indent) im
(line3, col3) = state newIm
newCol = col3 + length ")"
newInf = ((line, col),(line, newCol))
cRep = "complex(" ++ up newReal ++ "," ++ up newIm ++ ")"
instance Transformable DebugToC ActualParameter where
transform t (line, col) (options, place, indent) (In param@(VarExpr (Variable _ (StructType _) _ _) _) inf) = Result (In (result newParam) newInf) newSt cRep where
newParam = transform t (line, col) (options, AddressNeed_pl, indent) param
(line2, col2) = state newParam
newSt = (line2, col2)
newInf = ((line, col), newSt)
cRep = up newParam
transform t (line, col) (options, place, indent) (In param inf) = Result (In (result newParam) newInf) newSt cRep where
newParam = transform t (line, col) (options, FunctionCallIn_pl, indent) param
(line2, col2) = state newParam
newSt = (line2, col2)
newInf = ((line, col), newSt)
cRep = up newParam
transform t (line, col) (options, place, indent) (Out param inf) = Result (Out (result newParam) newInf) newSt cRep where
newParam = transform t (line, col) (options, AddressNeed_pl, indent) param
(line2, col2) = state newParam
newSt = (line2, col2)
newInf = ((line, col), newSt)
cRep = up newParam
instance Transformable1 DebugToC [] Expression where
transform1 t (line, col) (options, place, indent) [] = Result1 [] (line, col) ""
transform1 t (line, col) (options, place, indent) (x:[]) = Result1 ((result newX):[]) (state newX) (up newX) where
newX = transform t (line, col) (options, place, indent) x
transform1 t (line, col) (options, place, indent) (x:xs) = Result1 ((result newX):(result1 newXs)) (state1 newXs) (up newX ++ ", " ++ up1 newXs) where
newX = transform t (line, col) (options, place, indent) x
(line2, col2) = state newX
newSt = (line2, col2 + length ", ")
newXs = transform1 t newSt (options, place, indent) xs
instance Transformable DebugToC Expression where
transform t (line, col) (options, place, indent) (VarExpr val inf) = Result (VarExpr (result newVal) newInf) newSt cRep where
newVal = transform t (line, col) (options, place, indent) val
(line2, col2) = state newVal
newSt = (line2, col2)
newInf = ((line, col), newSt)
cRep = up newVal
transform t (line, col) (options, place, indent) e@(ArrayElem name index inf1 inf2) = Result (ArrayElem (result newName) (result newIndex) newInf newInf) newSt cRep where
prefix = case place of
AddressNeed_pl -> "&"
_ -> ""
at = prefix ++ "at(" ++ show_type options MainParameter_pl (typeof e) NoRestrict ++ ","
newName = transform t (line, col + length at) (options, ValueNeed_pl, indent) name
(line2, col2) = state newName
newIndex = transform t (line2, col2 + length ",") (options, ValueNeed_pl, indent) index
(line3, col3) = state newIndex
newSt = (line3, col3 + length ")")
newInf = ((line, col), newSt)
cRep = at ++ up newName ++ "," ++ up newIndex ++ ")"
transform t (line, col) (options, place, indent) (StructField str field inf1 inf2) = Result (StructField (result newStr) field newInf newInf) newSt cRep where
newStr = transform t (line, col) (options, ValueNeed_pl, indent) str
(line2, col2) = state newStr
newSt = (line2, col2 + length ("." ++ field))
newInf = ((line, col), newSt)
cRep = up newStr ++ "." ++ field
transform t (line, col) (options, place, indent) (UnionField targetUnion field inf1 inf2) = Result (StructField (result newTarget) field newInf newInf) newSt cRep where
newTarget = transform t (line, col) (options, ValueNeed_pl, indent) targetUnion
(line2, col2) = state newTarget
newSt = (line2, col2 + length ("." ++ field))
newInf = ((line, col), newSt)
cRep = up newTarget ++ "." ++ field
transform t (line, col) (options, place, indent) (ConstExpr val inf) = Result (ConstExpr (result newVal) newInf) newSt cRep where
newVal = transform t (line, col) (options, place, indent) val
(line2, col2) = state newVal
newSt = (line2, col2)
newInf = ((line, col), newSt)
cRep = up newVal
transform t (line, col) (options, place, indent) (FunctionCall "!" typ role [a,b] inf1 inf2) = Result (FunctionCall "!" typ role [result newA, result newB] newInf newInf) newSt cRep where
newA = transform t (line, col+3) (options, place, indent) a
(line2, col2) = state newA
newB = transform t (line2, col2 + length ",") (options, place, indent) b
(line3, col3) = state newB
newSt = (line3, col3 + length ")")
newInf = ((line, col), newSt)
cRep = "at(" ++ up newA ++ "," ++ up newB ++ ")"
transform t (line, col) (options, place, indent) (FunctionCall fun typ InfixOp [a,b] inf1 inf2) = Result (FunctionCall fun typ InfixOp [result newA, result newB] newInf newInf) newSt cRep where
newA = transform t (line, col + length "(") (options, place, indent) a
(line2, col2) = state newA
newB = transform t (line2, col2 + length (" " ++ fun ++ " ")) (options, place, indent) b
(line3, col3) = state newB
newSt = (line3, col3 + length ")")
newInf = ((line, col), newSt)
cRep = "(" ++ up newA ++ " " ++ fun ++ " " ++ up newB ++ ")"
transform t (line, col) (options, place, indent) (FunctionCall fun typ role paramlist inf1 inf2) = Result (FunctionCall fun typ role (result1 newParamlist) newInf newInf) newSt cRep where
newParamlist = transform1 t (line, col + length (fun ++ "(")) (options, place, indent) paramlist
(line2, col2) = state1 newParamlist
newSt = (line2, col2 + length ")")
newInf = ((line, col), newSt)
cRep = fun ++ "(" ++ up1 newParamlist ++ ")"
transform t (line, col) (options, place, indent) (Cast typ exp inf1 inf2) = Result (Cast typ (result newExp) newInf newInf) newSt cRep where
prefix = concat ["(", toC options place typ, ")("]
newExp = transform t (line, col + length prefix) (options, place, indent) exp
(line2, col2) = state newExp
newSt = (line2, col2 + length ")")
newInf = ((line, col), newSt)
cRep = prefix ++ up newExp ++ ")"
transform t (line, col) (options, place, indent) (SizeOf (Left typ) inf1 inf2) = Result (SizeOf (Left typ) newInf newInf) newSt cRep where
col2 = col + length cRep
newSt = (line, col2)
newInf = ((line, col), newSt)
cRep = "sizeof(" ++ toC options place typ ++ ")"
transform t (line, col) (options, place, indent) (SizeOf (Right exp) inf1 inf2) = Result (SizeOf (Right (result newExp)) newInf newInf) newSt cRep where
newExp = transform t (line, col + length "sizeof(") (options, place, indent) exp
(line2, col2) = state newExp
newSt = (line2, col2 + length ")")
newInf = ((line, col), newSt)
cRep = "sizeof(" ++ up newExp ++ ")"
instance Transformable1 DebugToC [] Definition where
transform1 t (line, col) (options, place, indent) [] = Result1 [] (line, col) ""
transform1 t (line, col) (options, place, indent) (x:xs) = Result1 ((result newX):(result1 newXs)) (state1 newXs) (up newX ++ up1 newXs) where
newX = transform t (line, col) (options, place, indent) x
(line2, col2) = state newX
newSt = (line2, col2)
newXs = transform1 t newSt (options, place, indent) xs
instance Transformable DebugToC Module where
transform t (line, col) (options, place, indent) (Module defList inf) = Result (Module (result1 newDefList) newInf) newSt cRep where
newDefList = transform1 t (line, col) (options, place, indent) defList
(line2, col2) = state1 newDefList
newSt = (line2, col2)
newInf = ((line, col), newSt)
cRep = up1 newDefList
instance Transformable1 DebugToC [] Variable where
transform1 t (line, col) (options, place, indent) [] = Result1 [] (line, col) ""
transform1 t (line, col) (options, place, indent) (x:[]) = Result1 ((result newX):[]) (state newX) (up newX) where
newX = transform t (line, col) (options, place, indent) x
transform1 t (line, col) (options, place, indent) (x:xs) = Result1 ((result newX):(result1 newXs)) (state1 newXs) (up newX ++ ", " ++ up1 newXs) where
newX = transform t (line, col) (options, place, indent) x
(line2, col2) = state newX
newSt = (line2, col2 + length ", ")
newXs = transform1 t newSt (options, place, indent) xs
instance Transformable1 DebugToC [] StructMember where
transform1 t (line, col) (options, place, indent) [] = Result1 [] (line, col) ""
transform1 t (line, col) (options, place, indent) (x:xs) = Result1 ((result newX):(result1 newXs)) (state1 newXs) ((putIndent indent ++ up newX ++"\n" ) ++ up1 newXs) where
newX = transform t (line, col) (options, place, indent) x
(line2, col2) = state newX
newSt = (line2 + 1, indent)
newXs = transform1 t newSt (options, place, indent) xs
instance Transformable1 DebugToC [] UnionMember where
transform1 t (line, col) (options, place, indent) [] = Result1 [] (line, col) ""
transform1 t (line, col) (options, place, indent) (x:xs) = Result1 ((result newX):(result1 newXs)) (state1 newXs) ((putIndent indent ++ up newX ++"\n" ) ++ up1 newXs) where
newX = transform t (line, col) (options, place, indent) x
(line2, col2) = state newX
newSt = (line2 + 1, indent)
newXs = transform1 t newSt (options, place, indent) xs
instance Transformable DebugToC Definition where
transform t (line, col) (options, place, indent) (Struct name members inf1 inf2) = Result (Struct name (result1 newMembers) newInf newInf) newSt cRep where
newIndent = indent + 4
newMembers = transform1 t (line + 1, newIndent) (options, place, newIndent) members
(line2, col2) = state1 newMembers
newSt = (line2 + 1, indent)
newInf = ((line, col), newSt)
cRep = name ++ " {\n" ++ up1 newMembers ++ putIndent indent ++ "};\n"
transform t (line, col) (options, place, indent) (Union name members inf1 inf2) = Result (Union name (result1 newMembers) newInf newInf) newSt cRep where
newIndent = indent + 4
newMembers = transform1 t (line + 1, newIndent) (options, place, newIndent) members
(line2, col2) = state1 newMembers
newSt = (line2 + 1, indent)
newInf = ((line, col), newSt)
cRep = name ++ " {\n" ++ up1 newMembers ++ putIndent indent ++ "};\n"
transform t (line, col) (options, place, indent) (Procedure name inParam outParam body inf1 inf2) = Result (Procedure name (result1 newInParam) (result1 newOutParam) (result newBody) newInf newInf) newSt cRep where
newInParam = transform1 t (line, col + length ("void " ++ name ++ "(")) (options, MainParameter_pl, indent) inParam
(line2, col2) = state1 newInParam
(newSt1, newInPStr) | up1 newInParam == "" = ((line2, col2), "")
| otherwise = ((line2, col2 + length ", "), up1 newInParam ++ ", ")
newOutParam = transform1 t newSt1 (options, MainParameter_pl, indent) outParam
(line3, col3) = state1 newOutParam
newIndent = indent + 4
newBody = transform t (line3 + 2, newIndent) (options, Declaration_pl, newIndent) body
(line4, col4) = state newBody
newSt = (line4 + 1, indent)
newInf = ((line, col), newSt)
cRep = putIndent indent ++ "void "++ name ++ "(" ++ newInPStr ++ up1 newOutParam ++ ")\n" ++ putIndent indent ++ "{\n" ++ up newBody ++ putIndent indent ++ "}\n"
transform t (line, col) (options, place, indent) (Prototype returnType name inParam outParam inf1 inf2) = Result (Prototype returnType name (result1 newInParam) (result1 newOutParam) newInf newInf) newSt cRep where
newInParam = transform1 t (line, col + length (" " ++ name ++ "(")) (options, MainParameter_pl, indent) inParam
(line2, col2) = state1 newInParam
(newSt1, newInPStr) | up1 newInParam == "" = ((line2, col2), "")
| otherwise = ((line2, col2 + length ", "), up1 newInParam ++ ", ")
newOutParam = transform1 t newSt1 (options, MainParameter_pl, indent) outParam
(line3, col3) = state1 newOutParam
newSt = (line3 + 1, indent)
newInf = ((line, col), newSt)
cRep = putIndent indent ++ " "++ name ++ "(" ++ newInPStr ++ up1 newOutParam ++ ");\n"
transform t (line, col) (options, place, indent) (GlobalVar decl inf1 inf2) = Result (GlobalVar (result newDecl) newInf newInf) newSt cRep where
newDecl = transform t (line, col) (options, place, indent) decl
(line2, col2) = state newDecl
newSt = (line2 + 1, indent)
newInf = ((line, col), newSt)
cRep = up newDecl ++ ";\n"
instance Transformable DebugToC StructMember where
transform t (line, col) (options, place, indent) dsm@(StructMember str typ inf) = Result (StructMember str typ newInf) newSt cRep where
col2 = col + length cRep
newSt = (line, col2)
newInf = ((line, col), newSt)
cRep = case structMemberType dsm of
ArrayType len innerType -> show_variable options place Value (structMemberType dsm)
(structMemberName dsm) ++ ";"
otherwise -> (toC options place $ structMemberType dsm) ++ " " ++ structMemberName dsm ++ ";"
instance Transformable DebugToC UnionMember where
transform t (line, col) (options, place, indent) dsm@(UnionMember str typ inf) = Result (UnionMember str typ newInf) newSt cRep where
col2 = col + length cRep
newSt = (line, col2)
newInf = ((line, col), newSt)
cRep = case unionMemberType dsm of
ArrayType len innerType -> show_variable options place Value (unionMemberType dsm)
(unionMemberName dsm) ++ ";"
otherwise -> (toC options place $ unionMemberType dsm) ++ " " ++ unionMemberName dsm ++ ";"
instance Transformable1 DebugToC [] Declaration where
transform1 t (line, col) (options, place, indent) [] = Result1 [] (line, col) ""
transform1 t (line, col) (options, place, indent) (x:xs) = Result1 ((result newX):(result1 newXs)) (state1 newXs) ((putIndent indent ++ up newX ++ ";\n" ) ++ up1 newXs) where
newX = transform t (line, col) (options, place, indent) x
(line2, col2) = state newX
newSt = (line2 + 1, indent)
newXs = transform1 t newSt (options, place, indent) xs
instance Transformable DebugToC Block where
transform t (line, col) (options, place, indent) (Block locs body inf) = Result (Block (result1 newLocs) (result newBody) newInf) newSt cRep where
newLocs = transform1 t (line, col) (options, Declaration_pl, indent) locs
(line2, col2) = state1 newLocs
newSt1 | up1 newLocs == "" = (line2, col2)
| otherwise = (line2 + 1, indent)
newBody = transform t newSt1 (options, place, indent) body
(line3, col3) = state newBody
newSt = (line3, col3)
newInf = ((line, col), newSt)
cRep = listprint id "\n" [up1 newLocs, up newBody]
instance Transformable DebugToC Declaration where
transform t (line, col) (options, place, indent) (Declaration declVar Nothing inf) = Result (Declaration (result newDeclVar) Nothing newInf) newSt cRep where
newDeclVar = transform t (line, col) (options, Declaration_pl, indent) declVar
(line2, col2) = state newDeclVar
newSt = (line2, col2)
newInf = ((line, col), newSt)
cRep = up newDeclVar
transform t (line, col) (options, place, indent) (Declaration declVar (Just expr) inf) = Result (Declaration (result newDeclVar) (Just (result newExpr)) newInf) newSt cRep where
newDeclVar = transform t (line, col) (options, Declaration_pl, indent) declVar
(line2, col2) = state newDeclVar
newExpr = transform t (line2, col2 + length " = ") (options, ValueNeed_pl, indent) expr
(line3, col3) = state newExpr
newSt = (line3, col3)
newInf = ((line, col), newSt)
cRep = up newDeclVar ++ " = " ++ up newExpr
instance Transformable1 DebugToC [] ActualParameter where
transform1 t (line, col) (options, place, indent) [] = Result1 [] (line, col) ""
transform1 t (line, col) (options, place, indent) [x] = Result1 [(result newX)] (state newX) (up newX)
where
newX = transform t (line, col) (options, place, indent) x
transform1 t (line, col) (options, place, indent) (x:xs) =
Result1 ((result newX):(result1 newXs)) (state1 newXs) ((up newX ++ ", ") ++ up1 newXs)
where
newX = transform t (line, col) (options, place, indent) x
(line2, col2) = state newX
newSt = (line2 , col2 + length ", ")
newXs = transform1 t newSt (options, place, indent) xs
instance Transformable1 DebugToC [] Program where
transform1 t (line, col) (options, place, indent) [] = Result1 [] (line, col) ""
transform1 t (line, col) (options, place, indent) (x:xs) = Result1 ((result newX):(result1 newXs)) (state1 newXs) (up newX ++ up1 newXs) where
newX = transform t (line, col) (options, place, indent) x
(line2, col2) = state newX
newSt = (line2, col2)
newXs = transform1 t newSt (options, place, indent) xs
instance Transformable1 DebugToC [] SwitchCase where
transform1 t (line, col) (options, place, indent) [] = Result1 [] (line, col) ""
transform1 t (line, col) (options, place, indent) (x:xs) = Result1 ((result newX):(result1 newXs)) (state1 newXs) ((up newX ++"break;\n" ) ++ up1 newXs) where
newX = transform t (line, col) (options, place, indent) x
(line2, col2) = state newX
newSt = (line2 + 1, indent)
newXs = transform1 t newSt (options, place, indent) xs
instance Transformable DebugToC Program where
transform t (line, col) (options, place, indent) (Empty inf1 inf2) = Result (Empty newInf newInf) newSt cRep where
newSt = (line, col)
newInf = ((line, col), newSt)
cRep = ""
transform t (line, col) (options, place, indent) (Comment True comment inf1 inf2) = Result (Comment True comment newInf newInf) newSt cRep where
lineNum = length $ lines $ comment ++ "a"
newSt = (lineNum + 1, indent)
newInf = ((line, col), newSt)
cRep = "/* " ++ comment ++ " */\n"
transform t (line, col) (options, place, indent) (Comment False comment inf1 inf2) = Result (Comment False comment newInf newInf) newSt cRep where
newSt = (line + 1, indent)
newInf = ((line, col), newSt)
cRep = "// " ++ comment ++ "\n"
transform t (line, col) (options, place, indent) (Assign lhs rhs inf1 inf2) = Result (Assign (result newLhs) (result newRhs) newInf newInf) newSt cRep where
newLhs = transform t (line, col) (options, ValueNeed_pl, indent) lhs
(line2, col2) = state newLhs
newRhs = transform t (line2, col2 + length " = ") (options, ValueNeed_pl, indent) rhs
(line3, col3) = state newRhs
newSt = (line3 + 1, indent)
newInf = ((line, col), newSt)
cRep = putIndent indent ++ up newLhs ++ " = " ++ up newRhs ++ ";\n"
transform t (line, col) (options, place, indent) (ProcedureCall name param inf1 inf2) = Result (ProcedureCall name (result1 newParam) newInf newInf) newSt cRep where
newParam = transform1 t (line, col + length name + length "(") (options, place, indent) param
(line2, col2) = state1 newParam
newSt = (line2 +1, indent)
newInf = ((line, col), newSt)
cRep = putIndent indent ++ name ++ "(" ++ up1 newParam ++ ");\n"
transform t (line, col) (options, place, indent) (Sequence prog inf1 inf2) = Result (Sequence (result1 newProg) newInf newInf) newSt cRep where
newProg = transform1 t (line, col) (options, place, indent) prog
(line2, col2) = state1 newProg
newSt = (line2, col2)
newInf = ((line, col), newSt)
cRep = up1 newProg
transform t (line, col) (options, place, indent) (Branch con tPrg ePrg inf1 inf2) = Result (Branch (result newCon) (result newTPrg) (result newEPrg) newInf newInf) newSt cRep where
newCon = transform t (line, col + length "if(") (options, ValueNeed_pl, indent) con
(line2, col2) = state newCon
newTPrg = transform t (line2 + 2, indent + 4) (options, place, indent + 4) tPrg
(line3, col3) = state newTPrg
newEPrg = transform t (line3 + 3, indent + 4) (options, place, indent + 4) ePrg
(line4, col4) = state newEPrg
newSt = (line4 + 1, indent)
newInf = ((line, col), newSt)
cRep = putIndent indent ++ "if(" ++ up newCon ++ ")\n" ++ putIndent indent ++ "{\n" ++
up newTPrg ++ putIndent indent ++ "}\n" ++ putIndent indent ++ "else\n" ++ putIndent indent
++ "{\n" ++ up newEPrg ++ putIndent indent ++ "}\n"
transform t (line, col) (options, place, indent) (Switch cond cases inf1 inf2) = Result (Switch (result newCond) (result1 newCases) newInf newInf) newSt cRep where
newCond = transform t (line, col + length "switch (") (options, ValueNeed_pl, indent) cond
(line2, col2) = state newCond
newCases = transform1 t (line + 2, indent + 4) (options, place, indent + 4) cases
(line3, col3) = state1 newCases
newSt = (line3 + 1, indent)
newInf = ((line, col), newSt)
cRep = "switch (" ++ up newCond ++")\n" ++ putIndent indent ++ "{\n" ++ up1 newCases ++ putIndent indent ++ "}\n"
transform t (line, col) (options, place, indent) (SeqLoop con conPrg blockPrg inf1 inf2) = Result (SeqLoop (result newCon) (result newConPrg) (result newBlockPrg) newInf newInf) newSt cRep where
newConPrg = transform t (line + 1, indent + 4) (options, place, indent + 4) conPrg
(line2, col2) = state newConPrg
newCon = transform t (line2, indent + 4 + length "while(") (options, ValueNeed_pl, indent + 4) con
(line3, col3) = state newCon
newBlockPrg = transform t (line2 + 2, indent + 4 + length "{\n") (options, place, indent + 8) blockPrg
(line4, col4) = state newBlockPrg
loopEnd = transform t (line4, col4) (options, place, indent + 8) (blockBody conPrg)
(line5, col5) = state loopEnd
newSt = (line5 + 2, indent)
newInf = ((line, col), newSt)
cRep = putIndent indent ++ "{\n" ++ up newConPrg ++ putIndent (indent + 4) ++ "while(" ++
up newCon ++ ")\n" ++ putIndent (indent + 4) ++ "{\n" ++ up newBlockPrg ++ up loopEnd ++
putIndent (indent + 4) ++ "}\n" ++ putIndent indent ++ "}\n"
transform t (line, col) (options, place, indent) (ParLoop count bound step prog inf1 inf2) = Result (ParLoop (result newCount) (result newBound) step (result newProg) newInf newInf) newSt cRep where
newCount = transform t (line + 1, indent + 4) (options, Declaration_pl, indent + 4) count
(line2, col2) = state newCount
for_init = transform t (line2 + 1, indent + 4 + length "for(") (options, ValueNeed_pl, indent + 4) count
(line3, col3) = state for_init
for_test = transform t (line3, col3 + length " = 0; ") (options, ValueNeed_pl, indent + 4) count
(line4, col4) = state for_test
newBound = transform t (line4, col4 + length " < ") (options, ValueNeed_pl, indent + 4) bound
(line5, col5) = state newBound
for_inc = transform t (line5, col5 + length "; ") (options, ValueNeed_pl, indent + 4) count
(line6, col6) = state for_inc
newProg = transform t (line6 + 2, indent + 8) (options, place, indent + 8) prog
(line7, col7) = state newProg
newSt = (line7 + 2, indent)
newInf = ((line, col), newSt)
cRep = putIndent indent ++ "{\n" ++ putIndent (indent + 4) ++ up newCount ++ ";\n" ++ putIndent (indent + 4) ++
"for(" ++ up for_init ++ " = 0; " ++ up for_test ++ " < " ++ up newBound ++ "; " ++ up for_inc ++
" += " ++ show step ++ ")\n" ++ putIndent (indent + 4) ++ "{\n" ++ up newProg ++ putIndent (indent + 4) ++
"}\n" ++ putIndent indent ++ "}\n"
transform t (line, col) (options, place, indent) (BlockProgram prog inf) = Result (BlockProgram (result newProg) newInf) newSt cRep where
newProg = transform t (line + 1, indent + 4) (options, place, indent + 4) prog
(line2, col2) = state newProg
newSt = (line2 + 1, indent)
newInf = ((line, col), newSt)
cRep = putIndent indent ++ "{\n" ++ up newProg ++ putIndent indent ++ "}\n"
instance Transformable DebugToC SwitchCase where
transform t (line, col) (options, place, indent) (SwitchCase matcher impl inf) = Result (SwitchCase (result newMatcher) (result newImpl) newInf) newSt cRep where
newMatcher = transform t (line, indent + length "case ") (options, place, indent) matcher
(line2, col2) = state newMatcher
newImpl = transform t (line2 + 1, indent + 4) (options, place, indent + 4) impl
(line3, col3) = state newImpl
newSt = (line3, col3 + length "}")
newInf = ((line, col), newSt)
cRep = "case " ++ up newMatcher ++ ": {\n" ++ up newImpl ++ putIndent indent ++ "}"
putIndent ind = concat $ replicate ind " "