attic/hsedit
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

offset but somethings wrong

Browse source
This commit is contained in:
Armin Friedl 2016-08-29 09:16:52 +02:00
parent 8249503206
commit 246d397ed8
1 changed files with 31 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

53
src/App/Fontifier.hs
View file

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