Pattern Expansion
Wil Baden
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<return> ... $)
($ "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 <char> ccc<char>" -- )
: 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 ;
[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 WilB...@Netcom.com
)
Wil Baden
Missing 0 before [IF} in blockette 6.
--
Wil