Skip to content

GitLab

C
clean-ide
Commit 69af5577 authored by John van Groningen's avatar John van Groningen
Browse files
Options

use a reversed acc in local function 'before' to prevent 

quadratic cost due to use of ++, use 'if (level==0)' instead
of 'if0' in function pL to reduce memory allocation (because if0
is lazy in last two arguments) and improve speed.
parent 3b7a6dc0
Hide whitespace changes
Inline Side-by-side
Showing with 33 additions and 40 deletions
Ed/syncol.icl
View file @ 69af5577
......@@ -2,10 +2,10 @@ implementation module syncol
// provides preparsing for Clean syntax colouring.
import StdArray, StdClass, StdBool, StdList, StdFunc, StdString
import StdArray, StdClass, StdBool, StdList, StdFunc, StdString, StdTuple,StdMisc
import StrictList
import StdTuple
import StdMisc
//import nodebug
//import dodebug // StdDebug
trace_n` _ f :== f
......@@ -38,6 +38,7 @@ iniState
/*
firstParse: textlines -> zip initial comment nesting level & textlines
*/
firstParse :: !(StrictList String) -> StrictList (!Info,!String)
firstParse lines
# parsed_lines = parse iniState lines
......@@ -73,15 +74,16 @@ quickParse beg end lines
// # l` = firstParse (slMap snd text)
= trace_n` ("qP",beg,end,s,f) (s,f,l)
where
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
before idx res state reversed_acc SNil
= (0,0,res (reverse reversed_acc))
before idx res state reversed_acc old=:(SCons (info=:(level,def,dec,off,flush),line) lines)
| idx < beg
| flush
= before (inc idx) res state [(info,line):reversed_acc] lines
= before (inc idx) (copy res (reverse reversed_acc)) {state& level=level,typedef=def,typedecl=dec,offside=off} [(info,line)] lines
# beg` = idx - length reversed_acc
= during beg` beg` state res [] (slAppend (slFromList (reverse reversed_acc)) old) //(acc++old)
during beg idx state res acc SNil
= (beg,dec idx,res acc)
during beg idx state res acc old=:(SCons (_,line) lines)
......@@ -95,6 +97,7 @@ where
| 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)
......@@ -112,8 +115,10 @@ where
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]
......@@ -129,7 +134,7 @@ instance == ParseState where
(==) 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
......@@ -173,15 +178,10 @@ parseLine state=:{level,typedef, typedecl,offside,parse_state} line
}
= pL state index
where
line_size
// e.g. need to check for where and let here...
:: Int
// e.g. need to check for where and let here...
line_size = size line
(
arggh
)
:: Int -> Int
(arggh) :: Int -> Int
(arggh) i = i + 1
pL state=:{level,parse_state} i // parse normal text
......@@ -192,7 +192,7 @@ where
"/*" -> pL {state & level = inc level} end // BC
"*/" -> pL {state & level = dec level} end // EC
"//" -> state // LC
"::" -> if0 // FI special case...
"::" -> if (level==0) // FI special case...
(case parse_state of
StartOfBlock
| i == 0
......@@ -204,37 +204,37 @@ where
_ -> pL {state & parse_state = Other} end
)
(pL state end)
"where" -> if0
"where" -> if (level==0)
(pL {state & parse_state = Other} end)
(pL state end)
"let" -> if0
"let" -> if (level==0)
(pL {state & parse_state = Other} end)
(pL state end)
"infix" -> if0 // LI special case...
"infix" -> if (level==0) // 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...
"infixl" -> if (level==0) // 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...
"infixr" -> if (level==0) // 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 (level==0) // OP .. CP
(if (parse_state==StartOfBlock)
(pL {state & parse_state = OpenPar} end)
(pL {state & parse_state = Other} end)
)
(pL state end)
")" -> if0 // CP
")" -> if (level==0) // CP
(if (parse_state==InfixId)
(pL {state & parse_state = CleanId} end)
(pL {state & parse_state = Other} end)
......@@ -242,14 +242,14 @@ where
(pL state end)
_
| isDigit line.[i]
-> if0
-> if (level==0)
(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 (level==0)
(if (parse_state==StartOfBlock)
(pL {state & parse_state = CleanId} end)
(if (parse_state==OpenPar)
......@@ -261,18 +261,12 @@ where
| whiteChar line.[i]
-> (pL state end)
// otherwise
-> if0
-> if (level==0)
(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
......@@ -288,7 +282,6 @@ where
| 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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment