fixes for regexp

git-svn-id: https://forth-ev.de/repos/bigforth@1741 3b8d8251-53f3-0310-8f3b-fd1cb8370982

regexp-test.fs

@@ -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]

regexp.fs

@@ -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

string.fs

@@ -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