Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.forth > #42528

Text Expansion Macros

Show all headers | View raw

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

Back to comp.lang.forth | Previous | Next — Next in thread | Find similar | Unroll thread

Thread

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

csiph-web