Commit 5772698d authored by Diederik van Arkel's avatar Diederik van Arkel
Browse files

updated syntax colouring;

parent 23835bdc
......@@ -25,7 +25,7 @@ export TextAnnot Void, SyncInf, ConsInf
*/
:: LineAnnot :== Info
dummyLineAnnot :== (0,False,False,0)
dummyLineAnnot :== (0,False,False,0,False)
annotLine :== slMap (\s->(dummyLineAnnot,s))
annotWhole :== firstParse
annotPart :== quickParse
......
......@@ -94,7 +94,7 @@ optDrawS :== pictdrawstring // use non-optimised versions
optDrawC :== pictdrawchar // "
tabDrawStringC :: !Point2 !(!Info,!String) !FontInfo !*Picture -> *Picture
tabDrawStringC point ((clevel,typedef,typedecl,_),string)
tabDrawStringC point ((clevel,typedef,typedecl,_,_),string)
{tabSize,charWidth,thefont, showTabs, syntaxColours={textColour, backgroundColour,tabColour, commentColour, stringColour, charColour, keywordColour, typedefColour, typedeclColour}}
picture
#! strings = splitAtTabs string
......
......@@ -12,6 +12,7 @@ import StrictList
// ,!Bool // in typedecl at start of line
,!Bool // is typedecl line
,!Int // context offside level
,!Bool // flush accu
)
// pack bools into bitfield?
......
......@@ -4,332 +4,405 @@ implementation module syncol
import StdArray, StdClass, StdBool, StdList, StdFunc, StdString
import StrictList
/*
:: Private =
{ num :: !Int
, icl_only :: !Bool
}
Start
// = scanFirst 0 0 0 line1 // (index,indent,level)
# s0 = (0,False,False,0)
# s1 = parseLine s0 line1
# s2 = parseLine s1 line2
# s3 = parseLine s2 line3
# s4 = parseLine s3 line4
# s5 = parseLine s4 line5
= (s0,s1,s2,s3,s4,s5)
where
line1 = ":: State = "
line2 = " {num::Int}"
line3 = "fun :: frups"
line4 = " -> fraps"
line5 = "global :== something"
*/
trace_n` msg v :== v
import StdMisc
import nodebug
//import dodebug
//slFromList` :: ![a] -> StrictList a
slFromList` [] r = r
slFromList` [x:xs] r = SCons x (slFromList` xs r)
:: State =
{ level :: !Int // comment nesting level at start of line
, typedef :: !Bool // in typedef at start of line
, typedecl :: !Bool // in typedecl at start of line
, offside :: !Int // typedecl offside level
, parse_state :: !ParseState
, has_content :: !Bool
}
:: ParseState = StartOfBlock | CleanId | OpenPar | InfixId | Precedence | Fixity | Other
iniState
=
{ level = 0
, typedef = False
, typedecl = False
, offside = 0
, parse_state = StartOfBlock
, has_content = False
}
/*
parseLine: initial comment nesting level & textline -> new comment nesting level
firstParse: textlines -> zip initial comment nesting level & textlines
*/
firstParse :: !(StrictList String) -> StrictList (!Info,!String)
firstParse lines
# parsed_lines = parse iniState lines
= slFromList (backpatch iniState id [] parsed_lines)
where
parse :: State (StrictList String) -> [(State,String)]
parse state SNil
= []
parse state (SCons line lines)
# state = parseLine state line
= [(state,line) : parse state lines]
:: State :==
( !Int // comment nesting level at start of line
, !Bool // in typedef at start of line
, !Bool // in typedecl at start of line
, !Int // typedecl offside level
)
:: Info` :==
(!Int // comment nesting level at start of line
,!Bool // is typedef line
// ,!Int // typedecl offside level
,!Bool // is typedecl line
)
backpatch :: State ([(Info,String)] -> [(Info,String)]) [(Info,String)] [(State,String)] -> [(Info,String)]
backpatch state res acc []
= res acc
backpatch state res acc old=:[(state`,line):lines]
# flush = state`.has_content || (not (state.typedecl) && state`.typedecl)
# info = ((state.level,state`.typedef,state`.typedecl,state`.offside,flush),line)
| state`.has_content
= backpatch state` (copy res acc) [info] lines
| not (state.typedecl) && state`.typedecl
= backpatch state` (patch res acc) [info] lines
= backpatch state` res (accum acc info) lines
scanFirst :: !Int !Int !Int !.String -> (!Int,!Int,!Int)
scanFirst level index indent line
| index >= line_size = (index,-1,level)
# char = line.[index]
| char == ' ' = scanFirst level (inc index) (inc indent) line
| char == '\t' = scanFirst level (inc index) ((inc (indent >> 2)) << 2) line
| char == '\n' = scanFirst level (inc index) indent line
| char == '\r' = scanFirst level (inc index) indent line
| char == '\f' = scanFirst level (inc index) indent line
| char == '*'
# index` = inc index
indent` = inc indent
| index` >= line_size = (index,indent,level)
| line.[index`] == '/'
# index`` = inc index`
indent`` = inc indent`
| level <> 0 = scanFirst (dec level) index`` indent`` line // try to fix problem below
| index`` >= line_size = (index``,-1,dec level)
| funnyChar line.[index``]
= (index,indent,level) // hmmm excludes */*/ and *//*...*/
= scanFirst (dec level) index`` indent`` line
| level == 0
= (index,indent,level)
= scanFirst level index` indent` line
| char == '/'
# index` = inc index
indent` = inc indent
| index` >= line_size = (index,indent,level)
# char` = line.[index`]
| char` == '/' = (index,-1,level) // shouldn't we exclude funnyId's ??
| char` == '*' = scanFirst (inc level) (inc index`) (inc indent`) line
| level == 0
= (index,indent,level)
= scanFirst level index` indent` line
| level <> 0
= scanFirst level (inc index) (inc indent) line
= (index,indent,level)
where
line_size = size line
/*
quickParse: (first modified line) (last modified line) textlines
-> last changed line with different comment nesting & textlines
*/
funnyChar c = isStringMember c (dec funnySize) funnyChars
quickParse :: !Int !Int !(StrictList (!Info,!String)) -> (Int,Int,StrictList (!Info,!String))
//quickParse fln lln text
// = (0,slLength text - 1,firstParse (slMap snd text))
quickParse beg end lines
# (s,f,l) = before 0 slFromList iniState [] lines
= trace_n` ("qP",beg,end,s,f) (s,f,l)
where
isStringMember :: !Char !Int !String -> Bool
isStringMember x i s
| i < 0 = False
#! c = s.[i]
| c == x = True
= isStringMember x (dec i) s
before idx res state acc SNil
= (0,0,res acc)
before idx res state acc old=:(SCons (info=:(level,def,dec,off,flush),line) lines)
| idx >= beg
# beg` = idx - length acc
= during beg` beg` state res [] (slAppend (slFromList acc) old) //(acc++old)
| flush
= before (inc idx) res state (acc++[(info,line)]) lines
= before (inc idx) (copy res acc) {state& level=level,typedef=def,typedecl=dec,offside=off} [(info,line)] lines
during beg idx state res acc SNil
= (beg,dec idx,res acc)
during beg idx state res acc old=:(SCons (_,line) lines)
| idx >= end
= after beg idx state res acc old
# state` = parseLine state line
# flush = state`.has_content || (not (state.typedecl) && state`.typedecl)
# info = ((state.level,state`.typedef,state`.typedecl,state`.offside,state`.has_content),line)
| state`.has_content
= during beg (inc idx) state` (copy res acc) [info] lines
| not (state.typedecl) && state`.typedecl
= during beg idx {state & typedecl=True} (patch res acc) [] old
= during beg (inc idx) state` res (acc++[info]) lines
after beg idx state res acc SNil
= (beg,dec idx,res acc)
after beg idx state res acc old=:(SCons (info,line) lines)
// kan stoppen als na flush info's gelijk zijn...
# state` = parseLine state line
# flush` = state`.has_content || (not (state.typedecl) && state`.typedecl)
# info` = (state.level,state`.typedef,state`.typedecl,state`.offside,flush`)
| state`.has_content
| eqInfo info info`
= (beg, idx,res (acc ++ (slToList old)))
= after beg (inc idx) state` (copy res acc) [(info`,line)] lines
| not (state.typedecl) && state`.typedecl
= after beg idx {state & typedecl=True} (patch res acc) [] old
= after beg (inc idx) state` res (acc++[(info`,line)]) lines
funnyChars =: "~@#$%^?!+-*<>\\/|&=:."
funnySize = 20 // =: size funnyChars?
copy res acc rest
= res (acc ++ rest)
patch res acc rest
= res ((map (\((c,t,d,o,h),l)->((c,False,True,o,h),l)) acc) ++ rest)
accum acc info
= acc ++ [info]
scanfunny :: !Int !Int !String -> Int
scanfunny i line_size line
| i >= line_size = line_size
| funnyChar line.[i] = scanfunny (inc i) line_size line
= i
eqInfo :: !Info !Info -> Bool
eqInfo (a,b,c,d,e) (a`,b`,c`,d`,e`) = a==a` && b==b` && c==c` && d==d` && e==e`
//:: String State -> ((Info,String),State)
parseLine :: !.State !.String -> (!Bool,!State)
parseLine state=:(level,typedef,typedecl,offside) line
#! (index,indent,level) = scanFirst level 0 0 line
#! (typedecl,offside) = if typedecl
instance == ParseState where
(==) StartOfBlock StartOfBlock = True
(==) CleanId CleanId = True
(==) OpenPar OpenPar = True
(==) InfixId InfixId = True
(==) Precedence Precedence = True
(==) Fixity Fixity = True
(==) Other Other = True
(==) _ _ = False
parseLine state=:{level,typedef, typedecl,offside,parse_state} line
#! (index,indent,level) = scanFirst level line
#! (typedecl,offside`) = if typedecl
(if (index < line_size && indent >= 0 && indent <= offside)
(False,indent)
(True,offside)
)
(False,if (indent >= 0) indent offside)
#! state = (level,typedef,typedecl,offside)
(False,if (indent >= 0) (case parse_state of
OpenPar -> offside
InfixId -> offside
Fixity -> offside
Precedence -> offside
CleanId -> offside
_ -> indent
)
offside)
#! parse_state = if (indent==offside`)
(case parse_state of
OpenPar -> OpenPar
InfixId -> InfixId
Fixity -> Fixity
Precedence -> Precedence
CleanId -> CleanId
_ -> StartOfBlock
)
parse_state
#! typedef = if (index==0 && indent >= 0 && not (whiteChar line.[0])) False typedef
#! has_content = indent >= 0 && index < line_size
| index > 0
#! not_double_colon = line%(index,dec (scanfunny index line_size line)) <> "::"
= (has_content && not_double_colon, pL state index)
= (has_content, pL state index)
// = (has_content && if (index > 0) not_double_colon True , pL state index)
# not_double_colon = line%(index,dec (scanfunny index line_size line)) <> "::"
not_typedecl_prefix = parse_state == StartOfBlock
#! has_content = if (index>0)
(has_content && not_double_colon && not_typedecl_prefix)
has_content
#! state = {state
& level=level
, typedef=typedef
, typedecl=typedecl
, offside=offside`
, parse_state=parse_state
, has_content=has_content
}
= pL state index
where
line_size
// e.g. need to check for where and let here...
:: Int
line_size = size line
(
arggh
)
:: Int -> Int
(arggh) i = i + 1
pL state=:{level,parse_state} i // parse normal text
| i >= line_size = state
# end = getToken level i line line_size
# token = line%(i,dec end)
= case token of
"/*" -> pL {state & level = inc level} end // BC
"*/" -> pL {state & level = dec level} end // EC
"//" -> state // LC
"::" -> if0 // FI special case...
(case parse_state of
StartOfBlock
| i == 0
-> pL {state & typedef = True, parse_state = Other} end
-> pL {state & parse_state = Other} end
CleanId -> pL {state & typedecl = True, parse_state = Other} end
Fixity -> pL {state & typedecl = True, parse_state = Other} end
Precedence -> pL {state & typedecl = True, parse_state = Other} end
_ -> pL {state & parse_state = Other} end
)
(pL state end)
"where" -> if0
(pL {state & parse_state = Other} end)
(pL state end)
"let" -> if0
(pL {state & parse_state = Other} end)
(pL state end)
"infix" -> if0 // LI special case...
(if (parse_state==CleanId)
(pL {state & parse_state = Fixity} end)
(pL {state & parse_state = Other} end)
)
(pL state end)
"infixl" -> if0 // LI special case...
(if (parse_state==CleanId)
(pL {state & parse_state = Fixity} end)
(pL {state & parse_state = Other} end)
)
(pL state end)
"infixr" -> if0 // LI special case...
(if (parse_state==CleanId)
(pL {state & parse_state = Fixity} end)
(pL {state & parse_state = Other} end)
)
(pL state end)
"(" -> if0 // OP .. CP
(if (parse_state==StartOfBlock)
(pL {state & parse_state = OpenPar} end)
(pL {state & parse_state = Other} end)
)
(pL state end)
")" -> if0 // CP
(if (parse_state==InfixId)
(pL {state & parse_state = CleanId} end)
(pL {state & parse_state = Other} end)
)
(pL state end)
_
| isDigit line.[i]
-> if0
(if (parse_state==Fixity)
(pL {state & parse_state = Precedence} end)
(pL {state & parse_state = Other} end)
)
(pL state end)
| isLower line.[i] || isUpper line.[i] || funnyChar line.[i]
-> if0
(if (parse_state==StartOfBlock)
(pL {state & parse_state = CleanId} end)
(if (parse_state==OpenPar)
(pL {state & parse_state = InfixId} end)
(pL {state & parse_state = Other} end)
)
)
(pL state end)
| whiteChar line.[i]
-> (pL state end)
// otherwise
-> if0
(pL {state & parse_state = Other} end)
(pL state end)
where
if0 t f
| level==0 = t
= f
proceed si so se
| parse_state == si = so
= se
// rework scanFirst to use getToken?!
scanFirst :: !Int !.String -> (!Int,!Int,!Int)
scanFirst level line = scanFirst level 0 0 line
where
line_size = size line
pL :: !State !Int -> State
pL (level,typedef,typedecl,offside) i // parse normal text
| i >= line_size = (level,typedef,typedecl,offside)
#! char = line.[i]
scanFirst :: !Int !Int !Int !.String -> (!Int,!Int,!Int)
// commentlevel index indent line -> (first_index,first_indent,commentlevel)
scanFirst level index indent line
| index >= line_size = (index,-1,level)
# char = line.[index]
| char == ' ' = scanFirst level (inc index) (inc indent) line
| char == '\t' = scanFirst level (inc index) ((inc (indent >> 2)) << 2) line // assumes tab=4
| char == '\n' = scanFirst level (inc index) indent line
| char == '\r' = scanFirst level (inc index) indent line
| char == '\f' = scanFirst level (inc index) indent line
| char == '*'
# i = inc i
| i >= line_size = (level,typedef,typedecl,offside)
| line.[i] == '/'
#! i = inc i
| level <> 0 = pL (dec level,typedef,typedecl,offside) i // try to fix problem below
| i < line_size && funnyChar line.[i]
= scanFunny (level,typedef,typedecl,offside) i i // hmmm excludes */*/ and *//*...*/
= pL (dec level,typedef,typedecl,offside) i
= pL (level,typedef,typedecl,offside) i
# index` = inc index
indent` = inc indent
| index` >= line_size = (index,indent,level)
| line.[index`] == '/'
# index`` = inc index`
indent`` = inc indent`
| level <> 0 = scanFirst (dec level) index`` indent`` line // try to fix problem below
| index`` >= line_size = (index``,-1,dec level)
| funnyChar line.[index``]
= (index,indent,level) // hmmm excludes */*/ and *//*...*/
= scanFirst (dec level) index`` indent`` line
| level == 0
= (index,indent,level)
= scanFirst level index` indent` line
| char == '/'
#! i = inc i
| i >= line_size = (level,typedef,typedecl,offside)
#! char = line.[i]
| char == '/' = (level,typedef,typedecl,offside) // shouldn't we exclude funnyId's ??
| char == '*' = pL (inc level,typedef,typedecl,offside) (inc i)
= pL (level,typedef,typedecl,offside) i
| (char == '"') && (level == 0)
= pS (level,typedef,typedecl,offside) (inc i)
| (char == '\'') && (level == 0)
= pC (level,typedef,typedecl,offside) (inc i)
| (level == 0) && (funnyChar char)
= scanFunny (level,typedef,typedecl,offside) i i
| i == 0 && not (WhiteSpace char)
= pL (level,False,typedecl,offside) (inc i)
= pL (level,typedef,typedecl,offside) (inc i)
scanFunny :: !State !Int !Int -> State
scanFunny (level=:0,typedef,typedecl,offside) _ 0
| (line_size == 2 && line == "::")
|| (line_size >= 3 && line%(0,1) == "::" && not (funnyChar line.[2]))
= pL (level,True,False,offside) 2
# c = line.[0]
| typedef
| (line_size == 1 && (line == "|" || line == "="))
|| (line_size >= 2 && (line%(0,0) == "|" || line%(0,0) == "=") && not (funnyChar line.[1]))
|| (line_size == 3 && line == ":==")
|| (line_size >= 4 && line%(0,2) == ":==" && not (funnyChar line.[3]))
= pL (level,typedef,typedecl,offside) 1
| funnyChar c
= scanFunny (level,False,typedecl,offside) 0 1
= pL (level,False,typedecl,offside) 0
| funnyChar c
= scanFunny (level,typedef,typedecl,offside) 0 1
= pL (level,typedef,typedecl,offside) 0
where
no_c` = line_size < 2
c` = line.[1]
scanFunny (level,typedef,typedecl,offside) s i
| i >= line_size
| level == 0 && line%(s,dec i) == "::"
= pL (0,typedef,True,offside) i
= pL (level,typedef,typedecl,offside) i
#! c = line.[i]
| funnyChar c = scanFunny (level,typedef,typedecl,offside) s (inc i)
| level == 0 && line%(s,dec i) == "::"
= pL (0,typedef,True,offside) i
= pL (level,typedef,typedecl,offside) i
# index` = inc index
indent` = inc indent
| index` >= line_size = (index,indent,level)
# char` = line.[index`]
| char` == '/' = (index,-1,level) // shouldn't we exclude funnyId's ??
| char` == '*' = scanFirst (inc level) (inc index`) (inc indent`) line
| level == 0
= (index,indent,level)
= scanFirst level index` indent` line
| level <> 0
= scanFirst level (inc index) (inc indent) line
= (index,indent,level)
pS cl i // parse string constant
| i >= line_size = cl // unterminated string constant...
# char = line.[i]
| char == '"' = pL cl (inc i)
| char == '\\'
= pS cl (i + 2)
= pS cl (inc i)
////////////
pC cl i // parse character constant
| i >= line_size = cl // unterminated char constant...
# char = line.[i]
| char == '\'' = pL cl (inc i)
| char == '\\' = pC cl (i + 2)
= pC cl (inc i)
// pT i // parse type
isStringMember :: !Char !Int !String -> Bool
isStringMember x i s
| i < 0 = False
#! c = s.[i]
| c == x = True
= isStringMember x (dec i) s
WhiteSpace c
:== c == ' ' || c == '\t' || c == '\n' || c == '\r' || c == '\f';
funnyChar c = isStringMember c (dec funnySize) funnyChars
where
funnyChars =: "~@#$%^?!+-*<>\\/|&=:."
funnySize = 20 // =: size funnyChars?
//slFromList` :: ![a] -> StrictList a
slFromList` [] r = r
slFromList` [x:xs] r = SCons x (slFromList` xs r)
scanfunny :: !Int !Int !String -> Int
scanfunny i line_size line
| i >= line_size = line_size
| funnyChar line.[i] = scanfunny (inc i) line_size line
= i
/*
firstParse: textlines -> zip initial comment nesting level & textlines
*/
firstParse :: !(StrictList String) -> StrictList (!Info,!String)
firstParse lines
// = slFromList (fP (0,False,False,0) [] lines)
= fP (0,False,False,0) id [] lines
where
fP :: !(!Int,!Bool,!Bool,!Int) ((StrictList (!Info,!String)) -> StrictList (!Info,!String)) ![(!(!Int,!Bool,!Bool,!Int),!String)] !(StrictList String) -> StrictList (!Info,!String)
fP i res acc SNil
= res (slFromList acc)
fP i=:(level,typedef,typedecl,offside) res acc (SCons h t)
#! (has_contents,j=:(level`,typedef`,typedecl`,offside`)) = parseLine i h
i` = (level,typedef`,typedecl`,offside`)