APL/D Source Code:
────────────────────────────────────────────────────────────────────────────────
create←{⎕IO ⎕ML←0 ⍝ Create table.
error←⎕SIGNAL⍨ ⍝ signal error.
tps←80 160 320 83 163 323 645 ⍝ expected types.
0::⎕EN error⊃⎕DM ⍝ pass error to caller.
0=⎕NC'⍺':⎕SIGNAL 2 ⍝ left arg is table name.
2=|≡⍵:⍺ ∇,⊂⍵ ⍝ single field: enclose.
tab←#.⎕NS'' ⋄ tab.(⎕IO ⎕ML←0) ⍝ new table handle.
tab.tname←⍺,('.'≠⊃⌽⍺∩'/.\')/'.ddb' ⍝ table file name.
tab.access←'w' ⍝ read/write access.
tab.(names types)←↓⍉↑2↑¨⍵ ⍝ field names, data types,
tab.shapes←3↓¨0,¨⍵ ⍝ and shapes.
0∊tab.types∊tps:11 error'BAD FIELD TYPE' ⍝ unexpected type.
_fill tab: ⍝ install handle parameters.
fix←{83 ⎕DR⊃(⎕DR ⍵)⍺ ⎕DR ⍵} ⍝ ⍺ type fix.
buff←¯86 ¯128 0 ¯128 ⍝ magic no: aa 80 00 80
buff,←323 fix tab.(0 _cols _flds) ⍝ skip cols flds
buff,←163 fix tab.types ⍝ types
buff,←83 fix tab.(⊃∘⍴¨shapes) ⍝ ranks
buff,←323 fix tab.(↑,/shapes) ⍝ shapes
buff,←80 fix↑,/tab.names,¨⊃⎕AV ⍝ 0-terminated field names.
tab._skip←⌈(⊃⍴buff)÷tab._cols ⍝ rows occupied by header.
buff[4+⍳4]←323 fix tab._skip ⍝ set skip field in buff.
22::⎕EN error'BAD TABLE NAME' ⍝ can't create: table exists.
ntie←tab.tname ⎕NCREATE 0 ⍝ create ⍺.ddb file.
0::⎕EN error⊃⎕DM{⍺}⎕NUNTIE ntie ⍝ untie file on error.
_←(tab.(_skip×_cols)↑buff)⎕NAPPEND ntie 83 ⍝ write header bytes.
_←⎕NUNTIE ntie ⍝ release file.
tab.(_map←83 ¯1 _cols ⎕MAP tname access) ⍝ map as byte matrix.
1:shy←tab ⍝ shy result: table handle.
}
────────────────────────────────────────────────────────────────────────────────
remove←{ ⍝ Remove table.
error←⎕SIGNAL⍨ ⍝ signal error.
0::⎕EN error⊃⎕DM ⍝ pass error to caller.
9=⎕NC'⍵':∇ ⍵.({tname}⎕EX'_map') ⍝ open: retry after close.
tname←⍵,('.'≠⊃⌽⍵∩'/.\')/'.ddb' ⍝ table file name.
22::{1:shy←0}0 ⍝ table didn't exist.
ntie←tname ⎕NTIE 0 ⍝ tie table file.
19::⎕EN error'TABLE OPEN'{⍺}⎕NUNTIE ntie ⍝ table mapped.
1:shy←{1}tname ⎕NERASE ntie ⍝ erase table file.
}
────────────────────────────────────────────────────────────────────────────────
append←{⎕IO ⎕ML←0 ⍝ Append row(s) to table.
error←⎕SIGNAL⍨ ⍝ signal error.
0=⎕NC'⍺':⎕SIGNAL 2 ⍝ left arg is table.
9≠⎕NC'⍺':('w'open ⍺)∇ ⍵ ⍝ file name: retry with handle.
0::⎕EN error⊃⎕DM ⍝ pass error to caller.
'w'≠⍺.access:19 error'READ-ONLY TABLE' ⍝ check write access.
put←{⍵ ⎕NAPPEND ntie 83} ⍝ put rows to file.
vals←⍺.(_flds=1)⊃⍵(⊂⍵) ⍝ enclose if single field table.
puts←⍺.{types shapes _xtra ⍵}vals ⍝ put parameters.
ntie←⍺.tname ⎕NTIE 0{⍺}⍺.⎕EX'_map' ⍝ tie native file.
remap←⍺.{83 ¯1 _cols ⎕MAP tname access} ⍝ remap file.
reset←{⍺._map←remap ⎕NUNTIE ⍵} ⍝ reset after error.
0::⎕EN error⊃⎕DM{⍺}⍺ reset ntie ⍝ reset & signal error.
size←put↑,/⍺.names _83mat¨↓⍉↑puts ⍝ append extra rows.
1:shy←{size}⍺ reset ntie ⍝ shy result: table handle.
}
────────────────────────────────────────────────────────────────────────────────
retain←{⎕IO ⎕ML←0 ⍝ Retain only selected rows.
0::(⊃⎕DM)⎕SIGNAL ⎕EN ⍝ pass error to caller.
0=⎕NC'⍺':⎕SIGNAL 2 ⍝ left arg is table.
9≠⎕NC'⍺':('w'open ⍺)∇ ⍵ ⍝ file name: retry with handle.
error←⎕SIGNAL⍨ ⍝ signal error.
'w'≠⍺.access:19 error'READ-ONLY TABLE' ⍝ check write access.
mask←⍺.((_skip/1),⍵∨0×⍳(⊃⍴_map)-_skip) ⍝ mask for whole file.
size←⍺._cols×+/mask ⍝ new file size.
∧/mask:shy←size ⍝ all rows retained: done.
unmap←⍺.{tname ⎕NTIE 0{⍺}⎕EX'_map'} ⍝ unmap and tie native file.
remap←{⍺._map←_map ⎕NUNTIE ⍵} ⍝ untie and map native file.
_map←⍺.{83 ¯1 _cols ⎕MAP tname access} ⍝ map file.
ntie←unmap 0 ⍝ unmap and tie native file.
lndx←¯1+⎕NSIZE ntie ⍝ last byte index.
last←⎕NREAD ntie 83 1 lndx ⍝ last byte in file.
19::⎕EN error'TABLE OPEN'{⍺}⍺ remap ntie ⍝ failure: too many handles.
{0}last ⎕NAPPEND lndx ⎕NRESIZE ntie: ⍝ attempt remove/replace byte.
{0}⍺ remap ntie: ⍝ success: not too many handles.
⍺._map[⍳+/mask;]←mask⌿⍺._map ⍝ compress mapped file rows.
1:shy←{size}⍺ remap size ⎕NRESIZE unmap 0 ⍝ truncate and remap file.
}
────────────────────────────────────────────────────────────────────────────────
open←{⎕IO ⎕ML←0 ⍝ Open table {read/write}.
error←⎕SIGNAL⍨ ⍝ signal error.
0::⎕EN error⊃⎕DM ⍝ pass error to caller.
⍺←'r' ⍝ default: read-only.
9=⎕NC'⍵':⍺ ∇ ⍵.tname ⍝ handle: reopen.
tab←#.⎕NS'' ⋄ tab.(⎕IO ⎕ML)←0 ⍝ create handle.
tab.access←('rRwW'⍳⍺)⊃'rrwwr' ⍝ read/write access.
tab.tname←⍵,('.'≠⊃⌽⍵∩'/.\')/'.ddb' ⍝ table file name.
19 22::22 error'BAD TABLE NAME' ⍝ bad name signals 19 or 22.
vec←83 ¯1 ⎕MAP tab.(tname access) ⍝ map table as byte vector.
tab.(_skip _cols _flds)←1↓323 ⎕DR 16↑vec ⍝ field size values.
slice←{vec[(16+⍺×tab._flds)+⍳⍵]} ⍝ slice from vec.
ranks←2 slice tab._flds ⍝ field ranks.
tab.types←163 ⎕DR 0 slice 2×tab._flds ⍝ field types.
size←4×+/ranks ⍝ size of shape vector.
shapes←0+323 ⎕DR 3 slice size ⍝ all shapes.
tab.shapes←ranks{(-⍺)↑¨(+\⍺)↑¨⊂⍵}shapes ⍝ shape per field.
drop←16+size+3×tab._flds ⍝ size of fixed header region.
nvec←drop↓tab.(_skip×_cols)↑vec ⍝ names vector.
split←{¯1↓¨80 ⎕DR¨(0=¯1⌽⍵)⊂⍵} ⍝ name split.
tab.names←tab._flds↑split nvec ⍝ field names.
_fill tab: ⍝ install handle parameters.
tab.(_map←83 ¯1 _cols ⎕MAP tname access) ⍝ remap file as byte matrix.
tab ⍝ result is table handle.
}
────────────────────────────────────────────────────────────────────────────────
defs←{ ⍝ Field definitions.
error←⎕SIGNAL⍨ ⍝ signal error.
0::⎕EN error⊃⎕DM ⍝ pass error to caller.
9≠⎕NC'⍵':∇ open ⍵ ⍝ accepts table name or handle.
⍵.((↓⍉↑names types),¨shapes) ⍝ .. table handle.
}
────────────────────────────────────────────────────────────────────────────────
get←{⎕IO ⎕ML←0 ⍝ Get rows from table field(s).
error←⎕SIGNAL⍨ ⍝ signal error.
0=⎕NC'⍺':⎕SIGNAL 2 ⍝ left arg is table.
0::⎕EN error⊃⎕DM ⍝ pass errors to caller.
9≠⎕NC'⍺':(open ⍺)∇ ⍵ ⍝ file name: open.
rows field_s←(2|⎕DR⊃⍵)⊃(1 ⍵)⍵ ⍝ row selection, field name(s).
fields←(1=≡,field_s)⊃field_s(⊂field_s) ⍝ enclose if single field.
qt←{'"',⍵,'"'} ⍝ quote bad field name.
3::6 error'BAD NAME',⍕qt¨fields~⍺.names ⍝ unexpected field name(s).
inds←⍺.names⍳fields ⍝ fields indices from key.
mask←(⍳⍺._flds)∊inds ⍝ field selection mask.
cols←↑∨/inds⊃¨⊂⍺._cvex ⍝ column indices.
cons←mask/⍺.(↓⍉↑types shapes _svex _xtra) ⍝ conversion parameters.
fix←{ ⍝ fix values' type and shape.
type shape svec xtra←⍺ ⍝ conversion parameters.
conv←{(|⍺)⎕DR⊃(⎕DR ⍵)83 ⎕DR ⍵} ⍝ type conversion.
resp←{((⊃⍴⍵),⍺)⍴⍵} ⍝ reshape.
~¯1∊×shape:shape resp type conv ⍵ ⍝ simple: convert type.
sconv←{↓⍉↑,¨(3+80×xtra~0)conv¨⍵} ⍝ shape conversion.
split←{(sconv ¯1↓⍵)(type conv⊃⌽⍵)} ⍝ split out shape and values.
svex←{(⊂shape)⌈(⊂shape<0)\¨⍵} ⍝ shape vectors.
encls←{(svex ⍺)↑¨(⊂|shape)⍴¨↓⍵} ⍝ reshape each value.
↑encls/split svec⊂⍵ ⍝ shape vectors and values.
}
xtract←{ ⍝ mask out rows and cols.
1≡rows:⍺._skip 0↓cols/⍵ ⍝ get 1 ...: get all rows.
0≡rows:cols/0⌿⍵ ⍝ get 0 ...: get no rows.
cols/((⍺._skip⍴0 0),rows)⌿⍵ ⍝ use header-padded mask.
}
1=≡,field_s:(⊃cons)fix ⍺ xtract ⍺._map ⍝ fetch single field.
part←↑,/mask/⍺._pvex ⍝ partition vector for fields.
(⍋inds)⊃¨⊂cons fix¨part⊂⍺ xtract ⍺._map ⍝ fetch multiple fields.
}
────────────────────────────────────────────────────────────────────────────────
put←{⎕IO ⎕ML←0 ⍝ Replace values in field(s).
0=⎕NC'⍺':⎕SIGNAL 2 ⍝ error: missing table.
9≠⎕NC'⍺':('w'open ⍺)∇ ⍵ ⍝ file name: open and continue.
error←⎕SIGNAL⍨ ⍝ signal error.
0::⎕EN error⊃⎕DM ⍝ pass error to caller.
mask field_s val_s←¯3↑1,⍵ ⍝ rows, field(s) and new values.
encl←{⍺⊃⍵(,⊂⍵)} ⍝ enclose ⍵ if ⍺.
single←1=≡,field_s ⍝ single field.
fields vals←single encl¨field_s val_s ⍝ enclose if single field.
'w'≠⍺.access:19 error'READ-ONLY TABLE' ⍝ opened without 'w' option.
3::6 error'BAD NAME',⍕fields~⍺.names ⍝ unexpected field name(s).
inds←⍺.names⍳fields ⍝ field indices from key.
rows←mask/⍺.(_skip↓⍳⊃⍴_map) ⍝ row indices.
cols←↑,/inds⊃¨⊂⍺._xvex ⍝ column indices.
puts←↓⍉↑inds⊃¨⊂↓⍉↑⍺.(types shapes _xtra) ⍝ conversion parameters.
collect←{↑,/fields _83mat¨↓⍉↑puts,⊂⍵} ⍝ collect values.
⍺._map[rows;cols]←collect vals ⍝ insert map rows.
1:shy←single⊃vals(⊃vals) ⍝ shy rslt: new values.
}
────────────────────────────────────────────────────────────────────────────────
_fill←{ ⍝ Install handle parameters.
0::(⊃⎕DM)⎕SIGNAL ⎕EN ⍝ pass errors to caller.
⍵.(_xtra←(shapes<0)×⌊(⎕DR¨⍵.shapes)÷80) ⍝ extra shape bytes per axis.
bpt←⍵.((+/¨_xtra)+(×/¨|shapes)×⌊types÷80) ⍝ bytes per type.
⍵.(_flds←⊃⍴,types) ⍝ number of fields
⍵._cols←+/bpt ⍝ no of bytes per row.
⍵._cvex←↓bpt{⍵∘.=⍺/⍵}⍳⍴bpt ⍝ byte-column masks.
⍵.(_xvex←_cvex/¨⊂⍳⍴⊃_cvex) ⍝ byte-column indices.
⍵._pvex←1=bpt↑¨1 ⍝ field partition vectors.
⍵._svex←⍵.(_pvex{(⍴⍺)↑↑,/1,⍵↑¨1}¨-_xtra) ⍝ shape partition vectors.
0 ⍝ zero rslt to foil guard.
}
────────────────────────────────────────────────────────────────────────────────
_83mat←{⎕IO ⎕ML←0 ⍝ type 83 rows for map mat.
type shape xtra vals←⍵ ⍝ conversion parameters.
error←⍺{(⍵,' in "',⍺⍺,'"')⎕SIGNAL ⍺} ⍝ signal error.
0::⎕EN error⊃⎕DM ⍝ pass error to caller.
simple←{ ⍝ simple: quick special case.
rdiff←(⍴⍴⍵)-⍴⍺ ⍝ rank difference.
rdiff=0:⍺ ∇(1,⍴⍵)⍴⍵ ⍝ single row: increase rank.
rdiff≠1:4 error'BAD RANK' ⍝ rank error.
1<|≡⍵:11 error'BAD DEPTH' ⍝ nested values: depth error.
1∊⍺<1↓⍴⍵:10 error'BAD SIZE' ⍝ value items truncated.
1≠≡⍵:11 error'BAD DEPTH' ⍝ depth error.
≠/2|type,⎕DR ⍵:11 error'BAD TYPE' ⍝ impossible conversion.
matr←{,[1+⍳⍴⍺]((⊃⍴⍵),⍺)↑⍵} ⍝ pad to required size.
type conv ⍺ matr ⍵ ⍝ padded matrix.
}
nested←{ ⍝ nested: slower general case.
2>|≡⍵:⍺ ∇,⊂⍵ ⍝ single row: increase depth.
svec←(⍺<0)/↓⍉↑⍴¨,⍵ ⍝ shapes.
pre←↑,/(3+80×xtra~0)conv∘(,[⍬])¨svec ⍝ shape bytes.
pre,(|⍺)simple↑((⊂⍺)⌈⍴¨⍵)↑¨⍵ ⍝ prefix simple mix.
}
conv←{83 ⎕DR⊃vchk\(⎕DR ⍵)⍺ ⎕DR ⍵} ⍝ ⍺-type conversion,
vchk←{0∊⍵:11 error'BAD VALUE' ⋄ ⍵} ⍝ error if conversion fails.
¯1∊×shape:shape nested vals ⍝ nested field:
shape simple vals ⍝ simple field:
}
────────────────────────────────────────────────────────────────────────────────
Back to: Contents