Red string conversion table generator

string-conversion-table-gen.red

Red []

; alphabetical datatype listing
; set 'datatype-single-test-values compose [
;     action!     (:add)
;     binary!     #{}
;     bitset!     #[bitset! #{}]
;     block!      []
;     char!       #"A"
;     closure!    (closure [a b] [])
;     datatype!   #[datatype! action!]
;     date!       1-jan-2000
;     decimal!    1.5
;     email!      [email protected]
;     end!        NA
;     error!      (make error! "") ;(disarm try [make error! ""])
;     event!      NA
;     file!       %""
;     frame!      NA
;     function!   (func [a b] [])
;     get-path!   :a/b/c
;     get-word!   :test
;     gob!        (make gob! [])
;     handle!     NA
;     image!      (make image! 1x1)
;     integer!    1
;     issue!      #abc
;     library!     NA
;     lit-path!   'a/b/c
;     lit-word!   'test
;     logic!      (false)
;     map!        (make map! [])
;     module!     NA
;     money!      $0.01
;     native!     NA
;     none!       #[none]
;     object!     (context [a: b: none])
;     op!         (:+)
;     pair!       1x1
;     paren!      (to paren! [])
;     path!       a/b/c
;     percent!    1%
;     port!       NA
;     rebcode!    NA
;     refinement! /test
;     routine!    NA
;     set-path!   a/b/c:
;     set-word!   test:
;     string!     "abc"
;     struct!     NA
;     tag!         <abc>
;     task!       NA
;     time!       0:0:1
;     tuple!      0.0.1
;     typeset!    (make typeset! [scalar! tag!])
;     unset!      (make unset! none)    'unset-placeholder ; compose eliminates the unset val
;     url!        http://abc
;     utype!      NA
;     vector!     (make vector! 10)
;     word!       test
; ]
;insert next find datatype-single-test-values 'unset! ()

; system/catalog/datatypes order
set 'datatype-single-test-values compose [
	end!        NA
	unset!      (make unset! none)    'unset-placeholder ; compose eliminates the unset val
	none!       #[none]
	logic!      (false)
	integer!    1
;    decimal!    1.5
	percent!    1%
;    money!      $0.01
	char!       #"A"
	pair!       1x1
	tuple!      0.0.1
	time!       0:0:1
	date!       1-jan-2000
	binary!     #{}
	string!     "abc"
	file!       %""
	email!      [email protected]
	url!        http://abc
	tag!         <abc>
;    bitset!     #[bitset! #{}]
	image!      (make image! 1x1)
	vector!     (make vector! 10)
	block!      []
	paren!      (to paren! [])
	path!       a/b/c
	set-path!   a/b/c:
	get-path!   :a/b/c
	lit-path!   'a/b/c
	map!        #()
;    datatype!   #[datatype! action!]
	typeset!    (make typeset! [scalar! tag!])
	word!       test
	set-word!   test:
	get-word!   :test
	lit-word!   'test
	refinement! /test
	issue!      #abc

	native!     NA
	action!     (:add)
;    rebcode!    NA
;    command!    NA
	op!         (:+)

;    closure!    (closure [a b] [])
	function!   (func [a b] [])
;    frame!      NA
	object!     (context [a: b: none])
;    module!     NA
	error!      (make error! "") ;(disarm try [make error! ""])
;    task!       NA
;    port!       NA

;    gob!        (make gob! [])
	event!      NA
;    handle!     NA

;    library!    NA
;    struct!     NA
;    utype!      NA
]


;---------------------------------------------------------------------------    
; replace didn't work correctly under R3 when this was first written, but 
; maybe it does now.
html-ize: func [value] [
	replace/all value "<" "&lt;"
	replace/all value ">" "&gt;"
]
;html-ize: func [value] [:value]

use: function [words [block!] body [block!]][
	forall words [words/1: to-set-word words/1]
	context head insert body append words none
]

use [format-base mold-all ops op-names][

	format-val: func [value] [format [] :value]
	mold-all: func [value] [mold/all :value]
	
	ops: [to-string form mold mold-all format-val]
	op-names: [to-string form mold "mold/all" format]
	
	set 'generate-all-form-tables func [
		/local buff tbl file ops
	][
		buff: copy ""
		if not exists? %form/ [make-dir/deep %form/]
;             foreach word ops [
;                 file: rejoin [%form/ file %.tbl]
;                 print [mold :word tab mold file]
;                 append buff tbl: generate-form-table word
;                 append buff crlf
;                 attempt [delete file]
;                 write file tbl
;             ] 
		append buff tbl: generate-form-table
		print ""
		attempt [delete %form/_all-tables-red.html]
		write %form/_all-tables-red.html buff
		buff
	]
	
	set 'generate-form-table func [
		/local emit res buff test-val-avail? get-test-val
	][
		test-val-avail?: func [type] [find/skip datatype-single-test-values to word! type 2]
		get-test-val: func [type] [select datatype-single-test-values to word! type]
		buff: copy ""
		emit: func [line] [append buff rejoin [form line " " crlf]]
		
		emit reduce [<h3> "String conversions" </h3>]
		emit <table border=0 cellspacing=1 cellpadding=5 bgcolor=gray>
		emit <tr>
		emit [<th> </th>] ; cell at 0x0
		foreach op op-names [emit reduce [<th> form op </th>]]
		emit </tr>    
	
		ct: 0
		foreach [type val] datatype-single-test-values [
			emit <tr bgcolor=white>
			if test-val-avail? type [
				emit reduce [<th> form type </th>]
			]
			foreach op ops [
				if test-val-avail? type [
					error? set/any 'res try [do reduce [op first [:val]]]
					emit reduce [<td> either error? get/any 'res [mold #ERR] [html-ize res] </td>]
				]
			]
			;dbg: buff halt
			emit </tr>
		]
		emit </table>
		emit <br>
		buff
	]
	
]

s: generate-all-form-tables