/red-system/rsc.r

  1REBOL [
  2	Title:   "Red/System compiler wrapper"
  3	Author:  "Nenad Rakocevic, Andreas Bolka"
  4	File: 	 %rsc.r
  5	Rights:  "Copyright (C) 2011 Nenad Rakocevic, Andreas Bolka. All rights reserved."
  6	License: "BSD-3 - https://github.com/dockimbel/Red/blob/master/BSD-3-License.txt"
  7	Usage:   {
  8		do/args %rsc.r "[-v <integer!>] path/source.reds"
  9	}
 10]
 11
 12unless value? 'system-dialect [
 13	do %compiler.r
 14]
 15
 16rsc: context [
 17	fail: func [value] [
 18		print value
 19		if system/options/args [quit/return 1]
 20		halt
 21	]
 22
 23	fail-try: func [component body /local err] [
 24		if error? set/any 'err try body [
 25			err: disarm err
 26			foreach w [arg1 arg2 arg3][
 27				set w either unset? get/any in err w [none][
 28					get/any in err w
 29				]
 30			]
 31			fail [
 32				"***" component "Internal Error:"
 33				system/error/(err/type)/type #":"
 34				reduce system/error/(err/type)/(err/id) newline
 35				"*** Where:" mold/flat err/where newline
 36				"*** Near: " mold/flat err/near newline
 37			]
 38		]
 39	]
 40
 41	load-filename: func [filename /local result] [
 42		unless any [
 43			all [
 44				#"%" = first filename
 45				attempt [result: load filename]
 46				file? result
 47			]
 48			attempt [result: to-rebol-file filename]
 49		] [
 50			fail ["Invalid filename:" filename]
 51		]
 52		result
 53	]
 54
 55	load-targets: func [/local targets] [
 56		targets: load %config.r
 57		if exists? %custom-targets.r [
 58			insert targets load %custom-targets.r
 59		]
 60		targets
 61	]
 62
 63	parse-options: has [
 64		args srcs opts output target verbose filename config config-name
 65	] [
 66		args: any [system/options/args parse any [system/script/args ""] none]
 67
 68		;; Select a default target based on the REBOL version.
 69		target: any [
 70			select [
 71				2 "Darwin"
 72				3 "MSDOS"
 73				4 "Linux"
 74			] system/version/4
 75			"MSDOS"
 76		]
 77
 78		srcs: copy []
 79		opts: make system-dialect/options-class [link?: yes]
 80
 81		parse args [
 82			any [
 83				  ["-r" | "--no-runtime"]   (opts/runtime?: no)
 84				| ["-g" | "--debug-stabs"]  (opts/debug?: yes)
 85				| ["-l" | "--literal-pool"] (opts/literal-pool?: yes)
 86				| ["-o" | "--output"]  		set output skip
 87				| ["-t" | "--target"]  		set target skip
 88				| ["-v" | "--verbose"] 		set verbose skip
 89				| set filename skip (append srcs load-filename filename)
 90			]
 91		]
 92
 93		;; Process -t/--target first, so that all other command-line options
 94		;; can potentially override the target config settings.
 95		unless config: select load-targets config-name: to word! trim target [
 96			fail ["Unknown target:" target]
 97		]
 98		opts: make opts config
 99		opts/config-name: config-name
100
101		;; Process -o/--output (if any).
102		if output [
103			opts/build-prefix: %""
104			opts/build-basename: load-filename output
105		]
106
107		;; Process -v/--verbose (if any).
108		if verbose [
109			unless attempt [opts/verbosity: to integer! trim verbose] [
110				fail ["Invalid verbosity:" verbose]
111			]
112		]
113
114		;; Process input sources.
115		if empty? srcs [fail "No source files specified."]
116		foreach src srcs [
117			unless exists? src [
118				fail ["Cannot access source file:" src]
119			]
120		]
121
122		reduce [srcs opts]
123	]
124
125	main: has [srcs opts build-dir result] [
126		set [srcs opts] parse-options
127
128		;; If we use a build directory, ensure it exists.
129		if all [opts/build-prefix find opts/build-prefix %/] [
130			build-dir: copy/part opts/build-prefix find/last opts/build-prefix %/
131			unless attempt [make-dir/deep build-dir] [
132				fail ["Cannot access build dir:" build-dir]
133			]
134		]
135
136		print [
137			newline
138			"-= Red/System Compiler =-" newline
139			"Compiling" srcs "..."
140		]
141
142		fail-try "Compiler" [
143			result: system-dialect/compile/options srcs opts
144		]
145
146		print ["^/...compilation time:" tab round result/1/second * 1000 "ms"]
147		if result/2 [
148			print [
149				"...linking time:" tab tab round result/2/second * 1000 "ms^/"
150				"...output file size:" tab result/3 "bytes"
151			]
152		]
153	]
154
155	fail-try "Driver" [main]
156]