offset but somethings wrong
This commit is contained in:
Armin Friedl
parent
8249503206
commit
246d397ed8
1 changed files with 31 additions and 22 deletions
|
|
@ -68,13 +68,13 @@ fontMap = [ (attrName "assignment" , fg Vty.blue)
|
|||
, (attrName "err_quotes" , Vty.withStyle (fg Vty.red) Vty.underline) -- unbalanced quotes
|
||||
, (attrName "err_read" , Vty.withStyle (fg Vty.yellow) Vty.underline) -- invalid read
|
||||
, (attrName "err_write" , Vty.withStyle (fg Vty.red) Vty.underline) -- invalid write
|
||||
, (attrName "err_access" , Vty.withStyle (fg Vty.red) Vty.underline) -- invalid access (alternative if easier than invalid read/invalid write separated)
|
||||
, (attrName "warn_access" , Vty.withStyle (fg Vty.red) Vty.underline) -- invalid access (alternative if easier than invalid read/invalid write separated)
|
||||
]
|
||||
|
||||
fontify :: CheckString -> Fontifications
|
||||
fontify = concatApply [ assignments, strings
|
||||
, returns, guards, comments
|
||||
, invalidAccess
|
||||
, warnAccess
|
||||
, mismatchedBrackets
|
||||
, mismatchedQuotes]
|
||||
|
||||
|
|
@ -100,13 +100,13 @@ guards = slicesToFT §: "guard" §. matchGrpStripCmts 1 §~ "\\[([^
|
|||
|
||||
mismatchedBrackets s = concatMap (mismatched §: "err_brackets" $ s) [('(',')'),('[',']'),('{','}')]
|
||||
|
||||
invalidAccess s = let strip = prune $ (comments s) ++ (strings s) in -- removes strings and comments from fontification
|
||||
(slicesToFT §: "err_read" $ strip $ invalidReads s) ++
|
||||
(slicesToFT §: "err_write" $ strip $ invalidWrites s)
|
||||
-- warnAccess s = let strip = prune $ (comments s) ++ (strings s) in -- removes strings and comments from fontification
|
||||
-- (slicesToFT §: "warn_read" $ strip $ invalidReads s) ++
|
||||
-- (slicesToFT §: "warn_write" $ strip $ invalidWrites s)
|
||||
|
||||
-- (alternative if easier than invalid read/invalid write separated)
|
||||
-- invalidAccess s = let strip = prune $ (comments s) ++ (strings s) in
|
||||
-- slicesToFT §: "err_access" $ strip $ invAcc s
|
||||
warnAccess s = let strip = prune $ (comments s) ++ (strings s) in
|
||||
slicesToFT §: "warn_access" $ strip $ invalidAccesses s
|
||||
|
||||
{--- Utility Functions ---}
|
||||
|
||||
|
|
@ -179,11 +179,15 @@ invalidReads s = [] -- do magic here
|
|||
--invalidWrites :: CheckString -> Slices
|
||||
invalidWrites s = [] -- do magic here
|
||||
|
||||
-- facade to init invAcc
|
||||
invalidAccesses = invAcc [] "" 0
|
||||
|
||||
-- (alternative if easier than invalid read/invalid write separated)
|
||||
invAcc :: [(String,Slice,Bool)] -> String -> CheckString -> Slices
|
||||
invAcc a _ ('{':t) = invAcc (enterBlock a) "" t
|
||||
invAcc a accumStr ('}':t) = invAcc (leaveBlock a) "" t
|
||||
invAcc a accumStr ('[':t) = invAcc a accumStr (drop g t) -- TODO check reads in first part
|
||||
-- :: CurrentAssignments -> AccumulatorString -> GlobalIndex
|
||||
invAcc :: [(String,Slice,Bool)] -> String -> Int -> CheckString -> Slices
|
||||
invAcc a accumStr i ('{':t) = invAcc (enterBlock a) "" (i+1+(length accumStr)) t
|
||||
invAcc a accumStr i ('}':t) = invAcc (leaveBlock a) "" (i+1+(length accumStr)) t
|
||||
invAcc a accumStr i ('[':t) = invAcc a accumStr (i+1 + g+1) (drop g t) -- TODO check reads in first part
|
||||
where g = fromJust (elemIndex ':' t)
|
||||
-- when reading an assignment :word: =
|
||||
-- put :word:, slice, false in the list
|
||||
|
|
@ -191,17 +195,22 @@ invAcc a accumStr ('[':t) = invAcc a accumStr (drop g t) -- TODO check rea
|
|||
-- if it is found set its boolean value to true
|
||||
-- if it is not found add its slice to the result
|
||||
-- all variables with false at the end of a block are unused
|
||||
invAcc a accumStr (c:t) = let chkAccum = checkAccum 0 accumStr -- we need to track the actual index position in the string
|
||||
in if isNothing chkAccum
|
||||
then invAcc a (accumStr ++ [c]) t -- no assignment in accumStr
|
||||
else invAcc (a ++ [fromJust chkAccum]) "" t -- assignment in accumStr
|
||||
invAcc _ _ _ = []
|
||||
invAcc a accumStr i (c:t) = let writeAcc = getWrite i accumStr
|
||||
in if isNothing writeAcc
|
||||
then invAcc a (accumStr ++ [c]) i t -- no assignment in accumStr, don't advance offset
|
||||
else invAcc (a ++ [fromJust writeAcc]) [c] (i+(length accumStr)) t -- assignment in accumStr, advance offset to end
|
||||
invAcc a _ _ _ = aToSlices a []
|
||||
where aToSlices (a:as) slices = let a2 = (\(v,s,b) -> (s,b)) a
|
||||
in if snd a2
|
||||
then aToSlices as slices
|
||||
else aToSlices as ((fst a2):slices)
|
||||
aToSlices _ slices = slices
|
||||
|
||||
checkAccum :: Int -> String -> Maybe (String, Slice, Bool)
|
||||
checkAccum offset accumStr = ((Tdfa.matchOnceText §~ "(\\**[[:word:]]+)[[:blank:]]*=") accumStr) >>= matchToA
|
||||
where matchToA (before, match, after) =
|
||||
let m = match ! 1 -- extract the match group (0 = the whole match)
|
||||
in Just (fst m, (offset+(fst (snd m)), offset+(fst (snd m))+(snd (snd m))), False)
|
||||
getWrite :: Int -> String -> Maybe (String, Slice, Bool)
|
||||
getWrite offset accumStr = ((Tdfa.matchOnceText §~ "(\\**[[:word:]]+)[[:blank:]]*=") accumStr) >>= matchToA
|
||||
where matchToA (before, match, after) =
|
||||
let m = match ! 1 -- extract the match group (0 = the whole match)
|
||||
in Just (fst m, (offset+(fst (snd m)), offset+(fst (snd m))+(snd (snd m))), False)
|
||||
|
||||
enterBlock :: [(String,Slice,Bool)] -> [(String,Slice,Bool)]
|
||||
enterBlock = map (\(v,s,b) -> ('*':v,s,b))
|
||||
|
|
@ -209,7 +218,7 @@ enterBlock = map (\(v,s,b) -> ('*':v,s,b))
|
|||
-- remove 1 * from each variable name
|
||||
-- if it cannot be removed, remove the variable
|
||||
leaveBlock :: [(String,Slice,Bool)] -> [(String,Slice,Bool)]
|
||||
leaveBlock _ = []
|
||||
leaveBlock a = a
|
||||
|
||||
{- General Fontification Utilities -}
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue