Return to substitute.fs CVS log

Up to [gforth] / gforth

Allow substitute to access stack, too

    1: \ substitute stuff
    2: 
    3: require string.fs
    4: 
    5: wordlist AConstant macros-wordlist
    6: 
    7: : macro: ( addr u -- ) Create here 0 , $! DOES> $@ ;
    8: 
    9: : replaces ( addr1 len1 addr2 len2 -- )
   10:     \G create a macro with name @var{addr2 len2} and content @var{addr1 len1}.
   11:     \G if the macro already exists, just change the content.
   12:     2dup macros-wordlist search-wordlist
   13:     IF  nip nip >body $!
   14:     ELSE
   15: 	get-current >r macros-wordlist set-current
   16: 	['] macro: execute-parsing
   17: 	r> set-current
   18:     THEN ;
   19: 
   20: Variable macro$
   21: 
   22: : $substitute ( addr1 len1 -- addr2 len2 n )
   23:     \G substitute all macros in text @var{addr1 len1}.
   24:     \G @var{n} is the number of substitutions, @var{addr2 len2} the result.
   25:     s" " macro$ $! 0 >r
   26:     BEGIN  dup  WHILE  '%' $split
   27: 	    2swap macro$ $+! dup IF
   28: 		over c@ '%' = IF
   29: 		    over dup 1+ over - macro$ $+! 1 /string
   30: 		ELSE
   31: 		    '%' $split 2swap dup 0= IF
   32: 			2drop s" %" macro$ $+! r> 1+ >r
   33: 		    ELSE
   34: 			macros-wordlist search-wordlist  IF
   35: 			    -rot 2>r execute macro$ $+! 2r> r> 1+ >r
   36: 			THEN
   37: 		    THEN
   38: 		THEN
   39: 	    THEN
   40:     REPEAT  2drop macro$ $@ r> ;
   41: 
   42: : substitute ( addr1 len1 addr2 len2 -- addr2 len3 n )
   43:     \G substitute all macros in text @var{addr1 len1}, and copy the
   44:     \G result to @var{addr2 len2}.  @var{n} is the number of
   45:     \G substitutions, @var{addr2 len3} the result.  If
   46:     \G @var{len2}=@var{len3}, it is likely that the string did not fit.
   47:     2>r $substitute -rot
   48:     2r> rot umin 2dup 2>r move 2r> rot ;
   49: 
   50: : unescapes ( addr1 u1 dest -- dest u2 )
   51:     \G double all delimiters in @var{addr1 u1}, so that substitute
   52:     \G will result in the original text.  Note that the buffer
   53:     \G @var{dest} does not have a size, as in worst case, it will need
   54:     \G just twice as many characters as @var{u1}. @{dest u2} is the
   55:     \G resulting string.
   56:     dp @ >r dup >r dp !
   57:     bounds ?DO
   58: 	I c@ dup '%' = IF  dup c,  THEN  c,
   59:     LOOP  r> here over -  r> dp ! ;