World: r3wp

(in slim)

cause its impractical

Maxim, do you have a user in R3 chat? Otherwise I can post the original 
debug source of LOAD (not even posted there).

load: func [
	{Loads a file, URL, or string.}

 source [file! url! string! binary! block!] {Source or block of sources}

 /header  {Includes REBOL header object if present. Preempts /all.}

 /next    {Load the next value only. Return block with value and new 
 position.}

;	/library {Force file to be a dynamic library. (Command version)}
;	/markup  {Convert HTML and XML to a block of tags and strings.}
	/all     {Load all values. Does not evaluate REBOL header.}
	/unbound {Do not bind the block.}
	/local data content val rst tmp

][  ; Note: Avoid use of ALL and NEXT funcs, because of /all and 
/next options
	content: val: rst: tmp: none ; In case people call LOAD/local
	
	; Retrieve the script data
	data: case [
		block? source [ ; Load all in block
			return map x source [apply :load [:x header next all unbound]]
		]
		string? source [source] ; Will convert to binary! later
		binary? source [source]
		; Otherwise source is file or url
		'else [
			; See if a codec exists for this file type
			tmp: find find system/catalog/file-types suffix? source word!
			; Get the data, script required if /header
			content: read source  ; Must be a value, not unset
			case [
				binary? :content [content] ; Assumed script or decodable
				string? :content [content] ; Assumed script or decodable
				header [cause-error 'syntax 'no-header source]
				block? :content [content]
				'else [content: reduce [:content]]
			] ; Don't LOAD/header non-script data from urls and files.

  ] ; content is data if content doesn't need copying, or none if it 
  does
	]
	;print [1 "data type?" type? :data 'content true? :content]
	if string? :data [data: to-binary data] ; REBOL script is UTF-8

 assert/type [data [binary! block!] content [binary! string! block! 
 none!]]
	assert [any [binary? :data not header]]
	if tmp [ ; Use a codec if found earlier
		set/any 'data decode first tmp :data

  ; See if we can shortcut return the value, or fake a script if we 
  can't
		case [

   block? :data [if header [insert data val: make system/standard/script 
   []]]

   header [data: reduce [val: make system/standard/script [] :data]]

   (to logic! unbound) and not next [return :data] ; Shortcut return

   any [next any-block? :data any-word? :data] [data: reduce [:data]]
			'else [return :data] ; No binding needed, shortcut return
		]
		assert/type [data block!] ; If we get this far
	]
	;print [2 'data mold to-string :data]
	
	if binary? :data [ ; It's a script
		unless find [0 8] tmp: utf? data [ ; Not UTF-8
			cause-error 'script 'no-decode ajoin ["UTF-" abs tmp]
		]
		; Process the header if necessary
		either any [header not all] [
			if tmp: script? data [data: tmp] ; Load script data
			; Check for a REBOL header
			set/any [val rst] transcode/only data
			unless case [
				:val = [rebol] [ ; Possible script-in-a-block
					set/any [val rst] transcode/next/error rst
					if block? :val [ ; Is script-in-a-block
						data: first transcode/next data
						rst: skip data 2
					] ; If true, val is header spec
				]
				:val = 'rebol [ ; Possible REBOL header
					set/any [val rst] transcode/next/error rst
					block? :val ; If true, val is header spec
				]
			] [ ; No REBOL header, use default
				val: [] rst: data
			]
			; val is the header spec block, rst the position afterwards

   assert/type [val block! rst [binary! block!] data [binary! block!]]
			assert [same? head data head rst]
			; Make the header object

   either val: attempt [construct/with :val system/standard/script] 
   [
				if (select val 'content) = true [
					val/content: any [:content copy source]
				]
			] [cause-error 'syntax 'no-header data]
			; val is correct header object! here, or you don't get here
			; Convert the rest of the data if necessary and not /next
			unless any [next block? data] [data: rst: to block! rst]
			if block? data [ ; Script-in-a-block or not /next
				case [

     header [change/part data val rst] ; Replace the header with the object

     not all [remove/part data rst]	; Remove the header from the data
				]
				rst: none ; Determined later
			]
		] [rst: data] ; /all and not /header
	]

 ; val is the header object or none, rst is the binary position after 
 or none

 assert/type [val [object! none!] rst [binary! none!] data [binary! 
 block!]]

 assert [any [none? rst same? head data head rst] any [val not header]]

 ;print [3 'val mold/all :val 'data mold/all :data "type?" type? :data]
	
	; LOAD/next or convert data to block - block either way
	assert [block? data: case [
		not next [ ; Not /next
			unless any [block? data not binary? rst] [data: to block! rst]
			data
		]
		; Otherwise /next

  block? data [reduce pick [[data] [first+ data data]] empty? data]
		header [reduce [val rst]] ; Already transcoded above
		binary? rst [transcode/next rst]
	]]
	
	; Bind to current global context if not a module
	unless any [ ; Note: NOT ANY instead of ALL because of /all
		unbound
		(select val 'type) = 'module
	][
		bind/new data system/contexts/current
	]
	;print [6 'data mold/all :data 'tmp mold/all :tmp]
	
	; If appropriate and possible, return singular data value
	unless any [
		all header next  ; /all /header /next
		empty? data
		1 < length? data
	][set/any 'data first data]
	;print [7 'data mold/all :data]
	
	:data
]

you can't really catch all possible variations of things like: do 
reduce [ to-set-word "tadam"  44]

You can since R3 words are not bound by default.

no I have so litle time to play with R3... I barely have time to 
chat here...  life, work, kids, music, glass, et al... life is full 
enough withough R3 yet  ' :-/

Some of the asserts are commented out in the release version, but 
all testing is done with all asserts enabled.

wow, that's a pretty massive func!  :-)

I wrote it last weekend.

Though some of it was around before from my previous versions.

I guess a lot of what load used to do is now in the transcode native?

what!!  a command version!?!?   ;-)

{Force file to be a dynamic library. (Command version)}

Yup. And also some stuff that R2's LOAD never had.

No command version. That is just a reminder.

reminder of rebol's past?

Neither of those options will ever be in LOAD again, I think.

/unbound   YAY!

Reminder of missing functionality that will need to be implemented 
somewhere. Untiil last weekend, /next was commented out too.

does load/header/next only give back a header object?

If you read the source you might notice that if you don't specify 
/unbound, the code has to *explicitly* bind the loaded code.

LOAD/header/next gives back [header-object [the rest of the code]]

The /header and /next options are *much* stronger in R3.

cool... I've had issues in the past with them. :-)

LOAD/next %dir/ gives you [%file1 [%file2 %file3 ...]]

Also, the "required" REBOL header isn't so required anymore :)

LOAD/header %file.jpg returns [default-header-object image!]

LOAD makes interesting reading.
(I don't like the meaningless name of the TMP variable.)

strange although symmetric.

wrt "If you read the source you might notice that if you don't specify 
/unbound, the code has to *explicitly* bind the loaded code."  

didn't you mean IF you specify /unbound   ?

What I don't like is the 'val variable - I'm goinng to rename it 
to 'hdr next version.

That would be a good change.

yeah... I guess its val for historic reasons.

Uh oh - I've just noticed TMP is being used for different purposes. 
It's meaning is different at different parts of the function, making 
it harder to understand and reason about the function.

brian, still a bit puzzled by you last /unbound comment

possibly just optimisation of recycling words, not to clutter up 
the number of locals for nothing?

Yes, but cluttering up our heads with a muddle of confusion instead.

I think it's inexcusable in this context.

(That's a bit of a strong word. I should say the function should 
not be considered complete until such variable names are removed.)

No, to-block and transcode make unbound words. If you *don't* specify 
LOAD/unbound, LOAD won't bind the words, which it actually has to 
do explicitly with that BIND/new statement.

(sorry, went offline for a moment)

I do word recycling myself, but only in repeatedly used functions... 
but load being used just a few times per script, such optimisations 
seem a bit excessive, but then if that code was taken from Carl, 
he does pretty excessive optimisations all the time.

TMP is just that, a temporary variable. It has no special meaning 
that isn't mentioned in comments.

The code wasn't taken from Carl, I wrote it from scratch. I write 
LOAD.

Carl's code was less optimal.

hehe  carl's style is growing on you   ;-D

I've been the main writer of the non-GUI mezzanine changes for thhe 
last year. My code tends to be more strict than Carl's :)

I think VAL has a right to exist (with that name), because just after 
it is first set, you don't know whether it's a header block or not. 
You have to check. At the moment you have determined that its value 
is a script header, then you can do:

	hdr: val


which does mean you now have two locals, HDR and VAL, but I don't 
know any other way of preserving the clear and unambiguous meaning 
of a variable.

actually, most rebolers tend to grow the same habits in time :-)

If you think the code is bulletproof now, wait until after I do the 
ASSERT review of the entire codebase :)