( Headers in C for botForth  Rob Chapman  Apr 15, 1992 )
: ?\'  ( c -- c )  DUP ` ' =  IF  ." \"  ENDIF ;
HEX
  RULE-SET interpret-headers ( rules to create headers for Forth words )
  RULE-SET compile-headers   ( rules to ignore things in compile mode )
  RULE-SET translate-return  ( for post processing after translate rules )

translate-return RULES
{ }[ inputq PULL  interpret-headers RULES ]

interpret-headers RULES
{ }[ inputq PULL DROP ]
{ ( }[ ` ) SCAN ]
{ ." }{ " }[ ` " SCAN ]

{ : }{ get name  ] }
{ ] }[ interpret-headers  compile-headers RULES ]
{ CREATE }{ CONSTANT }{ VARIABLE }{ QUEUE }{ get name  new header }
{ get name }[ BL WORD  HERE  DUP C@ 1 + ALLOT ]

{ new header }{ .canned header  .count   .'name'  .tick }
{ imm header }{ .canned header  .icount  .'name'  .tick }

{ .canned header }{ .ext  .eol  .part1  .n  .part2  ._name  .part3   .&_prev }
{ .eol }[ A EMIT  0 out ! ]
{ .ext }[ DUP ]{ translate string  .eol  .extern }
{ .extern }[ ." extern void " COUNT TYPE  ." ();" ]
{ .part1 }[ ." DictEntry(" ]
{ .n }[ DUP C@ 1 + 0 .R ]
{ .part2 }[ ." )" ]
{ .part3 }[ ." ={" ]{ .eol }

{ ._name }[ ." _"  DUP ]{ .cstring }
{ iP }[ inputq PULL ]
{ translate string }[ inputq STUFF  translate-return  translate RULES ]
{ .string }[ COUNT TYPE ]
{ .&_prev }[ SWAP NUP ]{ ?.link }
{ ?.link }[ ."   (void *)"  ?DUP  IF  ." &_"  { .cstring }  ELSE  ." 0"  ENDIF ]
{ .cstring }{ translate string .string }
{ .count }[ ." ,0x80|"  DUP C@ 0 .R ." ," ]
{ .icount }[ ." ,0xC0|"  DUP C@ 0 .R ." ," ]
{ .'name' }[ COUNT  FOR  C@+ SWAP  ." '"  ?\'  EMIT  ." ',"  NEXT  DROP ]
{ .tick }[ " };" OVER ]{ .cstring  .string  .eol }

( ==== For making C headers from a word list ==== )
  0 VARIABLE linkage  ( points to the current linkage of a word )
  
{ make C headers }[ latest @ linkage ! ]{ next name }

{ next name }[ linkage @ ?DUP  IF  DUP L>LINK linkage !  { make header } ENDIF ]
{ make header }[ L>NAME ]{ extract name  type header  next name }
{ extract name }[ HERE $!  HERE C@  DUP  1F AND HERE C!  HERE ]
{ type header }[ SWAP 40 AND  IF  { imm header }  ELSE  { new header }  ENDIF ]

compile-headers RULES  ( from ruleset -- )
{ }[ inputq PULL DROP ]
{ [ }[ RULES ]
{ ] }[ compile-headers ]

( { C }{ [ new header ] } )
{ : }{ [ : }

{ ; }{ [ new header }
{ ; IMMEDIATE }{ [ imm header }

{ ( }[ ` ) SCAN ]
{ ." }{ " }[ ` " SCAN ]
{ ' }{ ` }{ POSTPONE }[ BL WORD ]
