Commit 1b122b65 authored by bp's avatar bp
Browse files

fixes for regexp

git-svn-id: https://forth-ev.de/repos/bigforth@1741 3b8d8251-53f3-0310-8f3b-fd1cb8370982
parent 0097c959
......@@ -101,15 +101,54 @@ s" fofoofoofofooofoobarbar" ?foos1
s" bla baz bar" ?foos1
s" foofoofoo" ?foos1
\ simple replacement test
." --- simple replacement test ---" cr
: delnum ( addr u -- addr' u' ) s// \d >> s" " //g ;
: test-delnum ( addr u addr' u' -- )
2swap delnum 2over 2over str= 0= IF
." test-delnum: got '" type ." ', expected '" type ." '"
ELSE 2drop 2drop ." passed" cr THEN ;
s" 0" s" " test-delnum
s" 00" s" " test-delnum
s" 0a" s" a" test-delnum
s" a0" s" a" test-delnum
s" aa" s" aa" test-delnum
: delcomment ( addr u -- addr' u' ) s// ` # {** .? **} >> s" " //g ;
s" hello # test " delcomment type cr
: delparents ( addr u -- addr' u' ) s// ` ( {* .? *} ` ) >> s" ()" //g ;
s" delete (test) and (another test) " delparents type cr
\ replacement tests
." --- replacement tests ---" cr
: hms>s ( addr u -- addr' u' )
s// \( \d \d \) ` : \( \d \d \) ` : \( \d \d \)
s// \( \d \d \) ` : \( \d \d \) ` : \( \d \d \) >>
\1 s>number drop 60 *
\2 s>number drop + 60 *
\3 s>number drop + 0 <<# 's' hold #s #> #>> //g ;
s" bla 12:34:56 fasel 00:01:57 blubber" hms>s
s" bla 45296s fasel 117s" str= 0= [IF] .( failed) [THEN]
s" bla 12:34:56 fasel 00:01:57 blubber" 2dup type hms>s
." replaced by " 2dup type
s" bla 45296s fasel 117s blubber" str= [IF] .( ok) [ELSE] .( failed) [THEN] cr
: delnum ( addr u -- addr' u' ) s// \d >> s" " //g ;
s" 0a" delnum type cr
s" a" delnum type cr
: hms>s,del() ( addr u -- addr' u' )
s// {{ \( \d \d \) ` : \( \d \d \) ` : \( \d \d \)
>> \1 s>number drop 60 *
\2 s>number drop + 60 *
\3 s>number drop + 0 <# 's' hold #s #> <<
|| ` ( {* .? *} ` ) >> <<" "
}} LEAVE //s ;
\ doesn't work yet
\ s" (bla) 12:34:56 (fasel) 00:01:57 (blubber)" 2dup type hms>s,del() space type cr
script? [IF] bye [THEN]
......@@ -178,19 +178,19 @@ Variable varsmax
0 Value >>ptr
0 Value <<ptr
Variable >>string
: >> ( addr -- addr ) dup to >>ptr ;
: s>> ( addr -- addr ) dup to >>ptr ;
: << ( run-addr addr u -- run-addr )
<<ptr 0= IF start$ to <<ptr THEN
>>string @ 0= IF s" " >>string $! THEN
<<ptr >>ptr over - >>string $+!
>>string $+! dup to <<ptr ;
: <<" '" parse postpone SLiteral postpone << ; immediate
: >>string@ ( -- addr u )
>>string $@len dup allocate throw
swap 2dup >>string $@ drop -rot move
>>string $off 0 to >>ptr 0 to <<ptr ;
>>string $@ ;
: >>string0 ( addr u -- addr u ) s" " >>string $!
0 to >>ptr over to <<ptr ;
: >>next ( -- addr u ) <<ptr end$ over - ;
: >>rest ( -- ) >>next >>string $+! ;
: s// ( addr u -- ptr ) ]] (( // >> [[ ; immediate
: //o ( ptr addr u -- addr' u' ) ]] << )) drop >>rest >>string@ [[ ; immediate
: //g ( ptr addr u -- addr' u' ) ]] << LEAVE )) drop >>string@ [[ ; immediate
: >> ( addr -- addr ) ]] <<ptr >>ptr u> ?LEAVE ?end [[ ; immediate
: s// ( addr u -- ptr ) ]] >>string0 (( // s>> [[ ; immediate
: //s ( ptr -- ) ]] )) drop >>rest >>string@ [[ ; immediate
: //o ( ptr addr u -- addr' u' ) ]] << //s [[ ; immediate
: //g ( ptr addr u -- addr' u' ) ]] << LEAVE //s [[ ; immediate
......@@ -32,7 +32,7 @@ also Memory
2dup dup $@len rot + swap $!len $@ 1+ r> /string insert ;
: $+! ( addr1 u addr2 -- )
>r dup r@ $@len + r@ $!len r> $@ + over - swap move ;
: $off ( addr -- ) HandleOff ;
: $off ( addr -- ) dup @ IF HandleOff ELSE drop THEN ;
toss
\ dynamic string handling 12dec99py
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment