\ The message body below is a verbatim copy, except for an \ insertion of zero before the [IF] at the head of blockette 6, \ a correction posted by the author in an immediate followup. \ From: Wil Baden \ Subject: Pattern Expansion \ Newsgroups: comp.lang.forth \ Date: 2000/05/23 \ MESSAGE BODY 0 [IF] ======================================================== Blockette 0 Wil Baden 00-03-28 PATTERN ======= General Purpose Macro Processor for Forth ----------------------------------------- EXPAND-PATTERN ( par . pat . -- pay . ) Gives a major extension to simple macro. (A simple macro only copies strings without arguments, and cannot define or parse.) Given two character strings -- the parameters and the pattern -- EXPAND-PATTERN consumes the characters from the pattern one by one, copying a character from it or a word from the parameters. The composite text will be returned as a character string. In the pattern, `$` indicates which word is taken from the parameters. `$1` through `$9` are words 1 through 9. `$0` is the contents of promiscuous variable TEMP. `$$` will be a single $. Example. S" John Doe (714) 666-1313 Victim" S" $2, $1 ($5)" EXPAND-PATTERN CR TYPE \ Doe, John (Victim) ============================================================== ($ Pattern Expansion ($ pattern | argument ... $) ($ | pattern | line ... $) ($ "pattern-expansion" is used for initialization and testing. It mixes a pattern of text and parameters with a succession of argument strings. There are two modes: `($` and `($ |`. ($ not followed by | takes as an argument single words. In the pattern they are represented by $1. $0 is the value in variable TEMP. $) as a word anywhere ends the succession of arguments. The other mode, `($ |`, takes lines as parameters. Arguments are $1 through $9. $0 is the value in TEMP. $) should begin text on a line. Examples. \ Declare four variables. ($ VARIABLE $1 | PEASEBLOSSOM COBWEB MOTH MUSTARDSEED $) \ Initialize them. ($ $1 OFF | PEASEBLOSSOM COBWEB MOTH MUSTARDSEED $) \ Declare, initialize, and display several variables. ($ | VARIABLE $1 $2 $1 ! $1 ? | LARRY 20 MOE 25 CURLY 30 $) \ Define constants for months. Names begin with `#`. 1 ($ DUP 1+ SWAP CONSTANT #$1 | JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC $) DROP \ "30 days hath September, ...." CASE ($ #$1 OF 30 ENDOF | SEP APR JUN NOV $) #FEB OF 28 #YEAR 4 MOD 0= - ENDOF \ 2's compl arith. DROP 31 0 ENDCASE \ It's easy to go from non-parsing to parsing, but how do \ you get from parsing to non-parsing? : SEEN ( str . -- ) S" SEE $1 " EXPAT EVALUATE ; \ SwiftForth sets up optimization replacements by: \ OPTIMIZE foo bar SUBSTITUTE foobar \ PowerMacForth does it: \ ' foo ' bar 2 ' foobar ADD-PATTERN \ Porting OPTIMIZE to PowerMacForth. : OPTIMIZE ( "foo bar SUBSTITUTE foobar" -- ) #EOL-CHAR PARSE S" ' $1 ' $2 2 ' $4 ADD-PATTERN " EXPAT EVALUATE ; Environmental dependency on 1 CHARS is 1 (I think). ======================================================== [THEN] 0 [IF] -------------------------------------------------------- Blockette 1 Off-the-Shelf TOOLS Some or all of these may already be defined. What you don't need should be commented out. Uncomment anything that you do need. Documentation is in their source files. -------------------------------------------------------- [THEN] 13 CONSTANT #EOL-CHAR ( 10 for Unix ) : (.) ( n -- str len ) DUP ABS 0 <# #S ROT SIGN #> ; : APPEND-CHAR ( char addr -- ) DUP >R COUNT DUP 1+ R> C! + C! ; : IS-BLANK ( char -- flag ) 33 - 0< ; : BL-SCAN ( str len -- str+i len-i ) BEGIN DUP WHILE OVER C@ IS-BLANK 0= WHILE 1 /STRING REPEAT THEN ; : BL-SKIP ( str len -- str+i len-i ) BEGIN DUP WHILE OVER C@ IS-BLANK WHILE 1 /STRING REPEAT THEN ; : BOUNDS ( str len -- str+len str ) OVER + SWAP ; : MACRO ( "name ccc" -- ) : CHAR PARSE POSTPONE SLITERAL POSTPONE EVALUATE POSTPONE ; IMMEDIATE ; : NEXT-WORD ( -- str len ) BEGIN BL WORD COUNT ( str len) DUP IF EXIT THEN REFILL WHILE 2DROP ( ) REPEAT ; ( str len) : NOT S" 0= " EVALUATE ; IMMEDIATE : PLACE ( str len addr -- ) 2DUP 2>R 1+ SWAP MOVE ( ) 2R> C! ; : STARTS? ( str len pattern len2 -- str len flag ) DUP >R 2OVER R> MIN COMPARE 0= ; VARIABLE TEMP 0 [IF] -------------------------------------------------------- Blockette 2 ARG ( par . n -- str len ) Takes an index n and returns the appropriate word from parameters. -------------------------------------------------------- [THEN] : ARG ( par . n -- str len ) \ Skip to end of word n-1. 1- 0 ?DO BL-SKIP BL-SCAN LOOP ( str len) \ Skip to beginning of word n and extract it. BL-SKIP 2DUP BL-SCAN ( str len str+i len-i) NIP - ( str i) ; 0 [IF] -------------------------------------------------------- Blockette 3 PAYOUT ( -- addr ) Is the value-word that will be set to the address for string output. THE-PAYOUT is the initial buffer for PAYOUT. #PARAM-CHAR is the character to identify arguments. The default is `$`. `$0` is the contents of TEMP. `$1` through `$9` are the 1st through 9th arguments. Otherwise the next character is taken. This yields `$$` for "$". TEMP is a promiscuous variable used to provide a number for use in parameter expansion. It is expanded by `$0`. -------------------------------------------------------- [THEN] 0 VALUE PAYOUT CREATE THE-PAYOUT 256 CHARS ALLOT CHAR $ VALUE #PARAM-CHAR 0 [IF] -------------------------------------------------------- Blockette 4 C@/STRING ( str len -- str+1 len-1 char ) Fetches the next character from the string and advances in the string. (Named like `C@+`.) COPY-PARAMETER ( pat . str len payout -- pat . ) Moves a parameter to payout. When moving a parameter to the payout, matching blanks in the pattern are consumed when possible, i.e., before another blank. Used in EXPAND-ARGUMENT.... -------------------------------------------------------- [THEN] : C@/STRING ( str len -- str+1 len-1 char ) OVER C@ >R 1 /STRING R> ; : COPY-PARAMETER ( pat . str len payout -- pat . ) ROT ROT BOUNDS ?DO ( pat . payout) >R OVER 2 S" " COMPARE 0= IF 1 /STRING THEN R> I C@ OVER APPEND-CHAR LOOP DROP ; 0 [IF] -------------------------------------------------------- Blockette 5 Used in EXPAND-PARAMETERS. EXPAND-ARGUMENT ( par . pat . char -- par . pat . ) Expands with the argument selected by the parameter number. -------------------------------------------------------- [THEN] : EXPAND-ARGUMENT ( par . pat . char -- par . pat . ) DUP [CHAR] 0 = IF \ Case 0. DROP TEMP @ (.) PAYOUT COPY-PARAMETER ( par . pat . ) ELSE \ Case {1...9}. [CHAR] 0 - ( par . pat . n) >R 2OVER R> ( par . pat . par . n) ARG ( par . pat . str len) PAYOUT COPY-PARAMETER ( par . pat . ) THEN ; 0 [IF] ------------------------------------------------------- Blockette 6 EXPAND-PARAMETERS ( par . pat . -- par . pat . ) Gets the expansion of a character in the pattern. Used in EXPAND-PATTERN. ?MEMORY ( x -- ) Is a check for memory allocation. EXPAND-PATTERN ( par . pat . -- pay . ) Expands the pattern string with words from the parameters string. Value word PAYOUT is used as the address for output. EXPAND-PATTERN takes the pattern one character at a time and copies it or a word from the parameters. EXPAT is short for EXPAND-PATTERN. ------------------------------------------------------- [THEN] : EXPAND-PARAMETERS ( par . pat . -- par . pat . ) C@/STRING ( par . pat . char) DUP [CHAR] 0 - 10 U< IF \ Case {0...9} EXPAND-ARGUMENT EXIT THEN PAYOUT APPEND-CHAR ; : ?MEMORY ABORT" Memory Error " ; : EXPAND-PATTERN ( par . pat . -- pay . ) PAYOUT 0= ?MEMORY 0 PAYOUT C! BEGIN DUP 0> WHILE C@/STRING ( par . pat . char) DUP #PARAM-CHAR = IF DROP EXPAND-PARAMETERS ELSE PAYOUT APPEND-CHAR THEN ( par . pat .) REPEAT 2DROP 2DROP ( ) PAYOUT COUNT ( pay . ) ; : EXPAT EXPAND-PATTERN ; 0 [IF] -------------------------------------------------------- Machinations with PATTERN and PAYOUT are so EXPAND-PATTERN can be nested in functions that call EXPAND-PATTERN. THE-PATTERN ( -- addr ) Is the initial holder for a pattern. PAYOUT-INIT ( -- ) Does `THE-PAYOUT TO PAYOUT`. PATTERN-INIT ( -- ) Does `THE-PATTERN TO PATTERN`. NEW-PAYOUT ( -- ) Allocates memory to PAYOUT. OLD-PAYOUT Frees memory from PAYOUT. [PAYOUT ( -- ) Saves PAYOUT on the rack and allocates new memory. PAYOUT] ( -- ) Frees PAYOUT and restores old setting. [PAYOUT ... PAYOUT] should be balanced. -------------------------------------------------------- [THEN] 0 VALUE PATTERN CREATE THE-PATTERN 128 CHARS ALLOT : PAYOUT-INIT THE-PAYOUT TO PAYOUT ; : PATTERN-INIT THE-PATTERN TO PATTERN ; \ If you don't have [DEFINED] then wipe the following out. [DEFINED] MACVOCAB [IF] \ Needed in PowerMacForth. ' PAYOUT-INIT RESTORER LINKTOKEN ' PATTERN-INIT RESTORER LINKTOKEN [THEN] PAYOUT-INIT PATTERN-INIT : NEW-PAYOUT 256 ALLOCATE ?MEMORY TO PAYOUT ; : OLD-PAYOUT PAYOUT FREE ?MEMORY ; MACRO [PAYOUT " PAYOUT >R NEW-PAYOUT " MACRO PAYOUT] " OLD-PAYOUT R> TO PAYOUT " 0 [IF] -------------------------------------------------------- Blockette 7 PATTERN will hold the pattern for the expansion. PARAMETERS will hold the arguments to merge with PATTERN. GET-PARAMETERS gets parameters from input source. PROVIDE-PARAMETERS does house-keeping for payout and pattern, gets parameters, expands and evaluates them. -------------------------------------------------------- [THEN] 0 VALUE PARAMETERS VARIABLE WHOLE-LINE : NEXT-LINE ( -- str len ) BEGIN #EOL-CHAR PARSE DUP 0= WHILE 2DROP REPEAT ; : GET-PARAMETERS ( -- str len ) WHOLE-LINE @ IF NEXT-LINE BL-SKIP ELSE NEXT-WORD THEN ; : PROVIDE-PARAMETERS ( pat . -- ) [PAYOUT PARAMETERS >R BEGIN GET-PARAMETERS DUP WHILE S" $)" STARTS? NOT WHILE DUP 1+ ALLOCATE ?MEMORY TO PARAMETERS PARAMETERS PLACE ( ) PARAMETERS COUNT 2OVER EXPAND-PATTERN ( tem . pat .) 2SWAP 2>R EVALUATE 2R> ( tem .) PARAMETERS FREE ?MEMORY REPEAT THEN 2DROP 2DROP ( ) R> TO PARAMETERS PAYOUT] ; : ($ \ ($ pattern | argument ... $) \ ($ | pattern | line ... $) [CHAR] | PARSE ( pat .) DUP 0= DUP WHOLE-LINE ! IF 2DROP [CHAR] | PARSE 1 /STRING THEN PATTERN >R DUP 1+ ALLOCATE ?MEMORY TO PATTERN PATTERN PLACE ( ) PATTERN COUNT PROVIDE-PARAMETERS ( ) PATTERN FREE ?MEMORY R> TO PATTERN ; IMMEDIATE ( -- Wil Baden Costa Mesa, California WilBaden@Netcom.com )