Skip to content
GitLab
Menu
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
Bernd Paysan
bigforth
Commits
1b122b65
Commit
1b122b65
authored
Sep 05, 2010
by
bp
Browse files
fixes for regexp
git-svn-id:
https://forth-ev.de/repos/bigforth@1741
3b8d8251-53f3-0310-8f3b-fd1cb8370982
parent
0097c959
Changes
3
Hide whitespace changes
Inline
Side-by-side
regexp-test.fs
View file @
1b122b65
...
...
@@ -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'
--
)
2
swap
delnum
2
over
2
over
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"
0
a
" 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
45296
s
fasel
117
s
blubber
" str= [IF] .( ok) [ELSE] .( failed) [THEN] cr
: delnum ( addr u -- addr' u' ) s//
\
d >> s"
" //g ;
s"
0
a
" 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
View file @
1b122b65
...
...
@@ -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
View file @
1b122b65
...
...
@@ -32,7 +32,7 @@ also Memory
2
dup
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
12
dec99py
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment