<commit_before>REBOL [
	Title:   "Red/System compiler"
	Author:  "<NAME>"
	File: 	 %compiler.r
	Rights:  "Copyright (C) 2011 <NAME>. All rights reserved."
	License: "BSD-3 - https://github.com/dockimbel/Red/blob/master/BSD-3-License.txt"
]

do %utils/r2-forward.r
do %utils/int-to-bin.r
do %utils/IEEE-754.r
do %utils/virtual-struct.r
do %utils/secure-clean-path.r
do %linker.r
do %emitter.r

system-dialect: context [
	verbose:  	  0										;-- logs verbosity level
	job: 		  none									;-- reference the current job object	
	runtime-path: %runtime/
	nl: 		  newline
	
	loader: do bind load %loader.r 'self
	
	compiler: context [
		job:		 none								;-- shortcut for job object
		pc:			 none								;-- source code input cursor
		script:		 none								;-- source script file name
		none-type:	 [#[none]]							;-- marker for "no value returned"
		last-type:	 none-type							;-- type of last value from an expression
		locals: 	 none								;-- currently compiled function specification block
		locals-init: []									;-- currently compiler function locals variable init list
		func-name:	 none								;-- currently compiled function name
		block-level: 0									;-- nesting level of input source block
		verbose:  	 0									;-- logs verbosity level
	
		imports: 	   make block! 10					;-- list of imported functions
		natives:	   make hash!  40					;-- list of functions to compile [name [specs] [body]...]
		globals:  	   make hash!  40					;-- list of globally defined symbols from scripts
		aliased-types: make hash!  10					;-- list of aliased type definitions
		
		resolve-alias?: yes								;-- YES: instruct the type resolution function to reduce aliases
		
		debug-lines: reduce [							;-- runtime source line/file information storage
			'records make block!  1000					;-- [address line file] records
			'files	 make hash!   20					;-- filenames table
		]
		
		pos:		none								;-- validation rules cursor for error reporting
		return-def: to-set-word 'return					;-- return: keyword
		fail:		[end skip]							;-- fail rule
		rule: value: none								;-- global parsing rules helpers
		
		not-set!:	  [logic! integer!]					;-- reserved for internal use only
		number!: 	  [byte! integer!]					;-- reserved for internal use only
		any-float!:	  [float! float32! float64!]		;-- reserved for internal use only
		any-number!:  union number! any-float!			;-- reserved for internal use only
		pointers!:	  [pointer! struct! c-string!] 		;-- reserved for internal use only
		any-pointer!: union pointers! [function!]		;-- reserved for internal use only
		poly!:		  union any-number! pointers!		;-- reserved for internal use only
		any-type!:	  union poly! [logic!]			  	;-- reserved for internal use only
		type-sets:	  [									;-- reserved for internal use only
			not-set! number! poly! any-type! any-pointer!
			any-number!
		]
		
		comparison-op: [= <> < > <= >=]
		
		functions: to-hash [
		;--Name--Arity--Type----Cc--Specs--		   Cc = Calling convention
			+		[2	op		- [a [poly!]   b [poly!]   return: [poly!]]]
			-		[2	op		- [a [poly!]   b [poly!]   return: [poly!]]]
			*		[2	op		- [a [any-number!] b [any-number!] return: [any-number!]]]
			/		[2	op		- [a [any-number!] b [any-number!] return: [any-number!]]]
			and		[2	op		- [a [number!] b [number!] return: [number!]]]
			or		[2	op		- [a [number!] b [number!] return: [number!]]]
			xor		[2	op		- [a [number!] b [number!] return: [number!]]]
			//		[2	op		- [a [number!] b [number!] return: [number!]]]		;-- modulo
			///		[2	op		- [a [number!] b [number!] return: [number!]]]		;-- remainder (real syntax: %)
			>>		[2	op		- [a [number!] b [number!] return: [number!]]]		;-- shift left signed
			<<		[2	op		- [a [number!] b [number!] return: [number!]]]		;-- shift right signed
			-**		[2	op		- [a [number!] b [number!] return: [number!]]]		;-- shift right unsigned
			=		[2	op		- [a [any-type!] b [any-type!]  return: [logic!]]]
			<>		[2	op		- [a [any-type!] b [any-type!]  return: [logic!]]]
			>		[2	op		- [a [poly!]   b [poly!]   return: [logic!]]]
			<		[2	op		- [a [poly!]   b [poly!]   return: [logic!]]]
			>=		[2	op		- [a [poly!]   b [poly!]   return: [logic!]]]
			<=		[2	op		- [a [poly!]   b [poly!]   return: [logic!]]]
			not		[1	inline	- [a [not-set!] 		   return: [logic!]]]	;@@ return should be not-set!
			push	[1	inline	- [a [any-type!]]]
			pop		[0	inline	- [						   return: [integer!]]]
		]
		
		user-functions: tail functions					;-- marker for user functions
		
		action-class: context [action: type: data: none]
		
		struct-syntax: [
			pos: opt [into ['align integer! opt ['big | 'little]]]	;-- struct's attributes
			pos: some [word! into type-spec]						;-- struct's members
		]
		
		pointer-syntax: ['integer! | 'byte! | 'float32! | 'float64! | 'float!]
		
		func-pointer: ['function! set value block! (check-specs '- value)]
		
		type-syntax: [
			'logic! | 'int32! | 'integer! | 'uint8! | 'byte! | 'int16!
			| 'float! | 'float32! | 'float64!
			| 'c-string!
			| 'pointer! into [pointer-syntax]
			| 'struct!  into [struct-syntax]
		]

		type-spec: [
			pos: some type-syntax | set value word! (			;-- multiple types allowed for internal usage			
				unless find aliased-types value [throw false]	;-- stop parsing if unresolved type
			)
		]		
		
		keywords: [
			;&			 [throw-error "reserved for future use"]
			as			 [comp-as]
			assert		 [comp-assert]
			size? 		 [comp-size?]
			if			 [comp-if]
			either		 [comp-either]
			case		 [comp-case]
			switch		 [comp-switch]
			until		 [comp-until]
			while		 [comp-while]
			any			 [comp-expression-list]
			all			 [comp-expression-list/_all]
			exit		 [comp-exit]
			return		 [comp-exit/value]
			declare		 [comp-declare]
			null		 [comp-null]
			
			true		 [also true pc: next pc]		  ;-- converts word! to logic!
			false		 [also false pc: next pc]		  ;-- converts word! to logic!
			
			func 		 [raise-level-error "a function"] ;-- func declaration not allowed at this level
			function 	 [raise-level-error "a function"] ;-- func declaration not allowed at this level
			alias 		 [raise-level-error "an alias"]	  ;-- alias declaration not allowed at this level
		]
		
		calc-line: has [idx head-end prev p header][
			header: head pc
			idx: (index? pc) - header/1  				;-- calculate real pc position (not counting hidden header)
			prev: 1

			parse header [								;-- search for closest line marker
				skip									;-- skip over header length
				some [
					set p pair! (
						if p/2 = idx [return p/1]		;-- exact value position match
						if p/2 > idx [return prev]		;-- closest value position match 
						prev: p/1
					)
				]
			]
			return p/1									;-- return last marker
		]
		
		store-dbg-lines: has [dbg pos][
			dbg: debug-lines
			unless pos: find dbg/files script [
				pos: tail dbg/files
				append dbg/files script
			]
			repend dbg/records [
				emitter/tail-ptr calc-line index? pos
			]
		]
		
		quit-on-error: does [
			clean-up
			if system/options/args [quit/return 1]
			halt
		]
		
		throw-error: func [err [word! string! block!]][
			print [
				"*** Compilation Error:"
				either word? err [
					join uppercase/part mold err 1 " error"
				][reform err]
				"^/*** in file:" mold script
				either locals [join "^/*** in function: " func-name][""]
			]
			if pc [
				print [
					"*** at line:" calc-line lf
					"*** near:" mold copy/part pc 8
				]
			]
			quit-on-error
		]
		
		throw-warning: func [msg [string! block!] /near][
			print [
				"*** Warning:" 	reform msg
				"^/*** in:" 	mold script
				"^/*** at:" 	mold copy/part any [all [near back pc] pc] 8
			]
		]
		
		raise-level-error: func [kind [string!]][
			pc: back pc
			throw-error reform ["declaring" kind "at this level is not allowed"]
		]
		
		raise-casting-error: does [
			backtrack 'as
			throw-error "multiple type casting not allowed"
		]
		
		raise-paren-error: does [
			pc: back pc
			throw-error "parens are only allowed nested in an expression"
		]
		
		raise-runtime-error: func [error [integer!]][
			emitter/target/emit-get-pc				;-- get current CPU program counter address
			last-type: [integer!]					;-- emit-get-pc returns an integer! (required for next line)
			compiler/comp-call '***-on-quit reduce [error <last>] ;-- raise a runtime error
		]
		
		backtrack: func [value /local res][
			pc: any [res: find/only/reverse pc value pc]
			to logic! res
		]
		
		blockify: func [value][either block? value [value][reduce [value]]]

		literal?: func [value][
			not any [word? value path? value block? value value = <last>]
		]
		
		not-initialized?: func [name [word!] /local pos][
			all [
				locals
				pos: find locals /local
				pos: find next pos name
				not find locals-init name
			]
		]
		
		get-alias-id: func [pos [hash!]][
			1000 + divide 1 + index? pos 2
		]
		
		get-type-id: func [value /local type alias][
			with-alias-resolution off [type: resolve-expr-type value]
			
			either alias: find aliased-types type/1 [
				get-alias-id alias
			][
				type: resolve-aliased type
				type: either type/1 = 'pointer! [
					pick [int-ptr! byte-ptr!] type/2/1 = 'integer!
				][
					type/1
				]
				select emitter/datatype-ID type
			]
		]
		
		system-reflexion?: func [path [path!] /local def][	
			if path/1 = 'system [
				switch path/2 [
					alias [
						unless path/3 [
							backtrack path
							throw-error "invalid system/alias path access"
						]
						unless def: find aliased-types path/3 [
							backtrack path
							throw-error ["undefined alias name:" path/3]
						]
						last-type: [integer!]
						return get-alias-id def			;-- special encoding for aliases
					]
					; add new special reflective system path here
				]
			]
			none
		]
		
		base-type?: func [value][
			if block? value [value: value/1]
			to logic! find/skip emitter/datatypes value 3
		]
		
		unbox: func [value][
			either object? value [value/data][value]
		]
		
		get-return-type: func [name [word!] /local type][
			type: select functions/:name/4 return-def
			unless type [
				backtrack name
				throw-error ["return type missing in function:" name]
			]
			any [type none-type]
		]
		
		set-last-type: func [spec [block!]][
			if spec: select spec return-def [last-type: spec]
		]
		
		exists-variable?: func [name [word! set-word!]][
			name: to word! name
			to logic! any [
				all [locals find locals name]
				find globals name
			]
		]
		
		get-variable-spec: func [name [word!]][
			any [
				all [locals select locals name]
				select globals name
			]
		]
		
		get-arity: func [spec [block!] /local count][
			count: 0
			parse spec [opt block! any [word! block! (count: count + 1)]]
			count
		]
		
		any-float?: func [type [block!]][
			find any-float! type/1
		]
		
		any-pointer?: func [type [block!]][
			type: first resolve-aliased type
			
			either find type-sets type [
				not empty? intersect get type any-pointer!
			][
				to logic! find any-pointer! type
			]
		]

		equal-types?: func [type1 [word!] type2 [word!]][
			type1: either find type-sets type1 [get type1][reduce [type1]]
			type2: either find type-sets type2 [get type2][reduce [type2]]
			not empty? intersect type1 type2
		]
		
		equal-types-list?: func [types [block!]][
			forall types [							;-- check if all last expressions are of same type
				unless types/1/1 [return none-type]	;-- test if type is defined
				types/1: resolve-aliased types/1	;-- reduce aliases and pseudo-types
				if all [
					not head? types
					not equal-types? types/-1/1 types/1/1
				][
					return none-type
				]
			]
			first head types						;-- all types equal, return the first one
		]
						
		with-alias-resolution: func [mode [logic!] body [block!] /local saved][
			saved: resolve-alias?
			resolve-alias?: mode	
			do body
			resolve-alias?: saved
		]
		
		resolve-aliased: func [type [block!] /local name][
			name: type/1
			all [
				not base-type? name
				not find type-sets name
				not type: select aliased-types name
				throw-error ["unknown type:" type]
			]
			type
		]
		
		resolve-type: func [name [word!] /with parent [block! none!] /local type][
			type: any [
				all [parent select parent name]
				get-variable-spec name
			]
			if all [not type find functions name][
				return reduce ['function! functions/:name/4]
			]
			unless any [not resolve-alias? base-type? type/1][
				type: select aliased-types type/1
			]
			type
		]
		
		resolve-struct-member-type: func [spec [block!] name [word!] /local type][
			unless type: select spec name [
				pc: skip pc -2
				throw-error [
					"invalid struct member" name "in:" mold to path! pc/1
				]
			]<commit_msg>FIX: minor fix in aliased type resolution.<commit_after>REBOL [
	Title:   "Red/System compiler"
	Author:  "<NAME>"
	File: 	 %compiler.r
	Rights:  "Copyright (C) 2011 <NAME>. All rights reserved."
	License: "BSD-3 - https://github.com/dockimbel/Red/blob/master/BSD-3-License.txt"
]

do %utils/r2-forward.r
do %utils/int-to-bin.r
do %utils/IEEE-754.r
do %utils/virtual-struct.r
do %utils/secure-clean-path.r
do %linker.r
do %emitter.r

system-dialect: context [
	verbose:  	  0										;-- logs verbosity level
	job: 		  none									;-- reference the current job object	
	runtime-path: %runtime/
	nl: 		  newline
	
	loader: do bind load %loader.r 'self
	
	compiler: context [
		job:		 none								;-- shortcut for job object
		pc:			 none								;-- source code input cursor
		script:		 none								;-- source script file name
		none-type:	 [#[none]]							;-- marker for "no value returned"
		last-type:	 none-type							;-- type of last value from an expression
		locals: 	 none								;-- currently compiled function specification block
		locals-init: []									;-- currently compiler function locals variable init list
		func-name:	 none								;-- currently compiled function name
		block-level: 0									;-- nesting level of input source block
		verbose:  	 0									;-- logs verbosity level
	
		imports: 	   make block! 10					;-- list of imported functions
		natives:	   make hash!  40					;-- list of functions to compile [name [specs] [body]...]
		globals:  	   make hash!  40					;-- list of globally defined symbols from scripts
		aliased-types: make hash!  10					;-- list of aliased type definitions
		
		resolve-alias?: yes								;-- YES: instruct the type resolution function to reduce aliases
		
		debug-lines: reduce [							;-- runtime source line/file information storage
			'records make block!  1000					;-- [address line file] records
			'files	 make hash!   20					;-- filenames table
		]
		
		pos:		none								;-- validation rules cursor for error reporting
		return-def: to-set-word 'return					;-- return: keyword
		fail:		[end skip]							;-- fail rule
		rule: value: none								;-- global parsing rules helpers
		
		not-set!:	  [logic! integer!]					;-- reserved for internal use only
		number!: 	  [byte! integer!]					;-- reserved for internal use only
		any-float!:	  [float! float32! float64!]		;-- reserved for internal use only
		any-number!:  union number! any-float!			;-- reserved for internal use only
		pointers!:	  [pointer! struct! c-string!] 		;-- reserved for internal use only
		any-pointer!: union pointers! [function!]		;-- reserved for internal use only
		poly!:		  union any-number! pointers!		;-- reserved for internal use only
		any-type!:	  union poly! [logic!]			  	;-- reserved for internal use only
		type-sets:	  [									;-- reserved for internal use only
			not-set! number! poly! any-type! any-pointer!
			any-number!
		]
		
		comparison-op: [= <> < > <= >=]
		
		functions: to-hash [
		;--Name--Arity--Type----Cc--Specs--		   Cc = Calling convention
			+		[2	op		- [a [poly!]   b [poly!]   return: [poly!]]]
			-		[2	op		- [a [poly!]   b [poly!]   return: [poly!]]]
			*		[2	op		- [a [any-number!] b [any-number!] return: [any-number!]]]
			/		[2	op		- [a [any-number!] b [any-number!] return: [any-number!]]]
			and		[2	op		- [a [number!] b [number!] return: [number!]]]
			or		[2	op		- [a [number!] b [number!] return: [number!]]]
			xor		[2	op		- [a [number!] b [number!] return: [number!]]]
			//		[2	op		- [a [number!] b [number!] return: [number!]]]		;-- modulo
			///		[2	op		- [a [number!] b [number!] return: [number!]]]		;-- remainder (real syntax: %)
			>>		[2	op		- [a [number!] b [number!] return: [number!]]]		;-- shift left signed
			<<		[2	op		- [a [number!] b [number!] return: [number!]]]		;-- shift right signed
			-**		[2	op		- [a [number!] b [number!] return: [number!]]]		;-- shift right unsigned
			=		[2	op		- [a [any-type!] b [any-type!]  return: [logic!]]]
			<>		[2	op		- [a [any-type!] b [any-type!]  return: [logic!]]]
			>		[2	op		- [a [poly!]   b [poly!]   return: [logic!]]]
			<		[2	op		- [a [poly!]   b [poly!]   return: [logic!]]]
			>=		[2	op		- [a [poly!]   b [poly!]   return: [logic!]]]
			<=		[2	op		- [a [poly!]   b [poly!]   return: [logic!]]]
			not		[1	inline	- [a [not-set!] 		   return: [logic!]]]	;@@ return should be not-set!
			push	[1	inline	- [a [any-type!]]]
			pop		[0	inline	- [						   return: [integer!]]]
		]
		
		user-functions: tail functions					;-- marker for user functions
		
		action-class: context [action: type: data: none]
		
		struct-syntax: [
			pos: opt [into ['align integer! opt ['big | 'little]]]	;-- struct's attributes
			pos: some [word! into type-spec]						;-- struct's members
		]
		
		pointer-syntax: ['integer! | 'byte! | 'float32! | 'float64! | 'float!]
		
		func-pointer: ['function! set value block! (check-specs '- value)]
		
		type-syntax: [
			'logic! | 'int32! | 'integer! | 'uint8! | 'byte! | 'int16!
			| 'float! | 'float32! | 'float64!
			| 'c-string!
			| 'pointer! into [pointer-syntax]
			| 'struct!  into [struct-syntax]
		]

		type-spec: [
			pos: some type-syntax | set value word! (			;-- multiple types allowed for internal usage			
				unless find aliased-types value [throw false]	;-- stop parsing if unresolved type
			)
		]		
		
		keywords: [
			;&			 [throw-error "reserved for future use"]
			as			 [comp-as]
			assert		 [comp-assert]
			size? 		 [comp-size?]
			if			 [comp-if]
			either		 [comp-either]
			case		 [comp-case]
			switch		 [comp-switch]
			until		 [comp-until]
			while		 [comp-while]
			any			 [comp-expression-list]
			all			 [comp-expression-list/_all]
			exit		 [comp-exit]
			return		 [comp-exit/value]
			declare		 [comp-declare]
			null		 [comp-null]
			
			true		 [also true pc: next pc]		  ;-- converts word! to logic!
			false		 [also false pc: next pc]		  ;-- converts word! to logic!
			
			func 		 [raise-level-error "a function"] ;-- func declaration not allowed at this level
			function 	 [raise-level-error "a function"] ;-- func declaration not allowed at this level
			alias 		 [raise-level-error "an alias"]	  ;-- alias declaration not allowed at this level
		]
		
		calc-line: has [idx head-end prev p header][
			header: head pc
			idx: (index? pc) - header/1  				;-- calculate real pc position (not counting hidden header)
			prev: 1

			parse header [								;-- search for closest line marker
				skip									;-- skip over header length
				some [
					set p pair! (
						if p/2 = idx [return p/1]		;-- exact value position match
						if p/2 > idx [return prev]		;-- closest value position match 
						prev: p/1
					)
				]
			]
			return p/1									;-- return last marker
		]
		
		store-dbg-lines: has [dbg pos][
			dbg: debug-lines
			unless pos: find dbg/files script [
				pos: tail dbg/files
				append dbg/files script
			]
			repend dbg/records [
				emitter/tail-ptr calc-line index? pos
			]
		]
		
		quit-on-error: does [
			clean-up
			if system/options/args [quit/return 1]
			halt
		]
		
		throw-error: func [err [word! string! block!]][
			print [
				"*** Compilation Error:"
				either word? err [
					join uppercase/part mold err 1 " error"
				][reform err]
				"^/*** in file:" mold script
				either locals [join "^/*** in function: " func-name][""]
			]
			if pc [
				print [
					"*** at line:" calc-line lf
					"*** near:" mold copy/part pc 8
				]
			]
			quit-on-error
		]
		
		throw-warning: func [msg [string! block!] /near][
			print [
				"*** Warning:" 	reform msg
				"^/*** in:" 	mold script
				"^/*** at:" 	mold copy/part any [all [near back pc] pc] 8
			]
		]
		
		raise-level-error: func [kind [string!]][
			pc: back pc
			throw-error reform ["declaring" kind "at this level is not allowed"]
		]
		
		raise-casting-error: does [
			backtrack 'as
			throw-error "multiple type casting not allowed"
		]
		
		raise-paren-error: does [
			pc: back pc
			throw-error "parens are only allowed nested in an expression"
		]
		
		raise-runtime-error: func [error [integer!]][
			emitter/target/emit-get-pc				;-- get current CPU program counter address
			last-type: [integer!]					;-- emit-get-pc returns an integer! (required for next line)
			compiler/comp-call '***-on-quit reduce [error <last>] ;-- raise a runtime error
		]
		
		backtrack: func [value /local res][
			pc: any [res: find/only/reverse pc value pc]
			to logic! res
		]
		
		blockify: func [value][either block? value [value][reduce [value]]]

		literal?: func [value][
			not any [word? value path? value block? value value = <last>]
		]
		
		not-initialized?: func [name [word!] /local pos][
			all [
				locals
				pos: find locals /local
				pos: find next pos name
				not find locals-init name
			]
		]
		
		get-alias-id: func [pos [hash!]][
			1000 + divide 1 + index? pos 2
		]
		
		get-type-id: func [value /local type alias][
			with-alias-resolution off [type: resolve-expr-type value]
			
			either alias: find aliased-types type/1 [
				get-alias-id alias
			][
				type: resolve-aliased type
				type: either type/1 = 'pointer! [
					pick [int-ptr! byte-ptr!] type/2/1 = 'integer!
				][
					type/1
				]
				select emitter/datatype-ID type
			]
		]
		
		system-reflexion?: func [path [path!] /local def][	
			if path/1 = 'system [
				switch path/2 [
					alias [
						unless path/3 [
							backtrack path
							throw-error "invalid system/alias path access"
						]
						unless def: find aliased-types path/3 [
							backtrack path
							throw-error ["undefined alias name:" path/3]
						]
						last-type: [integer!]
						return get-alias-id def			;-- special encoding for aliases
					]
					; add new special reflective system path here
				]
			]
			none
		]
		
		base-type?: func [value][
			if block? value [value: value/1]
			to logic! find/skip emitter/datatypes value 3
		]
		
		unbox: func [value][
			either object? value [value/data][value]
		]
		
		get-return-type: func [name [word!] /local type][
			type: select functions/:name/4 return-def
			unless type [
				backtrack name
				throw-error ["return type missing in function:" name]
			]
			any [type none-type]
		]
		
		set-last-type: func [spec [block!]][
			if spec: select spec return-def [last-type: spec]
		]
		
		exists-variable?: func [name [word! set-word!]][
			name: to word! name
			to logic! any [
				all [locals find locals name]
				find globals name
			]
		]
		
		get-variable-spec: func [name [word!]][
			any [
				all [locals select locals name]
				select globals name
			]
		]
		
		get-arity: func [spec [block!] /local count][
			count: 0
			parse spec [opt block! any [word! block! (count: count + 1)]]
			count
		]
		
		any-float?: func [type [block!]][
			find any-float! type/1
		]
		
		any-pointer?: func [type [block!]][
			type: first resolve-aliased type
			
			either find type-sets type [
				not empty? intersect get type any-pointer!
			][
				to logic! find any-pointer! type
			]
		]

		equal-types?: func [type1 [word!] type2 [word!]][
			type1: either find type-sets type1 [get type1][reduce [type1]]
			type2: either find type-sets type2 [get type2][reduce [type2]]
			not empty? intersect type1 type2
		]
		
		equal-types-list?: func [types [block!]][
			forall types [							;-- check if all last expressions are of same type
				unless types/1/1 [return none-type]	;-- test if type is defined
				types/1: resolve-aliased types/1	;-- reduce aliases and pseudo-types
				if all [
					not head? types
					not equal-types? types/-1/1 types/1/1
				][
					return none-type
				]
			]
			first head types						;-- all types equal, return the first one
		]
						
		with-alias-resolution: func [mode [logic!] body [block!] /local saved][
			saved: resolve-alias?
			resolve-alias?: mode	
			do body
			resolve-alias?: saved
		]
		
		resolve-aliased: func [type [block!] /local name][
			name: type/1
			all [
				type/1								;-- ensure it is not #[none]
				not base-type? name
				not find type-sets name
				not type: select aliased-types name
				throw-error ["unknown type:" type]
			]
			type
		]
		
		resolve-type: func [name [word!] /with parent [block! none!] /local type][
			type: any [
				all [parent select parent name]
				get-variable-spec name
			]
			if all [not type find functions name][
				return reduce ['function! functions/:name/4]
			]
			unless any [not resolve-alias? base-type? type/1][
				type: select aliased-types type/1
			]
			type
		]
		
		resolve-struct-member-type: func [spec [block!] name [word!] /local type][
			unless type: select spec name [
				pc: skip pc -2
				throw-error [
					"invalid struct member" name "in:" mold to path! pc/1
				]
			]
{'fraction_non_alphanumeric': 0.14024583663758922, 'fraction_numerical': 0.009873116574147502, 'mean_word_length': 2.343629855495161, 'pattern_counts': {'":': 0, '<': 27, '<?xml version=': 0, '>': 29, 'https://': 2, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3671451', 'n_tokens_mistral': 11061, 'n_tokens_neox': 8719, 'n_words': 2768}