/red-system/utils/virtual-struct.r

  1REBOL [
  2	Title:    "Red/System struct! datatype replacement library"
  3	Author:   "Nenad Rakocevic"
  4	File: 	  %virtual-struct.r
  5	Rights:   "Copyright (C) 2011 Nenad Rakocevic. All rights reserved."
  6	License:  "BSD-3 - https://github.com/dockimbel/Red/blob/master/BSD-3-License.txt"
  7	Requires: %int-to-bin.r
  8	Purpose:  "Migrate code dependent on struct! native datatype to /Core"
  9	Usage:	  {
 10		Replace:
 11			make struct! [...]	=>	make-struct [...]
 12			make struct! none	=>	make-struct none
 13			third <struct!>		=>	form-struct <struct!>
 14			struct? <struct!>	=>	struct? <struct!>		(no changes)
 15			
 16		Members read/write access:
 17			All members are accessed the same way as with native struct!.
 18			No changes required.
 19	}
 20	Comments: {
 21		A closer result could be achieved using a port scheme instead of
 22		an object to encapsulate data.
 23	}
 24]
 25
 26virtual-struct!: context [
 27	alignment: 4									;-- default struct members alignement in bytes
 28	
 29	base-class: context [
 30		__vs-type: struct!
 31		__vs-spec: none
 32	]
 33
 34	pad: func [buf [any-string!] n [integer!] /local mod][
 35		unless any [
 36			empty? buf
 37			zero? mod: (length? buf) // n
 38		][	
 39			head insert/dup tail buf null n - mod
 40		]
 41	]
 42	
 43	set 'struct? func [
 44		"Returns TRUE if the argument is a virtual struct!."
 45		value [any-type!]		"value to test"
 46		/local type
 47	][
 48		to logic! all [
 49			object? value
 50			type: in value '__vs-type
 51			struct! = get type
 52		]
 53	]
 54
 55	set 'make-struct func [
 56		"Returns a new virtual struct! value built from a spec block."
 57		spec  [block! object!]	"specification block (same as for struct!)"
 58		data  [block! none!]	"none or block of initialization values"
 59		/local action obj specs
 60	][
 61		obj: either object? spec [
 62			make spec []
 63		][
 64			specs: copy [__vs-spec: spec]
 65			foreach [name type] spec [append specs to set-word! name]
 66			append specs none
 67			make base-class specs
 68		]
 69		
 70		if data [
 71			specs: skip first obj 3					;-- skip over: self, __vs-type, __vs-spec
 72			until [
 73				set in obj specs/1 data/1
 74				data: next data
 75				tail? specs: next specs
 76			]
 77		]	
 78		obj
 79	]
 80
 81	set 'form-struct func [
 82		"Serialize a virtual struct! and returns a binary! value."
 83		obj [object!]			"virtual struct! value"
 84		/with					"provide a custom members alignment"
 85			n [integer!]		"new alignment value in bytes"
 86		/local out type members value
 87	][
 88		unless all [
 89			type: in obj '__vs-type
 90			struct! = get type
 91		][
 92			make error! "invalid virtual struct! value"
 93		]
 94		out: make binary! 4 * length? members: skip first obj 3		;-- raw guess
 95		n: any [n alignment]
 96		
 97		foreach name members [
 98			type: select obj/__vs-spec name
 99			value: get in obj name
100			
101			append out switch/default type/1 [
102				char 	 [to-bin8   any [value 0]]
103				short	 [pad out 2 to-bin16  any [value 0]]
104				int		 [pad out 4 to-bin32  any [value 0]]
105				char!	 [to-bin8   any [value 0]]
106				integer! [pad out 4 to-bin32  any [value 0]]
107				decimal! [pad out 4 #{0000000000000000}]	;-- placeholder
108			][
109				make error! join "datatype not supported: " mold type/1
110			]
111		]	
112		out
113	]
114]