Return to substitute.fs CVS log

Up to [gforth] / gforth

Annotation of gforth/substitute.fs, revision 1.1

1.1     ! pazsan      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:                        2dup macros-wordlist search-wordlist  IF
        !            35:                            execute 2swap 2drop r> 1+ >r macro$ $+!
        !            36:                        ELSE  2drop  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:     2swap $substitute >r
        !            48:     2swap rot umin 2dup >r >r move r> r> r> ;
        !            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 ! ;