/red-system/utils/virtual-struct.r
R | 114 lines | 104 code | 10 blank | 0 comment | 3 complexity | 3af5c7aef45318d6667e7b5aa20a174f MD5 | raw file
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]