Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]
Groups > comp.lang.forth > #42528 > unrolled thread
| Started by | humptydumpty <ouatubi@gmail.com> |
|---|---|
| First post | 2015-10-09 13:21 -0700 |
| Last post | 2015-10-19 03:23 -0700 |
| Articles | 8 — 5 participants |
Back to article view | Back to comp.lang.forth
Text Expansion Macros humptydumpty <ouatubi@gmail.com> - 2015-10-09 13:21 -0700
Re: Text Expansion Macros "WJ" <w_a_x_man@yahoo.com> - 2015-10-09 21:59 +0000
Re: Text Expansion Macros "HAA" <someone@microsoft.com> - 2015-10-16 16:11 +1000
Re: Text Expansion Macros Mark Wills <markwills1970@gmail.com> - 2015-10-16 04:26 -0700
Re: Text Expansion Macros Coos Haak <chforth@hccnet.nl> - 2015-10-10 00:19 +0200
Re: Text Expansion Macros humptydumpty <ouatubi@gmail.com> - 2015-10-09 21:11 -0700
Re: Text Expansion Macros humptydumpty <ouatubi@gmail.com> - 2015-10-16 10:18 -0700
Re: Text Expansion Macros humptydumpty <ouatubi@gmail.com> - 2015-10-19 03:23 -0700
| From | humptydumpty <ouatubi@gmail.com> |
|---|---|
| Date | 2015-10-09 13:21 -0700 |
| Subject | Text Expansion Macros |
| Message-ID | <6ea00a35-e9c1-4c17-96f5-888d1835b59f@googlegroups.com> |
Hi everyone!
Here is a usable TEM source+some-tests. Gforth tested:
-----
\ Text expansion macros. Using static buffers
\ -- Helper words
: ]S ( ctime: ca u -- ;rtime -- ca2 u )
] postpone sliteral
; immediate
\ --
: left ( cas us cad ud -- cas cad umin[us,ud] )
rot umin
;
\ -- Dynamic variable support
: >{ ]] dup @ 2>R [[ ; IMMEDIATE
: } ]] R> R> ! [[ ; IMMEDIATE
\ -- String manipulations words
: split-at-address ( ca u a -- a u-len ca len ; len = a-ca split WORD at ADDRESS to REST and QUOTIENT )
SWAP >R \ ca a
OVER - 2DUP \ ca len ca len
R> SWAP \ ca len ca u len
/STRING 2SWAP
;
: -heading ( ca u -- ca' u' )
BEGIN DUP 0> WHILE OVER C@ BL = WHILE 1 /STRING REPEAT THEN
;
: split-at-space ( ca u -- ra ru qa qu ; split WORD at space to REST and QUOTIENT )
2DUP BL scan drop \ ca u a
split-at-address
;
: string!+ ( cas us cad ud -- cad+len ud-len )
2DUP 2>R left DUP >R MOVE
R> 2R> ROT /STRING
;
\ -- Expansion words
VOCABULARY EXPANDABLE
VARIABLE -Expanded?
: (expand) ( ca' u' ca u ;DESTINATION$ SOURCE$ )
BEGIN
dup
WHILE ( q=query, r=rest, x=result )
over swap ( ca' u' ca ca u )
-heading split-at-space 2swap 2>R ( ca' u' ca ca.q u.q R: ca.r u.r )
2>R 2R@ drop over - R@ + 2R> ( ca' u' ca u" ca.q u.q R: ca.r u.r )
[ ALSO EXPANDABLE Context @ PREVIOUS ]L search-wordlist
IF
nip nip EXECUTE
-Expanded? OFF
THEN ( ca' u' ca.x u.x R: ca.r u.r )
2swap string!+
2R>
REPEAT
;
HERE 1024 32 * DUP ALLOT 2CONSTANT SRC$ \ Static buffers
HERE 1024 32 * DUP ALLOT 2CONSTANT DST$
: expand ( ca u -- ca' u' )
BEGIN
-Expanded? ON
DST$ 2swap (expand) 2drop
drop DST$ drop tuck -
>R R@ SRC$ left move SRC$ drop R>
-Expanded? @
UNTIL
>R R@ DST$ left move DST$ drop R>
;
\ --- Text expansion macros
: emacro<
Current >{
ALSO EXPANDABLE DEFINITIONS
' CATCH
} PREVIOUS THROW
;
: ]E
] expand evaluate
; IMMEDIATE
emacro< : ~ 2swap ;
\ --- Testing :)
1 [IF]
emacro< : ?? S" ( f -- ) IF ~ THEN" ; \ borrowed from Wil Baden
emacro< : ?choose [ S" SWAP" S" ( a b f -- b|a ) ?? drop" expand ]S ;
emacro< : choose S" ( a b -- m ) 2DUP ~ ?choose" ;
: maximum
[ S" <" S" choose" ]E
;
: minimum
[ S" >" S" choose" ]E
;
: umaximum
[ S" U<" S" choose" ]E
;
: uminimum
[ S" U>" S" choose" ]E
;
1 -1 maximum . .s -1 1 maximum . .s cr
1 -1 minimum . .s -1 1 minimum . .s cr
1 -1 umaximum u. .s -1 1 umaximum u. .s cr
1 -1 uminimum u. .s -1 1 uminimum u. .s cr
see maximum
see minimum
see umaximum
see uminimum
[THEN]
-----
Happy using & have a nice day,
humptydumpty
[toc] | [next] | [standalone]
| From | "WJ" <w_a_x_man@yahoo.com> |
|---|---|
| Date | 2015-10-09 21:59 +0000 |
| Message-ID | <mv9dbr$b2e$1@dont-email.me> |
| In reply to | #42528 |
humptydumpty wrote:
> : split-at-address ( ca u a -- a u-len ca len ;
> len = a-ca split WORD at ADDRESS to REST and QUOTIENT )
> SWAP >R \ ca a
> OVER - 2DUP \ ca len ca len
> R> SWAP \ ca len ca u len
> /STRING 2SWAP
> ;
Look at all of the stack comments the wretch had to use, because
his Masters taught him that local variables are wicked!
Anyone who would pay a penny for code like that is an idiot.
> : -heading ( ca u -- ca' u' )
> BEGIN DUP 0> WHILE OVER C@ BL = WHILE 1 /STRING REPEAT THEN
> ;
Instead of substandard Forth, let's use standard Forth.
Oforth:
>" word " strip .
word ok
> : split-at-space ( ca u -- ra ru qa qu ;
> split WORD at space to REST and QUOTIENT )
> 2DUP BL scan drop \ ca u a
> split-at-address
> ;
Let's test that.
s" foo bar " split-at-space ok
type ok
type foo bar ok
Now, in standard Forth (Oforth):
>" able was I ere " words .
[able, was, I, ere] ok
> : maximum
> [ S" <" S" choose" ]E
> ;
> : minimum
> [ S" >" S" choose" ]E
> ;
> : umaximum
> [ S" U<" S" choose" ]E
> ;
> : uminimum
> [ S" U>" S" choose" ]E
> ;
> 1 -1 maximum . .s -1 1 maximum . .s cr
> 1 -1 minimum . .s -1 1 minimum . .s cr
Instead of substandard Forth, let's use standard Forth.
Oforth:
: maximum { maxFor( #yourself ) }
>[3, 0, 5, 888, 7, 9] maximum .
888 ok
--
The report card by the American Society of Civil Engineers showed the national
infrastructure a single grade above failure, a step from declining to the point
where everyday things simply stop working the way people expect them to. ---
washingtonpost.com/local/trafficandcommuting/us-infrastructure-gets-d-in-annual-report/2013/03/19/c48cb010-900b-11e2-9cfd-36d6c9b5d7ad_story.html
[toc] | [prev] | [next] | [standalone]
| From | "HAA" <someone@microsoft.com> |
|---|---|
| Date | 2015-10-16 16:11 +1000 |
| Message-ID | <mvq0us$t2q$1@speranza.aioe.org> |
| In reply to | #42534 |
WJ wrote: > humptydumpty wrote: > > > : split-at-address ( ca u a -- a u-len ca len ; > > len = a-ca split WORD at ADDRESS to REST and QUOTIENT ) > > SWAP >R \ ca a > > OVER - 2DUP \ ca len ca len > > R> SWAP \ ca len ca u len > > /STRING 2SWAP > > ; > > > Look at all of the stack comments the wretch had to use, because > his Masters taught him that local variables are wicked! A comment is less costly than locals. > Anyone who would pay a penny for code like that is an idiot. I would compare the code generated. The shortest/fastest gets my penny.
[toc] | [prev] | [next] | [standalone]
| From | Mark Wills <markwills1970@gmail.com> |
|---|---|
| Date | 2015-10-16 04:26 -0700 |
| Message-ID | <5d713385-8bc2-49ad-9c92-3cbab0f62b33@googlegroups.com> |
| In reply to | #42647 |
On Friday, 16 October 2015 06:12:00 UTC+1, HAA wrote: > I would compare the code generated. The shortest/fastest gets > my penny. +1
[toc] | [prev] | [next] | [standalone]
| From | Coos Haak <chforth@hccnet.nl> |
|---|---|
| Date | 2015-10-10 00:19 +0200 |
| Message-ID | <v2ucha1acgv3$.2ri6pjj9vb45.dlg@40tude.net> |
| In reply to | #42528 |
Op Fri, 9 Oct 2015 13:21:52 -0700 (PDT) schreef humptydumpty:
> Hi everyone!
>
> Here is a usable TEM source+some-tests. Gforth tested:
>
> -----
> \ Text expansion macros. Using static buffers
>
> \ -- Helper words
>: ]S ( ctime: ca u -- ;rtime -- ca2 u )
> ] postpone sliteral
> ; immediate
> \ --
>: left ( cas us cad ud -- cas cad umin[us,ud] )
> rot umin
> ;
>
> \ -- Dynamic variable support
>:>{ ]] dup @ 2>R [[ ; IMMEDIATE
>: } ]] R> R> ! [[ ; IMMEDIATE
>
> \ -- String manipulations words
>: split-at-address ( ca u a -- a u-len ca len ; len = a-ca split WORD at ADDRESS to REST and QUOTIENT )
> SWAP >R \ ca a
> OVER - 2DUP \ ca len ca len
> R> SWAP \ ca len ca u len
> /STRING 2SWAP
> ;
>: -heading ( ca u -- ca' u' )
> BEGIN DUP 0> WHILE OVER C@ BL = WHILE 1 /STRING REPEAT THEN
> ;
>: split-at-space ( ca u -- ra ru qa qu ; split WORD at space to REST and QUOTIENT )
> 2DUP BL scan drop \ ca u a
> split-at-address
> ;
>: string!+ ( cas us cad ud -- cad+len ud-len )
> 2DUP 2>R left DUP >R MOVE
> R> 2R> ROT /STRING
> ;
>
> \ -- Expansion words
> VOCABULARY EXPANDABLE
>
> VARIABLE -Expanded?
>: (expand) ( ca' u' ca u ;DESTINATION$ SOURCE$ )
> BEGIN
> dup
> WHILE ( q=query, r=rest, x=result )
> over swap ( ca' u' ca ca u )
> -heading split-at-space 2swap 2>R ( ca' u' ca ca.q u.q R: ca.r u.r )
> 2>R 2R@ drop over - R@ + 2R> ( ca' u' ca u" ca.q u.q R: ca.r u.r )
> [ ALSO EXPANDABLE Context @ PREVIOUS ]L search-wordlist
> IF
> nip nip EXECUTE
> -Expanded? OFF
> THEN ( ca' u' ca.x u.x R: ca.r u.r )
> 2swap string!+
> 2R>
> REPEAT
> ;
> HERE 1024 32 * DUP ALLOT 2CONSTANT SRC$ \ Static buffers
> HERE 1024 32 * DUP ALLOT 2CONSTANT DST$
>: expand ( ca u -- ca' u' )
> BEGIN
> -Expanded? ON
> DST$ 2swap (expand) 2drop
> drop DST$ drop tuck -
> >R R@ SRC$ left move SRC$ drop R>
> -Expanded? @
> UNTIL
> >R R@ DST$ left move DST$ drop R>
> ;
>
> \ --- Text expansion macros
>: emacro<
> Current >{
> ALSO EXPANDABLE DEFINITIONS
> ' CATCH
> } PREVIOUS THROW
> ;
>: ]E
> ] expand evaluate
> ; IMMEDIATE
>
> emacro< : ~ 2swap ;
>
> \ --- Testing :)
> 1 [IF]
> emacro< : ?? S" ( f -- ) IF ~ THEN" ; \ borrowed from Wil Baden
> emacro< : ?choose [ S" SWAP" S" ( a b f -- b|a ) ?? drop" expand ]S ;
> emacro< : choose S" ( a b -- m ) 2DUP ~ ?choose" ;
>
>: maximum
> [ S" <" S" choose" ]E
> ;
>: minimum
> [ S" >" S" choose" ]E
> ;
>: umaximum
> [ S" U<" S" choose" ]E
> ;
>: uminimum
> [ S" U>" S" choose" ]E
> ;
> 1 -1 maximum . .s -1 1 maximum . .s cr
> 1 -1 minimum . .s -1 1 minimum . .s cr
> 1 -1 umaximum u. .s -1 1 umaximum u. .s cr
> 1 -1 uminimum u. .s -1 1 uminimum u. .s cr
> see maximum
> see minimum
> see umaximum
> see uminimum
> [THEN]
> -----
>
> Happy using & have a nice day,
> humptydumpty
You forgot to define ]L
: ]L ] postpone literal ; immediate
Current misses in the standard, simply rewrite (in emacro<)
'current >{' as 'get-current >r'
and '}' as 'r> set-current'
Defining two buffers of 32 Kb on a 16 bits system ?
1 Kb buffers is enough in your example.
Critique aside, the program works!
groet Coos
[toc] | [prev] | [next] | [standalone]
| From | humptydumpty <ouatubi@gmail.com> |
|---|---|
| Date | 2015-10-09 21:11 -0700 |
| Message-ID | <d512546b-9c7e-4ee0-ac8b-e47e48a332b1@googlegroups.com> |
| In reply to | #42535 |
On Saturday, October 10, 2015 at 1:19:23 AM UTC+3, Coos Haak wrote:
> Op Fri, 9 Oct 2015 13:21:52 -0700 (PDT) schreef humptydumpty:
>
> > Hi everyone!
> >
> > Here is a usable TEM source+some-tests. Gforth tested:
> >
> > -----
> > \ Text expansion macros. Using static buffers
> >
> > \ -- Helper words
> >: ]S ( ctime: ca u -- ;rtime -- ca2 u )
> > ] postpone sliteral
> > ; immediate
> > \ --
> >: left ( cas us cad ud -- cas cad umin[us,ud] )
> > rot umin
> > ;
> >
> > \ -- Dynamic variable support
> >:>{ ]] dup @ 2>R [[ ; IMMEDIATE
> >: } ]] R> R> ! [[ ; IMMEDIATE
> >
> > \ -- String manipulations words
> >: split-at-address ( ca u a -- a u-len ca len ; len = a-ca split WORD at ADDRESS to REST and QUOTIENT )
> > SWAP >R \ ca a
> > OVER - 2DUP \ ca len ca len
> > R> SWAP \ ca len ca u len
> > /STRING 2SWAP
> > ;
> >: -heading ( ca u -- ca' u' )
> > BEGIN DUP 0> WHILE OVER C@ BL = WHILE 1 /STRING REPEAT THEN
> > ;
> >: split-at-space ( ca u -- ra ru qa qu ; split WORD at space to REST and QUOTIENT )
> > 2DUP BL scan drop \ ca u a
> > split-at-address
> > ;
> >: string!+ ( cas us cad ud -- cad+len ud-len )
> > 2DUP 2>R left DUP >R MOVE
> > R> 2R> ROT /STRING
> > ;
> >
> > \ -- Expansion words
> > VOCABULARY EXPANDABLE
> >
> > VARIABLE -Expanded?
> >: (expand) ( ca' u' ca u ;DESTINATION$ SOURCE$ )
> > BEGIN
> > dup
> > WHILE ( q=query, r=rest, x=result )
> > over swap ( ca' u' ca ca u )
> > -heading split-at-space 2swap 2>R ( ca' u' ca ca.q u.q R: ca.r u.r )
> > 2>R 2R@ drop over - R@ + 2R> ( ca' u' ca u" ca.q u.q R: ca.r u.r )
> > [ ALSO EXPANDABLE Context @ PREVIOUS ]L search-wordlist
> > IF
> > nip nip EXECUTE
> > -Expanded? OFF
> > THEN ( ca' u' ca.x u.x R: ca.r u.r )
> > 2swap string!+
> > 2R>
> > REPEAT
> > ;
> > HERE 1024 32 * DUP ALLOT 2CONSTANT SRC$ \ Static buffers
> > HERE 1024 32 * DUP ALLOT 2CONSTANT DST$
> >: expand ( ca u -- ca' u' )
> > BEGIN
> > -Expanded? ON
> > DST$ 2swap (expand) 2drop
> > drop DST$ drop tuck -
> > >R R@ SRC$ left move SRC$ drop R>
> > -Expanded? @
> > UNTIL
> > >R R@ DST$ left move DST$ drop R>
> > ;
> >
> > \ --- Text expansion macros
> >: emacro<
> > Current >{
> > ALSO EXPANDABLE DEFINITIONS
> > ' CATCH
> > } PREVIOUS THROW
> > ;
> >: ]E
> > ] expand evaluate
> > ; IMMEDIATE
> >
> > emacro< : ~ 2swap ;
> >
> > \ --- Testing :)
> > 1 [IF]
> > emacro< : ?? S" ( f -- ) IF ~ THEN" ; \ borrowed from Wil Baden
> > emacro< : ?choose [ S" SWAP" S" ( a b f -- b|a ) ?? drop" expand ]S ;
> > emacro< : choose S" ( a b -- m ) 2DUP ~ ?choose" ;
> >
> >: maximum
> > [ S" <" S" choose" ]E
> > ;
> >: minimum
> > [ S" >" S" choose" ]E
> > ;
> >: umaximum
> > [ S" U<" S" choose" ]E
> > ;
> >: uminimum
> > [ S" U>" S" choose" ]E
> > ;
> > 1 -1 maximum . .s -1 1 maximum . .s cr
> > 1 -1 minimum . .s -1 1 minimum . .s cr
> > 1 -1 umaximum u. .s -1 1 umaximum u. .s cr
> > 1 -1 uminimum u. .s -1 1 uminimum u. .s cr
> > see maximum
> > see minimum
> > see umaximum
> > see uminimum
> > [THEN]
> > -----
> >
> > Happy using & have a nice day,
> > humptydumpty
>
> You forgot to define ]L
> : ]L ] postpone literal ; immediate
>
> Current misses in the standard, simply rewrite (in emacro<)
> 'current >{' as 'get-current >r'
> and '}' as 'r> set-current'
>
> Defining two buffers of 32 Kb on a 16 bits system ?
> 1 Kb buffers is enough in your example.
>
> Critique aside, the program works!
>
> groet Coos
Hi! Thank you for reply!
That source was captured from various files to make one source
,so there are some things that escaped my review before post.
About static buffers, initially they was 1k, then their capacity
was raised to 'infinity' :-)
Have a nice day,
humptydumpty
[toc] | [prev] | [next] | [standalone]
| From | humptydumpty <ouatubi@gmail.com> |
|---|---|
| Date | 2015-10-16 10:18 -0700 |
| Message-ID | <bc87dc56-d5f9-4caf-9d66-3bb2239da215@googlegroups.com> |
| In reply to | #42528 |
On Friday, October 9, 2015 at 11:21:55 PM UTC+3, humptydumpty wrote:
> Hi everyone!
>
> Here is a usable TEM source+some-tests. Gforth tested:
>
> -----
> \ Text expansion macros. Using static buffers
>
> \ -- Helper words
> : ]S ( ctime: ca u -- ;rtime -- ca2 u )
> ] postpone sliteral
> ; immediate
> \ --
> : left ( cas us cad ud -- cas cad umin[us,ud] )
> rot umin
> ;
>
> \ -- Dynamic variable support
> : >{ ]] dup @ 2>R [[ ; IMMEDIATE
> : } ]] R> R> ! [[ ; IMMEDIATE
>
> \ -- String manipulations words
> : split-at-address ( ca u a -- a u-len ca len ; len = a-ca split WORD at ADDRESS to REST and QUOTIENT )
> SWAP >R \ ca a
> OVER - 2DUP \ ca len ca len
> R> SWAP \ ca len ca u len
> /STRING 2SWAP
> ;
> : -heading ( ca u -- ca' u' )
> BEGIN DUP 0> WHILE OVER C@ BL = WHILE 1 /STRING REPEAT THEN
> ;
> : split-at-space ( ca u -- ra ru qa qu ; split WORD at space to REST and QUOTIENT )
> 2DUP BL scan drop \ ca u a
> split-at-address
> ;
> : string!+ ( cas us cad ud -- cad+len ud-len )
> 2DUP 2>R left DUP >R MOVE
> R> 2R> ROT /STRING
> ;
>
> \ -- Expansion words
> VOCABULARY EXPANDABLE
>
> VARIABLE -Expanded?
> : (expand) ( ca' u' ca u ;DESTINATION$ SOURCE$ )
> BEGIN
> dup
> WHILE ( q=query, r=rest, x=result )
> over swap ( ca' u' ca ca u )
> -heading split-at-space 2swap 2>R ( ca' u' ca ca.q u.q R: ca.r u.r )
> 2>R 2R@ drop over - R@ + 2R> ( ca' u' ca u" ca.q u.q R: ca.r u.r )
> [ ALSO EXPANDABLE Context @ PREVIOUS ]L search-wordlist
> IF
> nip nip EXECUTE
> -Expanded? OFF
> THEN ( ca' u' ca.x u.x R: ca.r u.r )
> 2swap string!+
> 2R>
> REPEAT
> ;
> HERE 1024 32 * DUP ALLOT 2CONSTANT SRC$ \ Static buffers
> HERE 1024 32 * DUP ALLOT 2CONSTANT DST$
> : expand ( ca u -- ca' u' )
> BEGIN
> -Expanded? ON
> DST$ 2swap (expand) 2drop
> drop DST$ drop tuck -
> >R R@ SRC$ left move SRC$ drop R>
> -Expanded? @
> UNTIL
> >R R@ DST$ left move DST$ drop R>
> ;
>
> \ --- Text expansion macros
> : emacro<
> Current >{
> ALSO EXPANDABLE DEFINITIONS
> ' CATCH
> } PREVIOUS THROW
> ;
> : ]E
> ] expand evaluate
> ; IMMEDIATE
>
> emacro< : ~ 2swap ;
>
> \ --- Testing :)
> 1 [IF]
> emacro< : ?? S" ( f -- ) IF ~ THEN" ; \ borrowed from Wil Baden
> emacro< : ?choose [ S" SWAP" S" ( a b f -- b|a ) ?? drop" expand ]S ;
> emacro< : choose S" ( a b -- m ) 2DUP ~ ?choose" ;
>
> : maximum
> [ S" <" S" choose" ]E
> ;
> : minimum
> [ S" >" S" choose" ]E
> ;
> : umaximum
> [ S" U<" S" choose" ]E
> ;
> : uminimum
> [ S" U>" S" choose" ]E
> ;
> 1 -1 maximum . .s -1 1 maximum . .s cr
> 1 -1 minimum . .s -1 1 minimum . .s cr
> 1 -1 umaximum u. .s -1 1 umaximum u. .s cr
> 1 -1 uminimum u. .s -1 1 uminimum u. .s cr
> see maximum
> see minimum
> see umaximum
> see uminimum
> [THEN]
> -----
>
> Happy using & have a nice day,
> humptydumpty
Hi all!
Here a polished (robust I think) version:
---
\ Text Expansion Macros. Single expansion buffer.
VOCABULARY EXPANDABLE
1024 CONSTANT EB#
CREATE Eb EB# allot
: blanks-eb ( -- ) Eb EB# BL fill ;
\ --- cad = past destination buffer address
\ --- cas = start source buffer address
: eb! ( ca u -- cad )
>R R@ EB# >= ABORT" Expansion buffer overflow."
Eb EB# R@ min move
R> Eb +
;
: char^v ( ca1 ca2 -- ;char exchange )
over c@ over c@ swap rot c! swap c!
;
: copy-back ( cad -- cas )
[ Eb EB# + ] LITERAL
swap
Eb 2dup >
IF ( cas hilimit start )
swap 1-
DO ( cad )
1-
I over char^v
-1 +LOOP
ELSE
2drop
THEN
;
: word-end? ( cas -- f )
dup c@ BL <>
IF ( cas )
1+ dup c@ BL = ( cas f1 )
swap [ Eb EB# + ] LITERAL = ( f1 f2 )
OR
IF -1 EXIT THEN
ELSE drop
THEN 0
;
: scan-back ( ca -- ca' )
BEGIN dup Eb >= WHILE dup c@ BL <> WHILE 1- REPEAT THEN
;
: last-word ( cax -- ca u ;cax+1=ca+u=cad )
dup scan-back 1+ tuck - 1+
;
VARIABLE -Expanded?
: copy ( cas -- cad )
Eb swap ( cax cas )
[ Eb EB# + ] LITERAL swap
?DO ( cax )
I word-end? ( cax f )
over I char^v ( cax )
IF ( cax )
last-word 2dup ( ca u ca u )
[ ALSO EXPANDABLE Context @ PREVIOUS ] LITERAL search-wordlist
IF ( ca u xt )
>R over swap BL fill
R> execute ( ca ca' u' )
rot swap ( ca' ca u' )
2dup + I > ABORT" Expansion buffer overflow."
2>R 2R@ move 2R> ( ca u' )
-Expanded? OFF
THEN
+
ELSE
1+
THEN
LOOP
;
: expand ( ca u -- ca' u' )
dup 0= IF EXIT THEN
blanks-eb eb!
BEGIN -Expanded? ON copy-back copy -Expanded? @ UNTIL
Eb tuck -
;
: emacro<
get-current >R
ALSO EXPANDABLE DEFINITIONS
' CATCH
R> set-current PREVIOUS THROW
;
: ]L
] POSTPONE LITERAL
; IMMEDIATE
: ]S
] POSTPONE SLITERAL
; IMMEDIATE
: ]E
] expand evaluate
; IMMEDIATE
emacro< : ~ -rot ;
emacro< : ?? S" IF ~ THEN" ;
emacro< : ?choose [ s" SWAP" s" ?? drop" expand ]S ;
emacro< : choose S" 2dup ~ ?choose" ;
1 [IF]
: umaximum
[ S" u<" S" choose" ]E
;
: uminimum
[ S" u>" S" choose" ]E
;
1 -1 umaximum u. .s -1 1 umaximum u. .s cr
1 -1 uminimum u. .s -1 1 uminimum u. .s cr
see umaximum
see uminimum
[THEN]
---
I think that is a safe way for evaluate macros,
as compiling is done at point of delivery.
Happy forthing & have a nice day,
humptydumpty
[toc] | [prev] | [next] | [standalone]
| From | humptydumpty <ouatubi@gmail.com> |
|---|---|
| Date | 2015-10-19 03:23 -0700 |
| Message-ID | <45c51952-5101-4321-96ec-7e7a75d28c03@googlegroups.com> |
| In reply to | #42659 |
On Friday, October 16, 2015 at 8:18:17 PM UTC+3, humptydumpty wrote:
> On Friday, October 9, 2015 at 11:21:55 PM UTC+3, humptydumpty wrote:
> > Hi everyone!
> >
> > Here is a usable TEM source+some-tests. Gforth tested:
> >
> > -----
> > \ Text expansion macros. Using static buffers
> >
> > \ -- Helper words
> > : ]S ( ctime: ca u -- ;rtime -- ca2 u )
> > ] postpone sliteral
> > ; immediate
> > \ --
> > : left ( cas us cad ud -- cas cad umin[us,ud] )
> > rot umin
> > ;
> >
> > \ -- Dynamic variable support
> > : >{ ]] dup @ 2>R [[ ; IMMEDIATE
> > : } ]] R> R> ! [[ ; IMMEDIATE
> >
> > \ -- String manipulations words
> > : split-at-address ( ca u a -- a u-len ca len ; len = a-ca split WORD at ADDRESS to REST and QUOTIENT )
> > SWAP >R \ ca a
> > OVER - 2DUP \ ca len ca len
> > R> SWAP \ ca len ca u len
> > /STRING 2SWAP
> > ;
> > : -heading ( ca u -- ca' u' )
> > BEGIN DUP 0> WHILE OVER C@ BL = WHILE 1 /STRING REPEAT THEN
> > ;
> > : split-at-space ( ca u -- ra ru qa qu ; split WORD at space to REST and QUOTIENT )
> > 2DUP BL scan drop \ ca u a
> > split-at-address
> > ;
> > : string!+ ( cas us cad ud -- cad+len ud-len )
> > 2DUP 2>R left DUP >R MOVE
> > R> 2R> ROT /STRING
> > ;
> >
> > \ -- Expansion words
> > VOCABULARY EXPANDABLE
> >
> > VARIABLE -Expanded?
> > : (expand) ( ca' u' ca u ;DESTINATION$ SOURCE$ )
> > BEGIN
> > dup
> > WHILE ( q=query, r=rest, x=result )
> > over swap ( ca' u' ca ca u )
> > -heading split-at-space 2swap 2>R ( ca' u' ca ca.q u.q R: ca.r u.r )
> > 2>R 2R@ drop over - R@ + 2R> ( ca' u' ca u" ca.q u.q R: ca.r u.r )
> > [ ALSO EXPANDABLE Context @ PREVIOUS ]L search-wordlist
> > IF
> > nip nip EXECUTE
> > -Expanded? OFF
> > THEN ( ca' u' ca.x u.x R: ca.r u.r )
> > 2swap string!+
> > 2R>
> > REPEAT
> > ;
> > HERE 1024 32 * DUP ALLOT 2CONSTANT SRC$ \ Static buffers
> > HERE 1024 32 * DUP ALLOT 2CONSTANT DST$
> > : expand ( ca u -- ca' u' )
> > BEGIN
> > -Expanded? ON
> > DST$ 2swap (expand) 2drop
> > drop DST$ drop tuck -
> > >R R@ SRC$ left move SRC$ drop R>
> > -Expanded? @
> > UNTIL
> > >R R@ DST$ left move DST$ drop R>
> > ;
> >
> > \ --- Text expansion macros
> > : emacro<
> > Current >{
> > ALSO EXPANDABLE DEFINITIONS
> > ' CATCH
> > } PREVIOUS THROW
> > ;
> > : ]E
> > ] expand evaluate
> > ; IMMEDIATE
> >
> > emacro< : ~ 2swap ;
> >
> > \ --- Testing :)
> > 1 [IF]
> > emacro< : ?? S" ( f -- ) IF ~ THEN" ; \ borrowed from Wil Baden
> > emacro< : ?choose [ S" SWAP" S" ( a b f -- b|a ) ?? drop" expand ]S ;
> > emacro< : choose S" ( a b -- m ) 2DUP ~ ?choose" ;
> >
> > : maximum
> > [ S" <" S" choose" ]E
> > ;
> > : minimum
> > [ S" >" S" choose" ]E
> > ;
> > : umaximum
> > [ S" U<" S" choose" ]E
> > ;
> > : uminimum
> > [ S" U>" S" choose" ]E
> > ;
> > 1 -1 maximum . .s -1 1 maximum . .s cr
> > 1 -1 minimum . .s -1 1 minimum . .s cr
> > 1 -1 umaximum u. .s -1 1 umaximum u. .s cr
> > 1 -1 uminimum u. .s -1 1 uminimum u. .s cr
> > see maximum
> > see minimum
> > see umaximum
> > see uminimum
> > [THEN]
> > -----
> >
> > Happy using & have a nice day,
> > humptydumpty
>
>
> Hi all!
> Here a polished (robust I think) version:
>
> ---
> \ Text Expansion Macros. Single expansion buffer.
>
> VOCABULARY EXPANDABLE
>
> 1024 CONSTANT EB#
> CREATE Eb EB# allot
>
> : blanks-eb ( -- ) Eb EB# BL fill ;
> \ --- cad = past destination buffer address
> \ --- cas = start source buffer address
> : eb! ( ca u -- cad )
> >R R@ EB# >= ABORT" Expansion buffer overflow."
> Eb EB# R@ min move
> R> Eb +
> ;
> : char^v ( ca1 ca2 -- ;char exchange )
> over c@ over c@ swap rot c! swap c!
> ;
> : copy-back ( cad -- cas )
> [ Eb EB# + ] LITERAL
> swap
> Eb 2dup >
> IF ( cas hilimit start )
> swap 1-
> DO ( cad )
> 1-
> I over char^v
> -1 +LOOP
> ELSE
> 2drop
> THEN
> ;
> : word-end? ( cas -- f )
> dup c@ BL <>
> IF ( cas )
> 1+ dup c@ BL = ( cas f1 )
> swap [ Eb EB# + ] LITERAL = ( f1 f2 )
> OR
> IF -1 EXIT THEN
> ELSE drop
> THEN 0
> ;
> : scan-back ( ca -- ca' )
> BEGIN dup Eb >= WHILE dup c@ BL <> WHILE 1- REPEAT THEN
> ;
> : last-word ( cax -- ca u ;cax+1=ca+u=cad )
> dup scan-back 1+ tuck - 1+
> ;
> VARIABLE -Expanded?
> : copy ( cas -- cad )
> Eb swap ( cax cas )
> [ Eb EB# + ] LITERAL swap
> ?DO ( cax )
> I word-end? ( cax f )
> over I char^v ( cax )
> IF ( cax )
> last-word 2dup ( ca u ca u )
> [ ALSO EXPANDABLE Context @ PREVIOUS ] LITERAL search-wordlist
> IF ( ca u xt )
> >R over swap BL fill
> R> execute ( ca ca' u' )
> rot swap ( ca' ca u' )
> 2dup + I > ABORT" Expansion buffer overflow."
> 2>R 2R@ move 2R> ( ca u' )
> -Expanded? OFF
> THEN
> +
> ELSE
> 1+
> THEN
> LOOP
> ;
> : expand ( ca u -- ca' u' )
> dup 0= IF EXIT THEN
> blanks-eb eb!
> BEGIN -Expanded? ON copy-back copy -Expanded? @ UNTIL
> Eb tuck -
> ;
> : emacro<
> get-current >R
> ALSO EXPANDABLE DEFINITIONS
> ' CATCH
> R> set-current PREVIOUS THROW
> ;
> : ]L
> ] POSTPONE LITERAL
> ; IMMEDIATE
> : ]S
> ] POSTPONE SLITERAL
> ; IMMEDIATE
> : ]E
> ] expand evaluate
> ; IMMEDIATE
>
> emacro< : ~ -rot ;
> emacro< : ?? S" IF ~ THEN" ;
> emacro< : ?choose [ s" SWAP" s" ?? drop" expand ]S ;
> emacro< : choose S" 2dup ~ ?choose" ;
>
> 1 [IF]
> : umaximum
> [ S" u<" S" choose" ]E
> ;
> : uminimum
> [ S" u>" S" choose" ]E
> ;
> 1 -1 umaximum u. .s -1 1 umaximum u. .s cr
> 1 -1 uminimum u. .s -1 1 uminimum u. .s cr
> see umaximum
> see uminimum
> [THEN]
> ---
>
> I think that is a safe way for evaluate macros,
> as compiling is done at point of delivery.
>
> Happy forthing & have a nice day,
> humptydumpty
There is bad comment :(
> over I char^v ( cax )
stack comment should be ( cax f ) or better nothing
as sequence 'over I char^v' leave stack unmodified.
Have a nice day,
humptydumpty
[toc] | [prev] | [standalone]
Back to top | Article view | comp.lang.forth
csiph-web