{-# LANGUAGE TypeFamilies #-} module Feldspar.Compiler.Backend.C.Plugin.PrettyPrint where import Feldspar.Transformation import Feldspar.Compiler.Backend.C.CodeGeneration -- import Feldspar.Compiler.Backend.C.Plugin.PrettyPrintHelp import Feldspar.Compiler.Backend.C.Platforms import Feldspar.Compiler.Backend.C.Options import Feldspar.Compiler.Error import qualified Data.List as List (last,find) -- =========================================================================== -- == DebugToC plugin -- =========================================================================== 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) -- Platform, Place and Indentation 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 -- TODO: Is this case valid newIm = transform t (line, col) (options, place, indent) im -- TODO: by ComplexConst ??? 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 = up1 newLocs ++ "\n" ++ up newBody 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 " "