module Feldspar.Compiler.Backend.C.Plugin.Locator where
import Feldspar.Transformation
import Feldspar.Compiler.Backend.C.CodeGeneration
import Feldspar.Compiler.Backend.C.Plugin.PrettyPrint
instance Default Bool where
def = False
instance Default (Program DebugToCSemanticInfo) where
def = Empty ((0,0),(0,0)) ((0,0),(0,0))
instance Combine Bool where
combine l1 l2 = l1 || l2
instance Combine (Program DebugToCSemanticInfo) where
combine Empty{} p2 = p2
combine p1 _ = p1
data GetPrgParLoop = GetPrgParLoop
instance Transformation GetPrgParLoop where
type From GetPrgParLoop = DebugToCSemanticInfo
type To GetPrgParLoop = DebugToCSemanticInfo
type Down GetPrgParLoop = (Int, Int)
type Up GetPrgParLoop = (Bool, Program DebugToCSemanticInfo)
type State GetPrgParLoop = ()
instance Plugin GetPrgParLoop where
type ExternalInfo GetPrgParLoop = (Int, Int)
executePlugin GetPrgParLoop (line, col) procedure =
result $ transform GetPrgParLoop () (line, col) procedure
getPrgParLoop :: (Int, Int) -> Module DebugToCSemanticInfo -> (Bool, Program DebugToCSemanticInfo)
getPrgParLoop (line, col) procedure = up res where
res = transform GetPrgParLoop () (line, col) procedure
instance Transformable GetPrgParLoop Program where
transform t () (line, col) pl@(ParLoop _ _ _ prog inf1 _) = Result pl () info where
info = case contains (line, col) inf1 of
True -> infoCr where
res = transform t () (line, col) prog
infoCr = if fst $ up res then up res else (True, pl)
_ -> def
transform t () (line, col) pr = defaultTransform t () (line, col) pr
data GetPrgAssign = GetPrgAssign
instance Transformation GetPrgAssign where
type From GetPrgAssign = DebugToCSemanticInfo
type To GetPrgAssign = DebugToCSemanticInfo
type Down GetPrgAssign = (Int, Int)
type Up GetPrgAssign = (Bool, Program DebugToCSemanticInfo)
type State GetPrgAssign = ()
instance Plugin GetPrgAssign where
type ExternalInfo GetPrgAssign = (Int, Int)
executePlugin GetPrgAssign (line, col) procedure =
result $ transform GetPrgAssign () (line, col) procedure
getPrgAssign :: (Int, Int) -> Module DebugToCSemanticInfo -> (Bool, Program DebugToCSemanticInfo)
getPrgAssign (line, col) procedure = up res where
res = transform GetPrgAssign () (line, col) procedure
instance Transformable GetPrgAssign Program where
transform _ () (line, col) assign@(Assign _ _ inf1 _) = Result assign () info where
info = if contains (line, col) inf1 then (True, assign) else def
transform t () (line, col) pr = defaultTransform t () (line, col) pr
data GetPrgBranch = GetPrgBranch
instance Transformation GetPrgBranch where
type From GetPrgBranch = DebugToCSemanticInfo
type To GetPrgBranch = DebugToCSemanticInfo
type Down GetPrgBranch = (Int, Int)
type Up GetPrgBranch = (Bool, Program DebugToCSemanticInfo)
type State GetPrgBranch = ()
instance Plugin GetPrgBranch where
type ExternalInfo GetPrgBranch = (Int, Int)
executePlugin GetPrgBranch (line, col) procedure =
result $ transform GetPrgBranch () (line, col) procedure
getPrgBranch :: (Int, Int) -> Module DebugToCSemanticInfo -> (Bool, Program DebugToCSemanticInfo)
getPrgBranch (line, col) procedure = up res where
res = transform GetPrgBranch () (line, col) procedure
instance Transformable GetPrgBranch Program where
transform t () (line, col) br@(Branch _ prog1 prog2 inf1 _) = Result br () info where
info = case contains (line, col) inf1 of
True -> infoCr where
res1 = transform t () (line, col) prog1
res2 = transform t () (line, col) prog2
res = combine (up res1) (up res2)
infoCr = if fst res then res else (True,br)
_ -> def
transform t () (line, col) pr = defaultTransform t () (line, col) pr
data GetPrgProcCall = GetPrgProcCall
instance Transformation GetPrgProcCall where
type From GetPrgProcCall = DebugToCSemanticInfo
type To GetPrgProcCall = DebugToCSemanticInfo
type Down GetPrgProcCall = (Int, Int)
type Up GetPrgProcCall = (Bool, Program DebugToCSemanticInfo)
type State GetPrgProcCall = ()
instance Plugin GetPrgProcCall where
type ExternalInfo GetPrgProcCall = (Int, Int)
executePlugin GetPrgProcCall (line, col) procedure =
result $ transform GetPrgProcCall () (line, col) procedure
getPrgProcCall :: (Int, Int) -> Module DebugToCSemanticInfo -> (Bool, Program DebugToCSemanticInfo)
getPrgProcCall (line, col) procedure = up res where
res = transform GetPrgProcCall () (line, col) procedure
instance Transformable GetPrgProcCall Program where
transform _ () (line, col) pc@(ProcedureCall _ _ inf1 _) = Result pc () info where
info = if contains (line,col) inf1 then (True,pc) else def
transform t () (line, col) pr = defaultTransform t () (line, col) pr
data GetPrgSeqLoop = GetPrgSeqLoop
instance Transformation GetPrgSeqLoop where
type From GetPrgSeqLoop = DebugToCSemanticInfo
type To GetPrgSeqLoop = DebugToCSemanticInfo
type Down GetPrgSeqLoop = (Int, Int)
type Up GetPrgSeqLoop = (Bool, Program DebugToCSemanticInfo)
type State GetPrgSeqLoop = ()
instance Plugin GetPrgSeqLoop where
type ExternalInfo GetPrgSeqLoop = (Int, Int)
executePlugin GetPrgSeqLoop (line, col) procedure =
result $ transform GetPrgSeqLoop () (line, col) procedure
getPrgSeqLoop :: (Int, Int) -> Module DebugToCSemanticInfo -> (Bool, Program DebugToCSemanticInfo)
getPrgSeqLoop (line, col) procedure = up res where
res = transform GetPrgSeqLoop () (line, col) procedure
instance Transformable GetPrgSeqLoop Program where
transform t () (line, col) sl@(SeqLoop _ _ prog inf1 _) = Result sl () info where
info = case contains (line, col) inf1 of
True -> infoCr where
res = transform t () (line, col) prog
infoCr = if fst $ up res then up res else (True, sl)
_ -> def
transform t () (line, col) pr = defaultTransform t () (line, col) pr
contains :: (Ord a, Ord b) => (a,b) -> ((a,b),(a,b)) -> Bool
contains (line, col) ((bl, bc), (el, ec)) = (line == bl && bc <= col) || (bl < line && line < el) || (line == el && col <= ec)
myShow :: Program DebugToCSemanticInfo -> String
myShow (Assign l r inf1 _) = "Assign \n" ++ ind show l ++ "\n=\n" ++ ind show r ++ "\n" ++ show inf1 ++ "\n"
myShow (Sequence progs inf1 _) = "Sequence\n" ++ ind (listprint myShow "\n") progs ++ "\n" ++ show inf1 ++ "\n"
myShow (Branch _ tb eb inf1 _) = "Branch\n" ++ ind myShowB tb ++ "\nelse\n" ++ ind myShowB eb ++ "\n" ++ show inf1 ++ "\n"
myShow (ParLoop count bound step block inf1 _)
= "ParLoop\n count: " ++ show count ++ "\n bound: " ++ show bound ++ "\n step: " ++ show step ++ "\n" ++ ind myShowB block ++ "\n" ++ show inf1 ++ "\n"
myShow x = show x
myShowB :: Block DebugToCSemanticInfo -> String
myShowB (Block ls prg inf) = "Block\n" ++ ind show ls ++"\n" ++ ind myShow prg ++ show inf