Check if brackets/parens are matching in a Red source and give errors with indication of line number

check-structure.red

Red [
	Title: 		"Red program structure checker"
	Purpose:	{Check if brackets/parens are matching in a Red file
				 and give errors with indication of line number}
	Author:		"Rudolf W. MEIJER"
	File:		%check-structure.red
	History:	[
					[0.0 04-Jan-2019 {Start of project}]
					[0.5 05-Jan-2019 {First working version}]
					[0.6 01-Feb-2019 {Added %" "}]
				]
	Notes:		{

The lexical structure of Red programs contains various delimiters that occur in pairs:
( ), [ ], #( ), #[ ], " ", #" ", %" ", { }, #{ } and < >.
Of these, the first four pairs may each enclose arbitrarily many characters
conforming to the Red lexical structure, that are to be interpreted as
(sequences of) Red values; thus they may themselves be nested to any depth.
The remaining six pairs enclose string-like constructs, and are limited as to
the characters they may contain, but since these may include (individual)
delimiters, and insome cases newlines, they have to be analyzed to the extent necessary.
In addition, the presence of end-of line comments has to be taken into account.

The following table gives the details.

( ), [ ], #( ), #[ ]
	no limitations, may contain newlines
" "
	no newline, unmatched quote must be escaped with ^, otherwise arbitrary content
#" "
	no newline, unmatched quote must be escaped with ^, content severely restricted,
	but since this is hardly more than a handful of characters on one line,
	a visual check is sufficient and therefore a programmatic check is unnecessary
%" "
	no newline, content severely restricted in an OS dependent way,
	but since this is hardly more than a handful of characters on one line,
	a visual check is sufficient and therefore a programmatic check is unnecessary
{ }
	newline allowed, { } must be properly paired, thus single { and } must be
	escaped with ^, otherwise arbitrary content
#{ }
	newline allowed, none of the other delimiters are allowed
< >
	newline allowed, not starting with whitespace, <, = or >, otherwise
	arbitrary content

	} ; end Notes

	Language:	'English
	Tabs:		4
] ; end prologue

;---|----1----|----2----|----3----|----4----|----5----|----6----|----7----|-


context [

	opening-char?: func [
		c [char!]
	][
		find "^"{[(" c
	]

	quoting?: func [
		s [string!]
	][
		any [s = "^"" s = "#^"" s = "%^"" s = "{" s = "<"]
	]

	short-quoting?: func [
		s [string!]
	][
		any [s = "^"" s = "#^"" s = "%^""]
	]

	stack: make block! 20
	line: 0

	report-error: func [
		mess [string! block!]
	][
		if block? mess [mess: rejoin mess]
		either line = 0
		[
			print mess
		][
			print [mess "at line" line]
		]
	]

	push: func [
		str [string!]
	][
;		print ["push" str line]
		insert stack reduce [str line]
	]

	pop: does [
;		print ["pop" first stack  second stack]
		remove/part stack 2
	]

	set 'check-brackets func [
		file [file!]
		/local text ptr ch token
	][

		line: 0

		unless all [
			text: attempt [read file]
			not empty? text
		][
			report-error "file not found or empty - nothing to check"
			exit
		]

		line: 1
		ptr: text

		while [not tail? ptr][
			ch: ptr/1
			switch/default ch [
				#"^/" [
					either all [
						not empty? stack
						short-quoting? first stack
					][
						report-error "unclosed ^""
						break
					][
						line: line + 1
						ptr: next ptr
					]
				]
				#";" [
					either all [
						not empty? stack
						quoting? first stack
					][
						ptr: next ptr
					][
						ptr: any [
							find ptr #"^/"
							tail ptr
						]
					]
				]
				#"^^" [
					either all [
						not empty? stack
						quoting? first stack
					][
						either tail? next ptr
						[
							ptr: next ptr
						][
							ptr: next next ptr
						]
					][
						report-error "found lone ^^ - skipping"
						ptr: next ptr
					]
				]
				#"#" [
					ptr: next ptr
					either all [
						not empty? stack
						quoting? first stack
					][
						; do nothing
					][
						unless tail? next ptr [
							if opening-char? ptr/1 [
								token: append copy "#" ptr/1
								either all [
									not empty? stack
									"#{" = first stack
								][
									report-error ["out of place " token]
									break
								][
									push token
									ptr: next ptr
								]
							]
						]
					]
				]
				#"%" [
					ptr: next ptr
					either all [
						not empty? stack
						quoting? first stack
					][
						; do nothing
					][
						unless tail? next ptr [
							if #"^"" = ptr/1 [
								token: "%^""
								either all [
									not empty? stack
									"#{" = first stack
								][
									report-error ["out of place " token]
									break
								][
									push token
									ptr: next ptr
								]
							]
						]
					]
				]
				#"^"" [
					either empty? stack
					[
						push to-string ch
					][
						case [
							short-quoting? first stack [
								pop
							]
							"{" = first stack [
								; do nothing
							]
							"#{" = first stack [
								report-error ["out of place " ch]
							]
							true [
								push to-string ch
							]
						]
					]
					ptr: next ptr
				]
				#"{" [
					either empty? stack
					[
						push to-string ch
					][
						case [
							short-quoting? first stack [
								; do nothing
							]
							"#{" = first stack [
								report-error ["out of place " ch]
								break
							]
							true [
								push to-string ch
							]
						]
					]
					ptr: next ptr
				]
				#"}" [
					either empty? stack
					[
						report-error ["unmatched " ch]
					][
						case [
							short-quoting? first stack [
								; do nothing
							]
							any [
								"{"  = first stack
								"#{" = first stack
							][
								pop
							]
						][
							report-error ["unmatched " ch]
						]
					]
					ptr: next ptr
				]
				#"<" [
					ptr: next ptr
					either all [
						not empty? stack
						quoting? first stack
					][
						; do nothing
					][
						unless any [
							tail? next ptr
							find " <=>" ptr/1
						][
							push to-string ch
						]
					]
				]
				#">" [
					if all [
						not empty? stack
						"<" = first stack
					][
						pop
					]
					ptr: next ptr
				]
				#"[" #"(" [
					either empty? stack
					[
						push to-string ch
					][
						case [
							quoting? first stack [
								; do nothing
							]
							"#{" = first stack [
								report-error ["out of place " ch]
								break
							]
							true [
								push to-string ch
							]
						]
					]
					ptr: next ptr
				]
				#"]" [
					either empty? stack
					[
						report-error ["unmatched " ch]
						break
					][
						case [
							quoting? first stack [
								; do nothing
							]
							"#{" = first stack [
								report-error ["out of place " ch]
								break
							]
							any ["[" = first stack "#[" = first stack][
								pop
							]
							true [
								report-error ["out of place " ch]
								break
							]
						]
					]
					ptr: next ptr
				]
				#")" [
					either empty? stack
					[
						report-error ["unmatched " ch]
						break
					][
						case [
							quoting? first stack [
								; do nothing
							]
							"#{" = first stack [
								report-error ["out of place " ch]
								break
							]
							any ["(" = first stack "#(" = first stack][
								pop
							]
							true [
								report-error ["out of place " ch]
								break
							]
						]
					]
					ptr: next ptr
				]
			][
				ptr: next ptr
			] ; end switch
		] ; while

		line: 0
		unless empty? stack [
			report-error ["opening " first stack " at line " second stack " not closed"]
		]
		print ["file" mold file "treated"]
	]
] ; end context