syncol.icl 3.55 KB
Newer Older
Diederik van Arkel's avatar
Diederik van Arkel committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
implementation module syncol

/*
	syncol: provides preparsing for Clean syntax colouring.
*/

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

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

parseLine :: !.Int !.String -> Int
parseLine comment_level line
	= pL comment_level 0
where
	funnyChar c = isStringMember c (dec funnySize) funnyChars

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

Diederik van Arkel's avatar
Diederik van Arkel committed
28
	funnyChars	= "~@#$%^?!+-*<>\\/|&=:."
Diederik van Arkel's avatar
Diederik van Arkel committed
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142
	funnySize	= 20	// =: size funnyChars?

	line_size	= size line

	pL :: !Int !Int -> Int
	pL l i											// parse normal text
		| i >= line_size		= l
		#! char = line.[i]
		| char == '*'
			# i = inc i
			| i >= line_size	= l
			| line.[i] == '/'
				#! i = inc i
				| l <> 0		= pL (dec l) i		// try to fix problem below
				| i < line_size && funnyChar line.[i]
					= scanFunny l i					// hmmm excludes */*/ and *//*...*/
				= pL (dec l) i
			= pL l i
		| char == '/'
			#! i = inc i
			| i >= line_size	= l
			#! char = line.[i]
			| char == '/'		= l					// shouldn't we exclude funnyId's ??
			| char == '*'		= pL (inc l) (inc i)
			= pL l i
		| (char == '"') && (l == 0)
			= pS (inc i)
		| (char == '\'') && (l == 0)
			= pC (inc i)
		| (l == 0) && (funnyChar char)
			= scanFunny l i
		= pL l (inc i)
	
	scanFunny l i
		| i >= line_size		= pL l line_size
		#! c = line.[i]
		| funnyChar c			= scanFunny l (inc i)
		= pL l i

	pS i											// parse string constant
		| i >= line_size		= 0					// unterminated string constant...
		# char = line.[i]
		| char == '"'			= pL 0 (inc i)
		| char == '\\'
			= pS (i + 2)
		= pS (inc i)

	pC i											// parse character constant
		| i >= line_size		= 0					// unterminated char constant...
		# char = line.[i]
		| char == '\''			= pL 0 (inc i)
		| char == '\\'			= pC (i + 2)
		= pC (inc i)
	
//	pT i											// parse type

/*
	firstParse: textlines -> zip initial comment nesting level & textlines
*/
firstParse :: !(StrictList String) -> (Int, StrictList (Int,String))
firstParse lines
	= fP 0 lines
where
	fP i SNil
		= (i,SNil)
	fP i (SCons h t)
		#! j = parseLine i h
		# (k,r) = fP j t
		= (k,SCons (i,h) r)

/*
	quickParse: (first modified line) (last modified line) textlines
	-> last changed line with different comment nesting & textlines
*/
quickParse :: !Int !Int !(StrictList (Int,String)) -> (Int,StrictList (Int,String))
quickParse fln lln text = qP 0 text id
where
	// parse before modified
	qP :: !Int !.(StrictList (Int,String)) ((StrictList (Int,String)) -> (StrictList (Int,String))) -> (Int, (StrictList (Int,String)))
	qP cln SNil c = (cln,c SNil)
	qP cln (SCons h=:(i,l) t) c
		| cln < fln = qP (inc cln) t (SC c h)
		| cln > lln = qR 0 cln (SCons h t) c
		#! 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
	qR k cln SNil c = (cln, c SNil)
	qR k cln r=:(SCons (i,l) t) c
		| k == i = (dec cln,c r)
		# d = k - i
		= (cln+slLength t,c (slMap (\(i,l) -> (i+d,l)) r))

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

//--
/*
	Extension to datatype definities simple...
	Need to replace Int by alg datatype
	int now indicates comment nesting level...
	need to differentiate is/isn't dtd
	Normal Int | DTD Int
	then check in column 0 if it says '::'...
*/