~crc-x/retro-language/sketches

« back to all changes in this revision

Viewing changes to new.rx

  • Committer: crc
  • Date: 2013-07-13 22:25:50 UTC
  • Revision ID: crc@questor-20130713222550-q5ech2zft7osokz2
remove purging of headers

Show diffs side-by-side

added added

removed removed

Lines of Context:
678
678
: default:  ( "-  ) ' 2 + , ; ' .macro last @ d->class !
679
679
" ( ``- ) Compile call to default definition of a function, ignoring any revectoring" :doc
680
680
 
681
 
: HEADERS   (  -n ) 32 ;
682
 
" ( -n ) Returns number of private headers permitted" :doc
683
 
 
684
 
{{
685
 
  : scratch  ( -a )
686
 
    memory @       STRING-LENGTH   -  ( tib     )
687
 
                   STRING-LENGTH   -  ( scratch )
688
 
    STRING-BUFFERS STRING-LENGTH * -  ( buffers )
689
 
    HEADERS dup STRING-LENGTH * swap 3 * + -  ( headers ) ;
690
 
 
691
 
  create next  0 ,
692
 
  create split 0 ,
693
 
 
694
 
  [ split @
695
 
    [ heap @ [ next @ heap ! default: header heap @ next ! ] dip heap ! here last @ d->xt ! ]
696
 
    [ default: header ] if ] is header
697
 
 
698
 
  create z
699
 
     999 , 999 , 0 ,
700
 
 
701
 
  [ split  on scratch next ! default: {{           z header ] is {{
702
 
  [ split off                default: ---reveal---          ] is ---reveal---
703
 
  [ split off                default: }}                    ] is }}
704
 
}}
705
681
 
706
682
( Dictionary ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
707
683
{{