syncol.icl 4.46 KB
Newer Older
Diederik van Arkel's avatar
Diederik van Arkel committed
1 2
implementation module syncol

3
// provides preparsing for Clean syntax colouring.
Diederik van Arkel's avatar
Diederik van Arkel committed
4 5 6 7 8 9 10 11

import StdArray, StdClass, StdBool, StdList, StdFunc, StdString
import StrictList

/*
	parseLine: initial comment nesting level & textline -> new comment nesting level
*/

Diederik van Arkel's avatar
Diederik van Arkel committed
12
parseLine :: !.Info !.String -> Info
Diederik van Arkel's avatar
Diederik van Arkel committed
13 14 15 16 17 18 19 20 21 22 23 24
parseLine comment_level line
	= pL comment_level 0
where
	funnyChar c = isStringMember c (dec funnySize) funnyChars

	isStringMember :: !Char !Int !String -> Bool
	isStringMember x i s
		| i < 0 = False
		#! c = s.[i]
		| c == x = True
		= isStringMember x (dec i) s

25
	funnyChars	=: "~@#$%^?!+-*<>\\/|&=:."
Diederik van Arkel's avatar
Diederik van Arkel committed
26 27 28 29
	funnySize	= 20	// =: size funnyChars?

	line_size	= size line

Diederik van Arkel's avatar
Diederik van Arkel committed
30 31 32
	pL :: !Info !Int -> Info
	pL (level,typedef) i											// parse normal text
		| i >= line_size		= (level,typedef)
Diederik van Arkel's avatar
Diederik van Arkel committed
33 34 35
		#! char = line.[i]
		| char == '*'
			# i = inc i
Diederik van Arkel's avatar
Diederik van Arkel committed
36
			| i >= line_size	= (level,typedef)
Diederik van Arkel's avatar
Diederik van Arkel committed
37 38
			| line.[i] == '/'
				#! i = inc i
Diederik van Arkel's avatar
Diederik van Arkel committed
39
				| level <> 0	= pL (dec level,typedef) i			// try to fix problem below
Diederik van Arkel's avatar
Diederik van Arkel committed
40
				| i < line_size && funnyChar line.[i]
Diederik van Arkel's avatar
Diederik van Arkel committed
41 42 43
					= scanFunny (level,typedef) i					// hmmm excludes */*/ and *//*...*/
				= pL (dec level,typedef) i
			= pL (level,typedef) i
Diederik van Arkel's avatar
Diederik van Arkel committed
44 45
		| char == '/'
			#! i = inc i
Diederik van Arkel's avatar
Diederik van Arkel committed
46
			| i >= line_size	= (level,typedef)
Diederik van Arkel's avatar
Diederik van Arkel committed
47
			#! char = line.[i]
Diederik van Arkel's avatar
Diederik van Arkel committed
48 49 50 51 52 53 54 55 56 57 58 59
			| char == '/'		= (level,typedef)					// shouldn't we exclude funnyId's ??
			| char == '*'		= pL (inc level,typedef) (inc i)
			= pL (level,typedef) i
		| (char == '"') && (level == 0)
			= pS (level,typedef) (inc i)
		| (char == '\'') && (level == 0)
			= pC (level,typedef) (inc i)
		| (level == 0) && (funnyChar char)
			= scanFunny (level,typedef) i
		| i == 0 && not (WhiteSpace char)
			= pL (level,False) (inc i)
		= pL (level,typedef) (inc i)
Diederik van Arkel's avatar
Diederik van Arkel committed
60
	
Diederik van Arkel's avatar
Diederik van Arkel committed
61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82
	scanFunny (level=:0,typedef) 0
		|  (line_size == 2 && line == "::")
		|| (line_size >= 3 && line%(0,1) == "::" && not (funnyChar line.[2]))
			= pL (level,True) 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) 1
			| funnyChar c
				= scanFunny (level,False) 1
			= pL (level,False) 0
		| funnyChar c
			= scanFunny (level,typedef) 1
		= pL (level,typedef) 0
	where
		no_c`	= line_size < 2
		c`		= line.[1]
	scanFunny (level,typedef) i
		| i >= line_size		= pL (level,typedef) line_size
Diederik van Arkel's avatar
Diederik van Arkel committed
83
		#! c = line.[i]
Diederik van Arkel's avatar
Diederik van Arkel committed
84 85
		| funnyChar c			= scanFunny (level,typedef) (inc i)
		= pL (level,typedef) i
Diederik van Arkel's avatar
Diederik van Arkel committed
86

Diederik van Arkel's avatar
Diederik van Arkel committed
87 88
	pS cl i											// parse string constant
		| i >= line_size		= cl				// unterminated string constant...
Diederik van Arkel's avatar
Diederik van Arkel committed
89
		# char = line.[i]
Diederik van Arkel's avatar
Diederik van Arkel committed
90
		| char == '"'			= pL cl (inc i)
Diederik van Arkel's avatar
Diederik van Arkel committed
91
		| char == '\\'
Diederik van Arkel's avatar
Diederik van Arkel committed
92 93
			= pS cl (i + 2)
		= pS cl (inc i)
Diederik van Arkel's avatar
Diederik van Arkel committed
94

Diederik van Arkel's avatar
Diederik van Arkel committed
95 96
	pC cl i											// parse character constant
		| i >= line_size		= cl				// unterminated char constant...
Diederik van Arkel's avatar
Diederik van Arkel committed
97
		# char = line.[i]
Diederik van Arkel's avatar
Diederik van Arkel committed
98 99 100
		| char == '\''			= pL cl (inc i)
		| char == '\\'			= pC cl (i + 2)
		= pC cl (inc i)
Diederik van Arkel's avatar
Diederik van Arkel committed
101 102 103
	
//	pT i											// parse type

Diederik van Arkel's avatar
Diederik van Arkel committed
104 105 106
WhiteSpace c
:==	c == ' ' || c == '\t' || c == '\n' || c == '\r' || c == '\f';

Diederik van Arkel's avatar
Diederik van Arkel committed
107 108 109
/*
	firstParse: textlines -> zip initial comment nesting level & textlines
*/
Diederik van Arkel's avatar
Diederik van Arkel committed
110
firstParse :: !(StrictList String) -> StrictList (Info,String)
111
firstParse lines
Diederik van Arkel's avatar
Diederik van Arkel committed
112
	= slFromList (fP (0,False) lines)
113 114 115 116 117 118 119
where
	fP i SNil
		= []
	fP i (SCons h t)
		#! j = parseLine i h
		= [ (i,h) : (fP j t) ]
	
Diederik van Arkel's avatar
Diederik van Arkel committed
120 121 122 123
/*
	quickParse: (first modified line) (last modified line) textlines
	-> last changed line with different comment nesting & textlines
*/
Diederik van Arkel's avatar
Diederik van Arkel committed
124
quickParse :: !Int !Int !(StrictList (Info,String)) -> (Int,StrictList (Info,String))
Diederik van Arkel's avatar
Diederik van Arkel committed
125 126 127
quickParse fln lln text = qP 0 text id
where
	// parse before modified
Diederik van Arkel's avatar
Diederik van Arkel committed
128
	qP :: !Int !.(StrictList (Info,String)) ((StrictList (Info,String)) -> (StrictList (Info,String))) -> (Int, (StrictList (Info,String)))
Diederik van Arkel's avatar
Diederik van Arkel committed
129 130 131
	qP cln SNil c = (cln,c SNil)
	qP cln (SCons h=:(i,l) t) c
		| cln < fln = qP (inc cln) t (SC c h)
Diederik van Arkel's avatar
Diederik van Arkel committed
132
		| cln > lln = qR (0,False) cln (SCons h t) c
Diederik van Arkel's avatar
Diederik van Arkel committed
133 134 135 136 137 138 139 140 141 142 143 144 145 146
		#! k = parseLine i l
		| cln < lln
			=  qS k (inc cln) t (SC c h)
		= qR k (inc cln) t (SC c h)
		
	// parse modified section
	qS i cln SNil c = (cln,c SNil)
	qS i cln (SCons h=:(_,l) t) c
		#! k = parseLine i l
		| cln < lln
			= qS k (inc cln) t (SC c (i,l))
		= qR k (inc cln) t (SC c (i,l))
	
	// parse after modified
Diederik van Arkel's avatar
Diederik van Arkel committed
147 148 149 150 151 152
	qR _ cln SNil c = (cln, c SNil)
	qR (level,typedef) cln r=:(SCons ((level`,typedef`),l) t) c
		| level == level` && typedef == typedef`
			= (dec cln,c r)
		# k = parseLine (level,typedef) l
		= qR k (inc cln) t (SC c ((level,typedef),l))
Diederik van Arkel's avatar
Diederik van Arkel committed
153 154

SC c h = \t -> c (SCons h t)