Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.forth > #33871 > unrolled thread

Tiny regular expressions code

Back to article view | Back to comp.lang.forth

Contents

  Tiny regular expressions code Hans Bezemer <the.beez.speaks@gmail.com> - 2014-10-13 18:15 +0200
    Re: Tiny regular expressions code Hans Bezemer <the.beez.speaks@gmail.com> - 2014-10-13 18:18 +0200
      Re: Tiny regular expressions code Pablo Hugo Reda <pabloreda@gmail.com> - 2014-10-13 09:32 -0700
      Re: Tiny regular expressions code Howerd <howerdo@yahoo.co.uk> - 2014-10-13 11:18 -0700
        Re: Tiny regular expressions code Hans Bezemer <the.beez.speaks@gmail.com> - 2014-10-13 20:36 +0200
          Re: Tiny regular expressions code Howerd <howerdo@yahoo.co.uk> - 2014-10-13 11:53 -0700
    Re: Tiny regular expressions code Hans Bezemer <the.beez.speaks@gmail.com> - 2014-10-13 22:14 +0200
    Re: Tiny regular expressions code mhx@iae.nl (Marcel Hendrix) - 2014-10-13 22:59 +0200
      Re: Tiny regular expressions code Hans Bezemer <the.beez.speaks@gmail.com> - 2014-10-13 23:11 +0200
    Re: Tiny regular expressions code albert@spenarnc.xs4all.nl (Albert van der Horst) - 2014-10-14 09:22 +0000
      Re: Tiny regular expressions code Hans Bezemer <the.beez.speaks@gmail.com> - 2014-10-14 17:43 +0200
        Re: Tiny regular expressions code albert@spenarnc.xs4all.nl (Albert van der Horst) - 2014-10-14 16:27 +0000
          Re: Tiny regular expressions code albert@spenarnc.xs4all.nl (Albert van der Horst) - 2014-10-15 09:48 +0000
            Re: Tiny regular expressions code Hans Bezemer <the.beez.speaks@gmail.com> - 2014-10-15 17:38 +0200
              Re: Tiny regular expressions code albert@spenarnc.xs4all.nl (Albert van der Horst) - 2014-10-16 09:20 +0000
    Re: Tiny regular expressions code josv@planet.nl - 2014-10-17 05:03 -0700
      Re: Tiny regular expressions code Hans Bezemer <the.beez.speaks@gmail.com> - 2014-10-17 17:48 +0200
        Re: Tiny regular expressions code Hans Bezemer <the.beez.speaks@gmail.com> - 2014-10-17 19:20 +0200
          Re: Tiny regular expressions code anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2014-10-18 15:43 +0000
            Re: Tiny regular expressions code Hans Bezemer <the.beez.speaks@gmail.com> - 2014-10-18 18:53 +0200
            Re: Tiny regular expressions code hughaguilar96@yahoo.com - 2014-10-18 19:19 -0700
              Re: Tiny regular expressions code Hans Bezemer <the.beez.speaks@gmail.com> - 2014-10-19 14:52 +0200
                Re: Tiny regular expressions code Hans Bezemer <the.beez.speaks@gmail.com> - 2014-10-19 15:25 +0200
                  Re: Tiny regular expressions code Bernd Paysan <bernd.paysan@gmx.de> - 2014-10-19 21:14 +0200
                    Re: Tiny regular expressions code Hans Bezemer <the.beez.speaks@gmail.com> - 2014-10-20 00:17 +0200
                Re: Tiny regular expressions code albert@spenarnc.xs4all.nl (Albert van der Horst) - 2014-10-19 17:10 +0000
                  Re: Tiny regular expressions code Hans Bezemer <the.beez.speaks@gmail.com> - 2014-10-19 19:59 +0200
            Re: Tiny regular expressions code Andrew Haley <andrew29@littlepinkcloud.invalid> - 2014-10-19 09:31 -0500
              The magical number seven (was: Tiny regular expressions code) anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2014-10-20 09:10 +0000
                Re: The magical number seven (was: Tiny regular expressions code) m.a.m.hendrix@tue.nl - 2014-10-20 03:13 -0700
                  Re: The magical number seven (was: Tiny regular expressions code) mhx@iae.nl (Marcel Hendrix) - 2014-10-20 20:19 +0200
                    Re: The magical number seven Lars Brinkhoff <lars.spam@nocrew.org> - 2014-10-21 08:56 +0200
                      Re: The magical number seven Bernd Paysan <bernd.paysan@gmx.de> - 2014-10-21 11:44 +0200
                    Re: The magical number seven (was: Tiny regular expressions code) Just Ian <superian@gmail.com> - 2014-10-21 07:06 -0700
                      Re: The magical number seven (was: Tiny regular expressions code) mhx@iae.nl (Marcel Hendrix) - 2014-10-21 20:11 +0200
                      Re: The magical number seven Andrew Haley <andrew29@littlepinkcloud.invalid> - 2014-10-26 04:27 -0500
                Re: The magical number seven (was: Tiny regular expressions code) Hans Bezemer <the.beez.speaks@gmail.com> - 2014-10-20 17:28 +0200
                  Re: The magical number seven (was: Tiny regular expressions code) anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2014-10-20 16:25 +0000
                  Re: The magical number seven (was: Tiny regular expressions code) "Rod Pemberton" <buzzoff@nonamewhichexists.cmm> - 2014-10-20 16:36 -0400
                    Re: The magical number seven "Elizabeth D. Rather" <erather@forth.com> - 2014-10-20 12:19 -1000
                      Re: The magical number seven "Rod Pemberton" <buzzoff@nonamewhichexists.cmm> - 2014-10-21 01:47 -0400
                        Re: The magical number seven "Elizabeth D. Rather" <erather@forth.com> - 2014-10-20 20:31 -1000
                          Re: The magical number seven albert@spenarnc.xs4all.nl (Albert van der Horst) - 2014-10-21 09:06 +0000
                            Re: The magical number seven "Elizabeth D. Rather" <erather@forth.com> - 2014-10-21 08:47 -1000
                              Re: The magical number seven "Rod Pemberton" <buzzoff@nonamewhichexists.cmm> - 2014-10-22 02:21 -0400
                    Re: The magical number seven (was: Tiny regular expressions code) Hans Bezemer <the.beez.speaks@gmail.com> - 2014-10-21 10:29 +0200
                      Re: The magical number seven (was: Tiny regular expressions code) Bernd Paysan <bernd.paysan@gmx.de> - 2014-10-21 11:34 +0200
                      Re: The magical number seven Andrew Haley <andrew29@littlepinkcloud.invalid> - 2014-10-26 04:41 -0500
                        Re: The magical number seven Hans Bezemer <the.beez.speaks@gmail.com> - 2014-10-26 12:07 +0100
                          Re: The magical number seven Andrew Haley <andrew29@littlepinkcloud.invalid> - 2014-10-26 13:58 -0500
                  Re: The magical number seven (was: Tiny regular expressions code) hughaguilar96@yahoo.com - 2014-10-20 16:34 -0700
                  Re: The magical number seven Andrew Haley <andrew29@littlepinkcloud.invalid> - 2014-10-26 04:33 -0500
                    Re: The magical number seven Hans Bezemer <the.beez.speaks@gmail.com> - 2014-10-26 12:12 +0100
                Re: The magical number seven Andrew Haley <andrew29@littlepinkcloud.invalid> - 2014-10-26 04:24 -0500
            Re: Tiny regular expressions code mhx@iae.nl (Marcel Hendrix) - 2014-10-19 17:10 +0200
        Re: Tiny regular expressions code Hans Bezemer <the.beez.speaks@gmail.com> - 2014-10-18 16:02 +0200
          Re: Tiny regular expressions code josv@planet.nl - 2014-10-18 07:50 -0700
    Re: Tiny regular expressions code Hans Bezemer <the.beez.speaks@gmail.com> - 2014-10-18 17:27 +0200
    Re: Tiny regular expressions code the_gavino_himself <visphatesjava@gmail.com> - 2014-11-08 19:24 -0800
    Re: Tiny regular expressions code the_gavino_himself <visphatesjava@gmail.com> - 2014-11-08 20:42 -0800

Page 1 of 3  [1] 2 3  Next page →

#33871 — Tiny regular expressions code

Short intermission from all the clashes here, sorry for the inconvenience,
but I used Forth for some CODING. You may fry me for the code quality
later, but this is a tiny regular expression parser, based on an article by
Kernighan and Pike
(http://www.drdobbs.com/architecture-and-design/regular-expressions/184410904).

It features ^, $, * and . but I added ? as well (zero or one). This is some
stuff that was left lying around as an intermediate stage for a similar 4tH
library (which is cleaner and more capable), but I thought, may be it is of
use/interest to someone, why throw it away.

Knock yourselves out ;-)

Hans Bezemer

---8<---
\ Regular Expressions by Brian W. Kernighan and Rob Pike
\ Believed to be in the public domain

defer (matchhere)

: (match*)                             ( a n ra rn c --f)
  begin
    >r 2over 2over (matchhere) if r> drop 2drop 2drop true exit then
    2over if c@ dup [char] . = swap r@ = or else dup xor then r> swap
  while                                \ character equals text?
    >r 2>r 1 /string 2r> r>            \ if so, match again
  repeat
  drop 2drop 2drop false               \ clean up, return false
;

: (match?)                             ( a n ra rn c --f)
  >r 2over 2over (matchhere) if r> drop 2drop 2drop true exit then
   2over if c@ dup [char] . = swap r> = or else r> dup xor then
  if 2>r 1 /string 2r> (matchhere) else 2drop 2drop false then
;                                      \ character equals text?

:noname                                ( a n ra rn -- f)
  dup if                               \ regular expression a null string?
    over char+ c@ dup [char] * =       \ if not, does it equal a '*'
    if                                 \ if so, call (match*)
      drop over c@ >r 2 /string r> (match*) exit
    else                               \ otherwise, does it equal a '?'
      [char] ? =
      if                               \ if so, call (match?)
        over c@ >r 2 /string r> (match?) exit
      else                             \ otherwise does it equal a '$'
        over c@ [char] $ = over 1 = and
        if                             \ and is it the last character?
          2drop nip 0= exit            \ is so, check length of text
        else                           \ finally, check if it char matches
          2over 0<> >r c@ >r over c@ dup
          [char] . = swap r> = or r> and
          if 1 /string 2>r 1 /string 2r> recurse exit then false
        then                           \ if so recurse, otherwise quit
      then
    then
  else
    true                               \ zero length regular expression
  then >r 2drop 2drop r>               \ clean up and exit
; is (matchhere)                       \ assign to DEFER (we got 'em)

: match                                ( a n ra rn  --f)
  dup if over c@ [char] ^ =  if 1 /string (matchhere) exit then then
  begin                                \ if caret, chop it
    2over 2over (matchhere) if 2drop 2drop true exit then
    >r over r> swap                    \ match characters
  while                                \ until no more text
    2>r 1 /string 2r>                  \ chop text
  repeat 2drop 2drop false             \ clean up
;

 s" 0,9"   s" ^0,?9$" match . .s cr
 s" 0:9"   s" ^0,?9$" match . .s cr
 s" 09"    s" ^0,?9$" match . .s cr
 s" 009"   s" ^0,?9$" match . .s cr
 s" 0,,9"  s" ^0,?9$" match . .s cr cr
---8<---

[toc] | [next] | [standalone]

#33872

Hans Bezemer wrote:

Sorry, backporting a bugfix:

---8<---
: (match?)                             ( a n ra rn c --f)
  >r 2over 2over (matchhere) if r> drop 2drop 2drop true exit then
   2over if c@ dup [char] . = swap r> = or else r> drop dup xor then
  if 2>r 1 /string 2r> (matchhere) else 2drop 2drop false then
;                                      \ character equals text?
---8<---

Hans Bezemer

[toc] | [prev] | [next] | [standalone]

#33873

very useful

Good one Hans!!

[toc] | [prev] | [next] | [standalone]

#33874

On Monday, 13 October 2014 17:16:14 UTC+1, The Beez  wrote:
> Hans Bezemer wrote:
> 
> 
> 
> Sorry, backporting a bugfix:
> 
> 
> 
> ---8<---
> 
> : (match?)                             ( a n ra rn c --f)
> 
>   >r 2over 2over (matchhere) if r> drop 2drop 2drop true exit then
> 
>    2over if c@ dup [char] . = swap r> = or else r> drop dup xor then
> 
>   if 2>r 1 /string 2r> (matchhere) else 2drop 2drop false then
> 
> ;                                      \ character equals text?
> 
> ---8<---
> 
> 
> 
> Hans Bezemer

Hi Hans,

I like this code, but I may have found a bug (although this could be a lack of understanding on my part ) :

   s" x09"      s" 0,?9" match .  cr -1
   s" x009"     s" 0,?9" match .  cr -1
   s" x0009"    s" 0,?9" match .  cr -1

All of the above show a match, but there is no ',' in any of the input strings.
Does s" 0,?9" mean find a 0 then a , then any or no character, then a 9 in the input string?
I applied your bug fix BTW...

Best regards,
Howerd

[toc] | [prev] | [next] | [standalone]

#33875

Howerd wrote:

> Hi Hans,
> 
> I like this code, but I may have found a bug (although this could be a
> lack of understanding on my part ) :
> 
>    s" x09"      s" 0,?9" match .  cr -1
>    s" x009"     s" 0,?9" match .  cr -1
>    s" x0009"    s" 0,?9" match .  cr -1
> 
> All of the above show a match, but there is no ',' in any of the input
> strings. Does s" 0,?9" mean find a 0 then a , then any or no character,
> then a 9 in the input string? I applied your bug fix BTW...

Yes, without a leading ^ it means: go for the first "0". Then the ? applies
to the PREVIOUS character (the ,). Finally: go for a 9. So it reads
- Find an 0
- Followed by an optional ,
- Followed by a 9.

Hans Bezemer

[toc] | [prev] | [next] | [standalone]

#33876

On Monday, 13 October 2014 19:34:11 UTC+1, The Beez  wrote:
> Howerd wrote:
> 
> 
> 
> > Hi Hans,
> 
> > 
> 
> > I like this code, but I may have found a bug (although this could be a
> 
> > lack of understanding on my part ) :
> 
> > 
> 
> >    s" x09"      s" 0,?9" match .  cr -1
> 
> >    s" x009"     s" 0,?9" match .  cr -1
> 
> >    s" x0009"    s" 0,?9" match .  cr -1
> 
> > 
> 
> > All of the above show a match, but there is no ',' in any of the input
> 
> > strings. Does s" 0,?9" mean find a 0 then a , then any or no character,
> 
> > then a 9 in the input string? I applied your bug fix BTW...
> 
> 
> 
> Yes, without a leading ^ it means: go for the first "0". Then the ? applies
> 
> to the PREVIOUS character (the ,). Finally: go for a 9. So it reads
> 
> - Find an 0
> 
> - Followed by an optional ,
> 
> - Followed by a 9.
> 
> 
> 
> Hans Bezemer

Hi Hans,

Thanks for explaining that :-)

Best regards,
Howerd

[toc] | [prev] | [next] | [standalone]

#33877

Hans Bezemer wrote:

This is an even smaller one, supporting just * and .:

---8<---
: (match-or-dot)
  over c@ [char] . = >r 2swap dup 0<> r> and
  >r over c@ >r 2swap over c@ r> = r> or
;

: match-reg
  dup 0> if
    over char+ c@ [char] * <>
    if
      2over 1 /string 2over 1 /string recurse >r (match-or-dot)
      r> and >r 2drop 2drop r> exit
    then

    begin
      (match-or-dot)
    while
      2over 2over 2 /string recurse if 2drop 2drop true exit then
      2>r 1 /string 2r>
    repeat 2 /string recurse exit

  else
    2drop nip 0=
  then
;

s" aa" s" a"    match-reg . cr
s" aa" s" aa"  match-reg . cr
s" aaa" s" aa"  match-reg . cr
s" aa" s" a*"  match-reg . cr
s" aa" s" .*"  match-reg . cr
s" ab" s" .*"  match-reg . cr
s" aab" s" c*a*b"  match-reg . cr depth .
---8<---

Hans Bezemer

[toc] | [prev] | [next] | [standalone]

#33878

Hans Bezemer <the.beez.speaks@gmail.com> writes Re: Tiny regular expressions code

[..]
> this is a tiny regular expression parser, based on an article by
> Kernighan and Pike
> (http://www.drdobbs.com/architecture-and-design/regular-expressions/184410904).

> It features ^, $, * and . but I added ? as well (zero or one). This is some
> stuff that was left lying around as an intermediate stage for a similar 4tH
> library (which is cleaner and more capable), but I thought, may be it is of
> use/interest to someone, why throw it away.

> Knock yourselves out ;-)

I had to use the below to decipher it :-)

-marcel

-- ------------------------------------------------------------------------
anew -regexpr

DEFER (matchhere) ( $1 $2 -- bool )

: (match*)  LOCAL c  DLOCALS| $2 $1 |  ( $1 $2 char -- bool )
	BEGIN	$1 $2 (matchhere) IF  TRUE EXIT  ENDIF
		$1 IF	c@ dup '.' =  
			swap c = OR 
           	 ELSE	drop FALSE 
		ENDIF  
	WHILE	$1 1 /string TO $1     
	REPEAT	FALSE ;

: (match?)  LOCAL c  DLOCALS| $2 $1 |  ( $1 $2 char -- bool )
	$1 $2 (matchhere) IF  TRUE EXIT  ENDIF
	$1 IF	c@ dup '.' = 
		swap c = OR 
	 ELSE   drop FALSE 
	ENDIF
	   IF	$1 1 /string $2 (matchhere) 
	 ELSE	FALSE
	ENDIF ;

:NONAME LOCALS| n2 a2 n1 a1 |		( $1 $2 -- bool )
	n2 0= IF  TRUE EXIT  ENDIF
	a2 char+ c@ '*' =		\ if not, does it equal a '*'
	   IF	a2 c@ >R		\ if so, call (match*)
		a2 n2 2 /string TO n2 TO a2  
		a1 n1  a2 n2  R> (match*) EXIT
	ENDIF				\ otherwise, does it equal a '?'
	a2 char+ c@ '?' =
	   IF	a2 c@ >R		\ if so, call (match?)
		a2 n2 2 /string TO n2 TO a2
		a1 n1  a2 n2  R> (match?) EXIT
        ENDIF		                \ otherwise, does it equal a '$'
	a2 c@ '$' =  n2 1 = AND
	   IF   n1 0= EXIT		\ and is it the last character?
	ENDIF	
	a2 c@  '.'   = 			\ finally, check if char matches
	a2 c@  a1 c@ = OR  
	n1 0<> AND 
	   IF	a1 n1 1 /string  
	   	a2 n2 1 /string  
		RECURSE EXIT  
	ENDIF	
	FALSE ; IS (matchhere)

: match DLOCALS| $2 $1 |		( $1 $2 -- bool )
	$2 nip IF  $2 drop c@ '^' 
		   = IF  $1 $2 1 /string (matchhere) EXIT  ENDIF
	    ENDIF 
	BEGIN	$1 $2 (matchhere) 	\ if caret, chop it
		   IF  TRUE exit 
		ENDIF 
		$1 NIP			\ match characters until no more text
	WHILE	$1 1 /string TO $1 	\ chop text
	REPEAT	FALSE ;

cr s" 0,9"   s" ^0,?9$" match . .( -1) 
cr s" 0:9"   s" ^0,?9$" match . .(  0)
cr s" 09"    s" ^0,?9$" match . .( -1)
cr s" 009"   s" ^0,?9$" match . .(  0)
cr s" 0,,9"  s" ^0,?9$" match . .(  0)
cr s" 0,,9"  s" ^0,*9$" match . .( -1)
cr s" 0,,9"  s" ^0*9$"  match . .(  0)
cr

[toc] | [prev] | [next] | [standalone]

#33879

Marcel Hendrix wrote:

> I had to use the below to decipher it :-)
Oh Marcel, you know of my hatred of locals ;-) ;-)
But agreed: with 2 strings on the stack it gets pretty crowded pretty soon -
especially if you have to evaluate some complex statement.

Still, the 4tH version is somewhat cleaner (but not ANS):

:noname                                ( a n ra rn -- f)
  dup if                               \ regular expression a null string?
    over char+ c@ (special?) if exit then
    over c@ ($) = over 1 = and         \ otherwise does it equal a '$'
    if                                 \ and is it the last character?
      2drop nip 0= exit                \ is so, check length of text
    else                               \ finally, check if it char matches
      2over 0<> >r c@ >r over c@ r> swap (eq?) r> and
      if chop 2>r chop 2r> recurse exit then false
    then                               \ if so recurse, otherwise quit
  else
    true                               \ zero length regular expression
  then >r 2drop 2drop r>               \ clean up and exit
; is (matchhere)                       \ assign to DEFER (we got 'em)

Hans Bezemer

[toc] | [prev] | [next] | [standalone]

#33887

In article <543bfa10$0$2928$e4fe514c@news2.news.xs4all.nl>,
Hans Bezemer  <the.beez.speaks@gmail.com> wrote:
>Short intermission from all the clashes here, sorry for the inconvenience,
>but I used Forth for some CODING. You may fry me for the code quality
>later, but this is a tiny regular expression parser, based on an article by
>Kernighan and Pike
>(http://www.drdobbs.com/architecture-and-design/regular-expressions/184410904).
>
>It features ^, $, * and . but I added ? as well (zero or one). This is some
>stuff that was left lying around as an intermediate stage for a similar 4tH
>library (which is cleaner and more capable), but I thought, may be it is of
>use/interest to someone, why throw it away.
>
>Knock yourselves out ;-)
>
>Hans Bezemer
>
>---8<---
>\ Regular Expressions by Brian W. Kernighan and Rob Pike
>\ Believed to be in the public domain
>
>defer (matchhere)
>
>: (match*)                             ( a n ra rn c --f)
>  begin
>    >r 2over 2over (matchhere) if r> drop 2drop 2drop true exit then
>    2over if c@ dup [char] . = swap r@ = or else dup xor then r> swap
>  while                                \ character equals text?
>    >r 2>r 1 /string 2r> r>            \ if so, match again
>  repeat
>  drop 2drop 2drop false               \ clean up, return false
>;
>
>: (match?)                             ( a n ra rn c --f)
>  >r 2over 2over (matchhere) if r> drop 2drop 2drop true exit then
>   2over if c@ dup [char] . = swap r> = or else r> dup xor then
>  if 2>r 1 /string 2r> (matchhere) else 2drop 2drop false then
>;                                      \ character equals text?
>
>:noname                                ( a n ra rn -- f)
>  dup if                               \ regular expression a null string?
>    over char+ c@ dup [char] * =       \ if not, does it equal a '*'
>    if                                 \ if so, call (match*)
>      drop over c@ >r 2 /string r> (match*) exit
>    else                               \ otherwise, does it equal a '?'
>      [char] ? =
>      if                               \ if so, call (match?)
>        over c@ >r 2 /string r> (match?) exit
>      else                             \ otherwise does it equal a '$'
>        over c@ [char] $ = over 1 = and
>        if                             \ and is it the last character?
>          2drop nip 0= exit            \ is so, check length of text
>        else                           \ finally, check if it char matches
>          2over 0<> >r c@ >r over c@ dup
>          [char] . = swap r> = or r> and
>          if 1 /string 2>r 1 /string 2r> recurse exit then false
>        then                           \ if so recurse, otherwise quit
>      then
>    then
>  else
>    true                               \ zero length regular expression
>  then >r 2drop 2drop r>               \ clean up and exit
>; is (matchhere)                       \ assign to DEFER (we got 'em)
>
>: match                                ( a n ra rn  --f)
>  dup if over c@ [char] ^ =  if 1 /string (matchhere) exit then then
>  begin                                \ if caret, chop it
>    2over 2over (matchhere) if 2drop 2drop true exit then
>    >r over r> swap                    \ match characters
>  while                                \ until no more text
>    2>r 1 /string 2r>                  \ chop text
>  repeat 2drop 2drop false             \ clean up
>;
>
> s" 0,9"   s" ^0,?9$" match . .s cr
> s" 0:9"   s" ^0,?9$" match . .s cr
> s" 09"    s" ^0,?9$" match . .s cr
> s" 009"   s" ^0,?9$" match . .s cr
> s" 0,,9"  s" ^0,?9$" match . .s cr cr
>---8<---

Most useful are expressions if they can be used to specify
transformations, and those are most useful if they can be scripted.

If you want to go that extra mile with r.e. , you may want to look
at forthtools.html on the site below.

Groetjes Albert
-- 
Albert van der Horst, UTRECHT,THE NETHERLANDS
Economic growth -- being exponential -- ultimately falters.
albert@spe&ar&c.xs4all.nl &=n http://home.hccnet.nl/a.w.m.van.der.horst

[toc] | [prev] | [next] | [standalone]

#33890

Albert van der Horst wrote:

> Most useful are expressions if they can be used to specify
> transformations, and those are most useful if they can be scripted.
> If you want to go that extra mile with r.e. , you may want to look
> at forthtools.html on the site below.
I had a look at it and I'd love to port it to 4tH - although it's a major
project. More so, because it's not ANS (several words I don't recognize - I
know lina) and has no stack comments (despite well documented code). I
didn't look close enough to see if it does fancy dictionary stuff. That's a
bit of a problem since 4tH has no dictionary.

Hans Bezemer

[toc] | [prev] | [next] | [standalone]

#33892

In article <543d4422$0$2833$e4fe514c@news2.news.xs4all.nl>,
Hans Bezemer  <the.beez.speaks@gmail.com> wrote:
>Albert van der Horst wrote:
>
>> Most useful are expressions if they can be used to specify
>> transformations, and those are most useful if they can be scripted.
>> If you want to go that extra mile with r.e. , you may want to look
>> at forthtools.html on the site below.
>I had a look at it and I'd love to port it to 4tH - although it's a major
>project. More so, because it's not ANS (several words I don't recognize - I
>know lina) and has no stack comments (despite well documented code). I
>didn't look close enough to see if it does fancy dictionary stuff. That's a
>bit of a problem since 4tH has no dictionary.

I can't believe that people miss stack comment if things are specified like
(knowing that stack items are in capitals.)
\ For X return the SQUARE of x.
: SQ  DUP * ;

lina is of course somewhat obscure and it would be nice if this was made
available in 4TH.
As far as I know 4TH that shouldn't be too hard. I'm willing to join
forces on this. regular expressions in itself is a major project,
but porting to 4TH shouldn't be with your knowledge of 4th and my
knowledge of the package.

Most non ANS words are in the block file. Only denotations are ciforth
specific, but more and more Forths have recognizers.
I think having a string recognizer for " is a mandatory prelude for r.e.
I would have gone mad if I had to consider each space whether it
belongs to a string or not and it would make the turnkey applications
unattractive for non-Forthers.

>
>Hans Bezemer
>

Groetjes Albert
-- 
Albert van der Horst, UTRECHT,THE NETHERLANDS
Economic growth -- being exponential -- ultimately falters.
albert@spe&ar&c.xs4all.nl &=n http://home.hccnet.nl/a.w.m.van.der.horst

[toc] | [prev] | [next] | [standalone]

#33908

In article <543d4f07$0$6914$e4fe514c@dreader36.news.xs4all.nl>,
Albert van der Horst <albert@spenarnc.xs4all.nl> wrote:
>In article <543d4422$0$2833$e4fe514c@news2.news.xs4all.nl>,
>Hans Bezemer  <the.beez.speaks@gmail.com> wrote:
>>Albert van der Horst wrote:
>>
>>> Most useful are expressions if they can be used to specify
>>> transformations, and those are most useful if they can be scripted.
>>> If you want to go that extra mile with r.e. , you may want to look
>>> at forthtools.html on the site below.
>>I had a look at it and I'd love to port it to 4tH - although it's a major
>>project. More so, because it's not ANS (several words I don't recognize - I
>>know lina) and has no stack comments (despite well documented code). I
>>didn't look close enough to see if it does fancy dictionary stuff. That's a
>>bit of a problem since 4tH has no dictionary.
>
>I can't believe that people miss stack comment if things are specified like
>(knowing that stack items are in capitals.)
>\ For X return the SQUARE of x.
>: SQ  DUP * ;
>
>lina is of course somewhat obscure and it would be nice if this was made
>available in 4TH.
>As far as I know 4TH that shouldn't be too hard. I'm willing to join
>forces on this. regular expressions in itself is a major project,
>but porting to 4TH shouldn't be with your knowledge of 4th and my
>knowledge of the package.
>
>Most non ANS words are in the block file. Only denotations are ciforth
>specific, but more and more Forths have recognizers.
>I think having a string recognizer for " is a mandatory prelude for r.e.
>I would have gone mad if I had to consider each space whether it
>belongs to a string or not and it would make the turnkey applications
>unattractive for non-Forthers.

This triggered me to update the (2003!) regular expression package
that is based on lina version 4.

Supposedly after "WANT -legacy-" it should compile on lina version 5.
It didn't, caused by a defect in the legacy system.
The word IN is missing in the legacy set. I will add
    : IN PP ;
to version 5.2 legacy and then it works.

Then I have ported it to version 5 32-bits.
After
   REQUIRE -> WANT
   $S      -> $/
   ^       -> .S
   (PARSE) -> PARSE
it works without the elective, with just the WANT system loaded.
Then it also works with 5.1 64 bits.

This is the version anyone porting it should use because:
1. You can use it with the latest lina
2. much less of lina is loaded (easier!)
3. better ISO-compatibility
4. I will throw verbose testing (that was there, but not published)
  into the package, which should help immensely.

Contact me, because I can't update my website at the moment.


>
>>
>>Hans Bezemer
>>
>
>Groetjes Albert
>--
>Albert van der Horst, UTRECHT,THE NETHERLANDS
>Economic growth -- being exponential -- ultimately falters.
>albert@spe&ar&c.xs4all.nl &=n http://home.hccnet.nl/a.w.m.van.der.horst
>
-- 
Albert van der Horst, UTRECHT,THE NETHERLANDS
Economic growth -- being exponential -- ultimately falters.
albert@spe&ar&c.xs4all.nl &=n http://home.hccnet.nl/a.w.m.van.der.horst

[toc] | [prev] | [next] | [standalone]

#33917

Albert van der Horst wrote:

> This is the version anyone porting it should use because:
> 1. You can use it with the latest lina
> 2. much less of lina is loaded (easier!)
> 3. better ISO-compatibility
> 4. I will throw verbose testing (that was there, but not published)
>   into the package, which should help immensely.
> 
> Contact me, because I can't update my website at the moment.
I did, using the email address used here and at your site. Haven't got an
answer yet..

I know I have to work at my patience ;-)

Hans Bezemer

[toc] | [prev] | [next] | [standalone]

#33941

In article <543e9480$0$2938$e4fe514c@news2.news.xs4all.nl>,
Hans Bezemer  <the.beez.speaks@gmail.com> wrote:
>Albert van der Horst wrote:
>
>> This is the version anyone porting it should use because:
>> 1. You can use it with the latest lina
>> 2. much less of lina is loaded (easier!)
>> 3. better ISO-compatibility
>> 4. I will throw verbose testing (that was there, but not published)
>>   into the package, which should help immensely.
>>
>> Contact me, because I can't update my website at the moment.
>I did, using the email address used here and at your site. Haven't got an
>answer yet..
>
>I know I have to work at my patience ;-)

I check my e-mail once a day, not always.

Anyway, I might as well explain here how to work with the archive.
In case others may want to try, or want input whether they want to
try.

1. null-test, on a linux system, assuming rcs (cvs works ceteres paribus).
   extract the archive
       tar xfz regexp.tgz ;cd regexp
   overwrite all files in regexp/ with version LAST_FOR_LINA4
       co -rLAST_FOR_LINA4 RCS/*
   test using lina in the current directory (. must be in the path,
   or adapt the makefile)
       make -B test
       make -B thinkingtest
2. Install lina 32 bits version 5 and extract the latest source from the
    archive.
   The same tests must succeed.
3. Change the source to run verbose instead of normal.
   The file test is much larger now and must be equal to test-verbose.
   The resulting file test is where you compare your code with.
4. With the other Forth (4th) try to compile regexp.frt
   You will have to add a prelude with facilities you copy from
    forth.lab. You may have to reimplement some missing words
   from the lina documentation: $@ $! $+! $/ $^
5. Now the testing can begin. The results must be the same as
    the test-verbose from step 3.

This completes the first phase. You can be pretty confident,
as the tests are really comprehensive.

Now the second phase is to have a turnkey that can be redistributed
and used as a filter
"
    #!refilter -s
    1 ARG[] GET-FILE
    ".." ".." GLOBAL
    2 ARG[] PUT-FILE
"
That is very implementation dependant, even not always possible,
but I think 4TH can do it.

>
>Hans Bezemer
>
-- 
Albert van der Horst, UTRECHT,THE NETHERLANDS
Economic growth -- being exponential -- ultimately falters.
albert@spe&ar&c.xs4all.nl &=n http://home.hccnet.nl/a.w.m.van.der.horst

[toc] | [prev] | [next] | [standalone]

#33976

13 oktober 2014 18:13:06 UTC+2 Hans wrote:
Hi Hans,

> Short intermission from all the clashes here, sorry for the inconvenience,
> 
> but I used Forth for some CODING. You may fry me for the code quality
Thank you very much, nice code.

Testing your code I wonder:
Is the following match not possible?
cr s" 123abcd_efg"   s" abc*ef" match . .( 1) 

Jos

[toc] | [prev] | [next] | [standalone]

#33980

josv@planet.nl wrote:
> Testing your code I wonder:
> Is the following match not possible?
> cr s" 123abcd_efg"   s" abc*ef" match . .( 1)

Nope. It says: look for "ab", followed by zero or more "c's" and finally
followed by "ef". It's NOT a wildcard, pal!

You probably wanna say:

        s" abc.*ef"

Which means: look for "abc", followed by zero or more random characters and
finally followed by "ef". May be this is more appropriate for you: ;-)

---8<---
: chop 1- swap char+ swap ;            ( a n -- a+1 n-1)
: s@ 0> if c@ else drop -1 then ;      ( a n -- c)
: 4drop 2drop 2drop ;                  ( a b c d --)
: 4dup 2over 2over ;                   ( a b c d -- a b c d a b c d)
: 2s@ 4dup s@ -rot s@ ;                ( a1 n1 a2 n2 -- a1 n1 a2 n2 c1 c2)
: w@ 2over s@ ;                        ( a n -- c)
: (2chop) chop 2swap ;                 ( a1 n1 a2 n2 -- a2+1 n2-1 a1 n1)
: 2chop (2chop) (2chop) ;              ( a1 n1 a2 n2 -- a1+1 n1-1 a2+1 n2-1)
                                       \ returns true on match, false if not
: wild-match                           ( a1 n1 a2 n2 -- f)
  begin                                ( a1 n1 a2 n2)
    dup 0<> >r w@ '*' <> r> and        ( a1 n1 a2 n2 f)
  while                                ( a1 n1 a2 n2)
    2s@ <> if w@ '?' <> if 4drop false exit then then 2chop 
  repeat 4dup 2>r 2>r                  ( a1+y n1-y a2+x n2-x)
  
  begin                                ( a1 n1 a2 n2)
    dup                                ( a1 n1 a2 n2 f)
  while                                ( a1 n1 a2 n2)
    w@ '*' = if                        ( a1 n1 a2 n2 f)
      2>r chop dup 2r> rot 0=          ( a1+1 n1-1 a2 n2)
      if 2r> 2r> 4drop 4drop true exit then
      4dup chop 2r> 2r> 4drop 2>r 2>r  ( a1+1 n1-1 a2 n2)
    else                               ( a1 n1 a2 n2)
      2s@ = >r w@ '?' = r> or          ( a1 n1 a2 n2 f)
      if 2chop else 4drop 2r> 2r> 2dup chop 2>r 2over 2>r then
    then                               ( a1 n1 a2 n2)
  repeat 2r> 2r> 4drop 2drop           ( a1 n1)
                                       ( f)
  begin 2dup s@ '*' = while chop repeat nip 0=
;
---8<---

s" *abc*ef*" s" 123abcd_efg"  wild-match . -1  ok

Hans Bezemer

[toc] | [prev] | [next] | [standalone]

#33981

Hans Bezemer wrote:

If you think the previous version (which kept the state in stack values) was
some heavy duty code, here is a recursive version which is cleaner:
 
---8<---
: chop 1- swap char+ swap ;            ( a n -- a+1 n-1)
: 4drop 2drop 2drop ;                  ( a b c d --)

: match-wild
  begin
    dup                                \ exit when match string is exhausted
  while
    over c@ [char] ? =                 \ match any character
    if                                 \ except empty string
      >r over r> swap 0= if 4drop false exit then
      2>r chop 2r> chop                \ okay, next one please
    else
      over c@ [char] * =               \ match zero or more characters
      if                               \ because we eat one character
        2over 2over chop recurse if 4drop true exit then
        >r over r> swap if 2over chop 2over recurse else false then
        >r 4drop r> exit               \ from match string, recursion stops
      else                             \ nothing worked with this wildcard
        2over if                       \ not an empty string?
          c@ >r over c@ r> =           \ if so, compare both characters
          if 2>r chop 2r> chop else 4drop false exit then
        else                           \ otherwise, it's no use going on
          drop 4drop false exit
        then
      then
    then
  repeat                               \ get next character
  >r drop nip r> or 0=                 \ only a match if both are at the end
;
---8<---

s" abracadabra"    s" ?b*r?"  match-wild . cr
s" pArka"          s" *a"     match-wild . cr
s" parka"          s" *a"     match-wild . cr
s" park"           s" *a*"    match-wild . cr
s" a"              s" a"      match-wild . cr
s" aardvark"       s" a*"     match-wild . cr
0 dup              s" *"      match-wild . cr

s" argh"           s" a"      match-wild . cr
s" ba"             s" a"      match-wild . cr
s" badger"         s" a*"     match-wild . cr
s" park"           s" *a"     match-wild . cr
s" perk"           s" *a*"    match-wild . cr
s" abracadabr"     s" ?b*r?"  match-wild . cr
s" abracadabzr"    s" ?b*r?"  match-wild . cr .s

Hans Bezemer

[toc] | [prev] | [next] | [standalone]

#34011

Hans Bezemer <the.beez.speaks@gmail.com> writes:
>Hans Bezemer wrote:
>
>If you think the previous version (which kept the state in stack values) was
>some heavy duty code, here is a recursive version which is cleaner:
> 
>---8<---
>: chop 1- swap char+ swap ;            ( a n -- a+1 n-1)
>: 4drop 2drop 2drop ;                  ( a b c d --)
>
>: match-wild
>  begin
>    dup                                \ exit when match string is exhausted
>  while
>    over c@ [char] ? =                 \ match any character
>    if                                 \ except empty string
>      >r over r> swap 0= if 4drop false exit then
>      2>r chop 2r> chop                \ okay, next one please
>    else
>      over c@ [char] * =               \ match zero or more characters
>      if                               \ because we eat one character
>        2over 2over chop recurse if 4drop true exit then
>        >r over r> swap if 2over chop 2over recurse else false then
>        >r 4drop r> exit               \ from match string, recursion stops
>      else                             \ nothing worked with this wildcard
>        2over if                       \ not an empty string?
>          c@ >r over c@ r> =           \ if so, compare both characters
>          if 2>r chop 2r> chop else 4drop false exit then
>        else                           \ otherwise, it's no use going on
>          drop 4drop false exit
>        then
>      then
>    then
>  repeat                               \ get next character
>  >r drop nip r> or 0=                 \ only a match if both are at the end
>;

Related to an adjacent discussion: I think that this serves nicely as
a demonstration that lack of locals does not automatically lead to
well-factored code (especially if you use 'the magical "seven, plus or
minus two" words' *maximum* as the definition of "well-factored").

- anton
-- 
M. Anton Ertl  http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
     New standard: http://www.forth200x.org/forth200x.html
   EuroForth 2014: http://www.euroforth.org/ef14/

[toc] | [prev] | [next] | [standalone]

#34012

Anton Ertl wrote:

> Hans Bezemer <the.beez.speaks@gmail.com> writes:
> Related to an adjacent discussion: I think that this serves nicely as
> a demonstration that lack of locals does not automatically lead to
> well-factored code (especially if you use 'the magical "seven, plus or
> minus two" words' *maximum* as the definition of "well-factored").
Well, that might also be due to my style of coding. When creating library
code I DON'T factor unless I have to. It saves me the call overhead (which
is heavier in 4tH than other Forths) and (for library code) the savings in
size don't add up to much. I don't know how users are thrashing the code,
so I want it as tight as possible.

In applications programs I do factor A LOT. E.g. in the 4tH preprocessor
you'll find LOTS of one-liners and other words rarely exceed three lines.

BTW, I don't find the "localists" doing so great either where "one-liners"
are concerned. Speaking of no one in general, I hasten to say.

Still, IMHO this particular code is not overly difficult to follow. And that
is where my primary concern is here. 

Hans Bezemer

[toc] | [prev] | [next] | [standalone]

Page 1 of 3  [1] 2 3  Next page →

Back to top | Article view | comp.lang.forth

csiph-web