Artifact b36cfdb0ce984ede2ca89467dea959c3a68b6dcb

File user/docl/tables.retro part of check-in [87f9808c0a] - playground: change references to 2dup to 2over (all working apps updated) by charleschilders on 2011-02-13 16:33:41. [annotate]

( --- tools for dealing with lists --- )
: deep    ( an-a) 0; for @ next ;
: deepest ( a-a ) repeat dup @ 0; nip again ;
: link,   ( a-  ) here 0 , swap deepest ! ;
: prop    ( a"-a) @last swap !last ' swap !last ;
: after   ( a-a ) last repeat 2over @ =if nip ;then @ 0; again ;
( --- output types --- )
: chars for @+ emit next ;
: string: .data ` type ; immediate
: phone '( emit 3 chars ') emit 
  3 chars '- emit 4 chars drop ;
: phone: .data ` phone ; immediate
: date 2 chars '/ emit 2 chars '/ emit 4 chars drop ;
: date: .data ` date ; immediate
: dollar '$ emit 100 /mod (.) '. emit dup 9 <if 0 (.) then (.) ;
: dollar: .data ` dollar ; immediate
( --- tables: fields/offsets, rows/links, etc. --- )
variable table
variable row
: save ( "- ) @table constant ;
: load ( a- ) @dup !row !table ;
: link @table ;    ( least recent row added )
: size link 1+ ; ( number of fields )
: head size 1+ ; ( header for last field )
: fields @last swap 
  dup for ' create r , , next
  here !table 0 , , @last , !last ;
: f:num @ ;
: f:xt f:num @row + @ ;
: f:fun 1+ @ ;
: f:pair dup f:xt swap f:fun ;
: num:f @head swap 1- deep @d->xt ;
: name:f @head prop ;
( --- input and output --- )
: row,   (  a- ) here !row link link, @size allot ;
: insert ( n"- ) name:f f:num @row + ! ;
: nwhere (  n- ) @link swap deep !row ;
: 3dup dup push push 2over pop -rot pop ;
: match? ( ana- ) 3dup + @ compare ;
: where  ( a"- ) name:f f:num @link
  repeat match? if !row drop ;then @ again ;
: select (  "- ) name:f f:xt ;
: select-list ( n"- ) for name:f f:pair cr with-class next ;
: select-all  (   - ) @size for r num:f f:pair cr with-class next ;
( --- input methods --- )
{{
: cents '. =if 100 * key dup emit 48 - 10 * key dup emit 48 - + + then ;
---reveal---
: keep: here repeat key dup 32 =if drop 0 , ;then dup emit , again ;
: num: 0 repeat key dup emit dup 48 57 within if 48 - swap 10 * + else cents ;then again ; 
}}
( --- example table --- )
4 fields string: name phone: number date: birthdate dollar: paycheck
save mytable
( --- test inputs --- )
row,
0 nwhere
keep: Luke
insert name
keep: 9998887777
insert number
keep: 06201983
insert birthdate
num: 99999.99
insert paycheck
row,
keep: Samuel
insert name
keep: 5554443333
insert number
keep: 12345678
insert birthdate
num: 999999.99
insert paycheck
( --- test outputs --- )
select-all
keep: Luke
where name
select-all