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

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

: YC ( .. xt xt |0 -- .. ) BEGIN WHILE execute REPEAT ;

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

Contents

  : YC  ( .. xt xt |0 -- .. )  BEGIN WHILE execute REPEAT ; humptydumpty <ouatubi@gmail.com> - 2016-01-28 23:19 -0800
    Re: : YC  ( .. xt xt |0 -- .. )  BEGIN WHILE execute REPEAT ; humptydumpty <ouatubi@gmail.com> - 2016-01-29 09:49 -0800
      Re: : YC ( .. xt xt |0 -- .. ) BEGIN WHILE execute REPEAT ; Gerry Jackson <gerry@jackson9000.fsnet.co.uk> - 2016-02-02 10:00 +0000
        Re: : YC ( .. xt xt |0 -- .. ) BEGIN WHILE execute REPEAT ; humptydumpty <ouatubi@gmail.com> - 2016-02-02 02:32 -0800
    Re: : YC  ( .. xt xt |0 -- .. )  BEGIN WHILE execute REPEAT ; hughaguilar96@gmail.com - 2016-01-29 20:42 -0800
      Re: : YC  ( .. xt xt |0 -- .. )  BEGIN WHILE execute REPEAT ; humptydumpty <ouatubi@gmail.com> - 2016-01-29 23:27 -0800
        Re: : YC  ( .. xt xt |0 -- .. )  BEGIN WHILE execute REPEAT ; humptydumpty <ouatubi@gmail.com> - 2016-01-29 23:30 -0800
        Re: : YC  ( .. xt xt |0 -- .. )  BEGIN WHILE execute REPEAT ; hughaguilar96@gmail.com - 2016-01-30 11:32 -0800
          Re: : YC  ( .. xt xt |0 -- .. )  BEGIN WHILE execute REPEAT ; humptydumpty <ouatubi@gmail.com> - 2016-01-31 10:02 -0800
            Re: : YC  ( .. xt xt |0 -- .. )  BEGIN WHILE execute REPEAT ; Julian Fondren <julian.fondren@gmail.com> - 2016-02-01 01:32 -0800
              Re: : YC  ( .. xt xt |0 -- .. )  BEGIN WHILE execute REPEAT ; humptydumpty <ouatubi@gmail.com> - 2016-02-01 02:23 -0800
                Re: : YC  ( .. xt xt |0 -- .. )  BEGIN WHILE execute REPEAT ; hughaguilar96@gmail.com - 2016-02-01 20:41 -0800
                  Re: : YC  ( .. xt xt |0 -- .. )  BEGIN WHILE execute REPEAT ; humptydumpty <ouatubi@gmail.com> - 2016-02-01 23:36 -0800
                    Re: : YC  ( .. xt xt |0 -- .. )  BEGIN WHILE execute REPEAT ; hughaguilar96@gmail.com - 2016-02-02 20:29 -0800
                      Re: : YC  ( .. xt xt |0 -- .. )  BEGIN WHILE execute REPEAT ; humptydumpty <ouatubi@gmail.com> - 2016-02-03 00:05 -0800
                      Re: : YC  ( .. xt xt |0 -- .. )  BEGIN WHILE execute REPEAT ; humptydumpty <ouatubi@gmail.com> - 2016-02-03 00:26 -0800
                        Re: : YC ( .. xt xt |0 -- .. ) BEGIN WHILE execute REPEAT ; Albert van der Horst <albert@spenarnc.xs4all.nl> - 2016-02-03 12:17 +0000
                          Re: : YC ( .. xt xt |0 -- .. ) BEGIN WHILE execute REPEAT ; humptydumpty <ouatubi@gmail.com> - 2016-02-03 06:17 -0800
                            Re: : YC ( .. xt xt |0 -- .. ) BEGIN WHILE execute REPEAT ; humptydumpty <ouatubi@gmail.com> - 2016-02-03 06:19 -0800
                      Re: : YC  ( .. xt xt |0 -- .. )  BEGIN WHILE execute REPEAT ; franck.bensusan@gmail.com - 2016-02-03 01:02 -0800
                        Re: : YC  ( .. xt xt |0 -- .. )  BEGIN WHILE execute REPEAT ; franck.bensusan@gmail.com - 2016-02-03 01:23 -0800
              Re: : YC  ( .. xt xt |0 -- .. )  BEGIN WHILE execute REPEAT ; anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-02-02 17:31 +0000
        Re: : YC  ( .. xt xt |0 -- .. )  BEGIN WHILE execute REPEAT ; hughaguilar96@gmail.com - 2016-01-31 21:19 -0800
          Re: : YC  ( .. xt xt |0 -- .. )  BEGIN WHILE execute REPEAT ; humptydumpty <ouatubi@gmail.com> - 2016-02-01 00:28 -0800
      Re: : YC ( .. xt xt |0 -- .. ) BEGIN WHILE execute REPEAT ; "WJ" <w_a_x_man@yahoo.com> - 2016-01-31 10:35 +0000
        Re: : YC ( .. xt xt |0 -- .. ) BEGIN WHILE execute REPEAT ; Chris Curl <ccurl609@gmail.com> - 2016-01-31 07:47 -0800
          Re: : YC ( .. xt xt |0 -- .. ) BEGIN WHILE execute REPEAT ; hughaguilar96@gmail.com - 2016-01-31 20:37 -0800
    Re: : YC ( .. xt xt |0 -- .. ) BEGIN WHILE execute REPEAT ; "WJ" <w_a_x_man@yahoo.com> - 2016-01-30 09:43 +0000
    Re: : YC  ( .. xt xt |0 -- .. )  BEGIN WHILE execute REPEAT ; Julian Fondren <julian.fondren@gmail.com> - 2016-01-30 02:11 -0800
      Re: : YC  ( .. xt xt |0 -- .. )  BEGIN WHILE execute REPEAT ; humptydumpty <ouatubi@gmail.com> - 2016-01-30 11:33 -0800
      Re: : YC ( .. xt xt |0 -- .. ) BEGIN WHILE execute REPEAT ; "WJ" <w_a_x_man@yahoo.com> - 2016-01-31 10:11 +0000
        Re: : YC ( .. xt xt |0 -- .. ) BEGIN WHILE execute REPEAT ; Julian Fondren <julian.fondren@gmail.com> - 2016-01-31 08:04 -0800
          Re: : YC ( .. xt xt |0 -- .. ) BEGIN WHILE execute REPEAT ; Julian Fondren <julian.fondren@gmail.com> - 2016-01-31 08:31 -0800

Page 2 of 2 — ← Prev page 1 [2]

#45264

Le mercredi 3 février 2016 10:02:30 UTC+1, franck....@gmail.com a écrit :

> So, "theorically", LASTEST is allowed to write a YC.
> (practically, nobody cares).
> 

So, "theorically", LASTEST is <not> allowed to write a YC.

Franck

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

#45253

Julian Fondren <julian.fondren@gmail.com> writes:
>With your words, I would have to ask: do I want YC, or YCC, or
>YCC+, or YCCI, or YCCI+, or YCG, or YCG+, or YCGI, or YCGI+ .

Somewhere between standard Forth loops and the YC words, there are the
Postscript looping words:

General loop:

{ ... } loop

You can leave it with "exit", which you can call in an "if".  Note
that loop does not push anything on the stack or consume anything from
the stack in each iteration (in particular, not the xt for the next
iteration).

Counted loop:

start inc end { ... } for

for pushes the current index on the stack before calling the procedure
(the { ... } part) in each iteration.

Counted loop without index:

count { ... } repeat

repeat does not push or pop anything on the stack in each iteration.
There is no way to get the index with repeat.

- 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 2015: http://www.rigwit.co.uk/EuroForth2015/

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

#45223

On Saturday, January 30, 2016 at 12:27:25 AM UTC-7, humptydumpty wrote:
> On Saturday, January 30, 2016 at 6:42:19 AM UTC+2, hughag...@gmail.com wrote:
> > : YC ( .. xt xt |0 -- .. ) BEGIN WHILE execute REPEAT ;
> > 
> > Here is an alternative suggestion:
> > 
> > \ toucher: i*x -- j*x continue?
> > 
> > : YC ( xt -- )  >r begin  r@ execute while repeat  r> drop ;
> > 
> > This way when your xt executes it has access to the data-stack that the parent set up (the i*x stuff) without anything (including its own xt value) being on top of this data getting in the way.

> Both methods gives transparency to data-stack, but responsibility to preserve
> 'xt' differs.
> 
> In my version, responsibility belongs to the word that is fed to the 'YC', in yours belongs to 'YC'.  

There is some history here. I had EACH in the novice package that is defined like this:

: each ( i*x head 'toucher -- j*x )                 \ toucher: i*x node -- j*x
    >r
    begin  dup while              \ -- node                       \r: -- 'toucher
        r@  over .fore @ >r       \ -- node 'toucher              \r: -- 'toucher next
        execute  r> repeat drop
    rdrop ;

When I released the novice package, everybody said that FFL was far better in every way. FFL had a HOF like EACH that did not hold its internal data on the return-stack, so when the xt was executed all that internal data was sitting on top of the user's data getting in the way. It was the user's responsibility to know how much internal data the HOF had and to push it to the return-stack during its execution and then pull it off again before exiting. So, the user had to know all the details of how the HOF worked internally --- the user couldn't just use the HOF and know what it did. I pointed out this problem with FFL and so the HOF in FFL got fixed. This was for singly-linked lists which my EACH is for --- I assume that the problem infects FFL throughout and that it hasn't been fixed everywhere (I haven't bothered to check because I have no interest in FFL). 

FFL (Forth Foundation Library) certainly does have a grandiose name. The use of the word "Foundation" is very comparable to the word "Standard" --- the Forth-200x committee love to declare themselves to be the Standard, and the Foundation, etc..

Anyway, Humptydumpty --- you started this thread out by saying: "deserves to be a primitive." This implies that it has to be part of the standard, because primitives are written in assembly-language rather than Forth. I agree that YC should be a primitive, but it needs some improvement --- don't be like the Forth-200x committee who are unable to learn anything, but instead declare their screw-ups to be "Standard" and "Foundation" --- Forth is more enjoyable when you write robust code, and you did say that you want to enjoy Forth. :-)

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

#45228

On Monday, February 1, 2016 at 7:19:47 AM UTC+2, hughag...@gmail.com wrote:
> On Saturday, January 30, 2016 at 12:27:25 AM UTC-7, humptydumpty wrote:
> > On Saturday, January 30, 2016 at 6:42:19 AM UTC+2, hughag...@gmail.com wrote:
> > > : YC ( .. xt xt |0 -- .. ) BEGIN WHILE execute REPEAT ;
> > > 
> > > Here is an alternative suggestion:
> > > 
> > > \ toucher: i*x -- j*x continue?
> > > 
> > > : YC ( xt -- )  >r begin  r@ execute while repeat  r> drop ;
> > > 
> > > This way when your xt executes it has access to the data-stack that the parent set up (the i*x stuff) without anything (including its own xt value) being on top of this data getting in the way.
> 
> > Both methods gives transparency to data-stack, but responsibility to preserve
> > 'xt' differs.
> > 
> > In my version, responsibility belongs to the word that is fed to the 'YC', in yours belongs to 'YC'.  
> 
> There is some history here. I had EACH in the novice package that is defined like this:
> 
> : each ( i*x head 'toucher -- j*x )                 \ toucher: i*x node -- j*x
>     >r
>     begin  dup while              \ -- node                       \r: -- 'toucher
>         r@  over .fore @ >r       \ -- node 'toucher              \r: -- 'toucher next
>         execute  r> repeat drop
>     rdrop ;
> 
> When I released the novice package, everybody said that FFL was far better in every way. FFL had a HOF like EACH that did not hold its internal data on the return-stack, so when the xt was executed all that internal data was sitting on top of the user's data getting in the way. It was the user's responsibility to know how much internal data the HOF had and to push it to the return-stack during its execution and then pull it off again before exiting. So, the user had to know all the details of how the HOF worked internally --- the user couldn't just use the HOF and know what it did. I pointed out this problem with FFL and so the HOF in FFL got fixed. This was for singly-linked lists which my EACH is for --- I assume that the problem infects FFL throughout and that it hasn't been fixed everywhere (I haven't bothered to check because I have no interest in FFL). 
> 
> FFL (Forth Foundation Library) certainly does have a grandiose name. The use of the word "Foundation" is very comparable to the word "Standard" --- the Forth-200x committee love to declare themselves to be the Standard, and the Foundation, etc..
> 
> Anyway, Humptydumpty --- you started this thread out by saying: "deserves to be a primitive." This implies that it has to be part of the standard, because primitives are written in assembly-language rather than Forth. I agree that YC should be a primitive, but it needs some improvement --- don't be like the Forth-200x committee who are unable to learn anything, but instead declare their screw-ups to be "Standard" and "Foundation" --- Forth is more enjoyable when you write robust code, and you did say that you want to enjoy Forth. :-)

Hi!

Improvements are already welcomed from everyone :-)
Enjoying robust Forth code is for everyone too!

For Forth coding fun, here is an attempt to write 'each' using YC:
\ ---
: XT    latestxt postpone literal ; immediate
: YC    ( .. xt|0 -- .. )       BEGIN ?dup WHILE execute REPEAT ;
: each  ( xt node -- xt node xt-each|0 )
        dup IF
                2>R
                2R@ swap execute
                2R> .fore
                xt              \ loops again
        ELSE    0       THEN    \ terminate loop
;
\ Use:  ( xt node ) ['] each YC  ( xt 0 ) 2drop
\ Test: ( xt node xt-each ) execute .S  ( xt node xt-each ;repeat that at heart wish or to list-end :-)
\ ---

Enjoying Forth,
humptydumpty

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

#45212 — Re: : YC ( .. xt xt |0 -- .. ) BEGIN WHILE execute REPEAT ;

hughaguilar96@gmail.com wrote:

> I rely heavily on passing an xt into a HOF that does
> some iteration and executes the xt on every pass.

+1

Hiding the gory details of iteration unshackles the mind of
the programmer, allowing it to devote all of its power
to the real problem.

-- 
Amazon bans book.  After nearly a month on the site, all traces of the book and
its 80 reviews have been removed.
http://jamesfetzer.blogspot.com/2015/11/debunking-sandy-hook-debunkers-5.html
https://www.youtube.com/watch?v=EEl_1HWFRfo

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

#45215 — Re: : YC ( .. xt xt |0 -- .. ) BEGIN WHILE execute REPEAT ;

On Sunday, January 31, 2016 at 5:37:57 AM UTC-5, WJ wrote:
> Hiding the gory details of iteration unshackles the mind of
> the programmer, allowing it to devote all of its power
> to the real problem.
> 
Your inability to see that Forth doesn't need to be able to do what Ruby
can do in as few lines of code shows that you have no imagination.
With Forth, you can literally do ANYTHING you want to do with the computer.

My purge files is this:

get.current.folder 40000 bytes purge.files

If you want to see the details behind mine, show me the details behind yours.

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

#45222 — Re: : YC ( .. xt xt |0 -- .. ) BEGIN WHILE execute REPEAT ;

On Sunday, January 31, 2016 at 8:47:51 AM UTC-7, Chris Curl wrote:
> On Sunday, January 31, 2016 at 5:37:57 AM UTC-5, WJ wrote:
> > Hiding the gory details of iteration unshackles the mind of
> > the programmer, allowing it to devote all of its power
> > to the real problem.
> > 
> Your inability to see that Forth doesn't need to be able to do what Ruby
> can do in as few lines of code shows that you have no imagination.
> With Forth, you can literally do ANYTHING you want to do with the computer.
> 
> My purge files is this:
> 
> get.current.folder 40000 bytes purge.files
> 
> If you want to see the details behind mine, show me the details behind yours.

I think that WJ is right that it is a good idea to hide iteration inside of a HOF so the application programmer can focus the application program rather than the details of explicit loops --- iteration is the most common source of bugs, so hiding the iteration should simplify programs considerably and make them easier to test.

I also think that WJ is a jackass. This business of posting Ruby code (now) or Gauche Scheme code (previously) is very annoying. If he likes those languages so much, he should just program in them and leave us alone. I have no interest in dynamic-OOP languages because tagged data makes the language slow (Ruby is abysmally slow even by scripting-language standards).

BTW: Why does WJ not post Gauche Scheme code anymore? Most likely Shiro Kawai or some other Gauche Scheme honcho told him that he was a jackass and that his constant promotion of Gauche Scheme on comp.lang.lisp was making the Gauche Scheme community look bad.

People should just program in whatever language they like. The point of programming is to write programs, hopefully that do something useful, or at least that are fun to write and/or to use --- telling everybody on the internet that they are programming in the wrong language is pointless --- being the "leading expert" on a programming language and authoring the Standard for that programming language, while never writing any programs, is also pointless.

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

#45194 — Re: : YC ( .. xt xt |0 -- .. ) BEGIN WHILE execute REPEAT ;

humptydumpty wrote:

> : xt  latestxt postpone literal ; immediate
> 
> \ Use:     : wordname .... test-sequence IF xt dup ELSE 0 THEN ;
> \ Kick into action:     ' wordname dup YC
> 
> \ Example:
> : downcount     dup . 1- dup 0 >= IF xt dup ELSE 0 THEN ;
> 10 ' downcount dup YC drop

Ruby:

def yc(n,xt)
  n = xt.call(n) while n
end

yc 10, lambda{|n| n>=0 and (print n, " "; n-1)}

 ===>
10 9 8 7 6 5 4 3 2 1 0

-- 
Government is not reason, it is not eloquence, it is force; like fire, a
troublesome servant and a fearful master.  Never for a moment should it be left
to irresponsible action. --- George Washington, speech of January 7, 1790
Use this [sword] for me, if I rule well; if not, against me. --- Trajan

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

#45196

On Friday, January 29, 2016 at 1:19:28 AM UTC-6, humptydumpty wrote:
> \ Example:
> : downcount     dup . 1- dup 0 >= IF xt dup ELSE 0 THEN ;
> 10 ' downcount dup YC drop
> 
> ---
> *Factored* loop. Small. Beautiful. Deserves to be a primitive.

Hmm.  Well, take this code (please don't say, "no thank you!"):

  variable matched
  : email ( -- )  matched off
    emails[ rules-apply? if purge  matched ++ then ]emails
    matched ? ." emails purged" cr ;

Where emails[ ... ]emails

  : emails[ ( -- )
    [ queuechars $@ bounds ] 2literal POSTPONE 2literal
    POSTPONE do POSTPONE i POSTPONE c@ POSTPONE queue[ ; immediate
  : ]emails ( -- )
    POSTPONE ]queue POSTPONE loop POSTPONE /queue ; immediate

is built on queue[ ... ]queue

  : queue[ ( c -- )
    POSTPONE open-queue POSTPONE input-path POSTPONE file[
    POSTPONE -H? POSTPONE if ; immediate
  : ]queue ( -- )
    POSTPONE then POSTPONE ]file ; immediate

is built on file[ ... ]file

  : file[ ( path-fid -- )
    POSTPONE dir[  POSTPONE file?  POSTPONE if ; immediate
  : ]file ( -- )
    POSTPONE then  POSTPONE ]dir ; immediate

is built on dir[ ... ]dir

  : dir[ ( path-fid -- )
    POSTPONE >r
    POSTPONE begin POSTPONE r@ POSTPONE getdents POSTPONE -getdents-error
    POSTPONE DUP POSTPONE 0> POSTPONE while POSTPONE :getdents POSTPONE ! POSTPONE dirents[ ; immediate
  : ]dir ( -- )
    POSTPONE ]dirents POSTPONE repeat POSTPONE r> POSTPONE drop ;
  immediate

is built on dirents[ ... ]dirents

  \ dirents has already been called and the buffer has content
  : dirents[ ( -- )
    POSTPONE 'getdents POSTPONE >o POSTPONE begin ; immediate
      ( -- )  \ the current object is linux-dirent
  : ]dirents ( -- )
    POSTPONE next POSTPONE empty? POSTPONE until POSTPONE o> ;
  immediate


Without testing, I think the following is about what this would look
like in an xt-passing style:

  : email ( -- )  matched off
    [: rules-apply? if purge  matched ++ then ;] do-emails
    matched ? ." emails purged" cr ;
  
  : do-emails { xt -- }
    [ queuechars $@ bounds ] 2literal do
       xt i c@ do-queue
    loop ;
  
  : do-queue ( xt c -- )
    open-queue input-path
    [: ( xt ) >r -H? if r@ execute then r> ;] swap do-files
    ( xt ) drop ;
  
  : do-files ( xt path-fid -- )
    [: ( xt ) >r file? if r@ execute then r> ;] swap do-dir
    ( xt ) drop ;
  
  : do-dir ( xt path-fid -- )
    >r begin r@ getdents -getdents-error dup 0> while
      :getdents !
      ( xt ) dup >r do-dirents r>
    repeat r> drop ;
  
  : do-dirents ( xt -- )
    'getdents >o >r begin
      r@ execute
    next empty? until r> drop o> ;


Is that ... better?  For all that it isn't littered with POSTPONE,
it seems more complex.  I would feel more uncomfortable about having
all of this in an speed-critical loop. (Not that this is one; the
unlinkat() syscalls in PURGE completely dominate the time spent by
the loop.)

It seems to have been easier to see how the POSTPONEs collapsed into
the user of emails[ ... ]emails, than to follow the original
quotation's path through all this.  (ciforth's SEE doesn't produce
great results on the POSTPONE code, but probably it would be pretty
clear with gforth's SEE)

How would it be improved with XT and YC ?


-- Julian

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

#45208

On Saturday, January 30, 2016 at 12:11:24 PM UTC+2, Julian Fondren wrote:
> On Friday, January 29, 2016 at 1:19:28 AM UTC-6, humptydumpty wrote:
> > \ Example:
> > : downcount     dup . 1- dup 0 >= IF xt dup ELSE 0 THEN ;
> > 10 ' downcount dup YC drop
> > 
> > ---
> > *Factored* loop. Small. Beautiful. Deserves to be a primitive.
> 
> Hmm.  Well, take this code (please don't say, "no thank you!"):
> 
>   variable matched
>   : email ( -- )  matched off
>     emails[ rules-apply? if purge  matched ++ then ]emails
>     matched ? ." emails purged" cr ;
> 
> Where emails[ ... ]emails
> 
>   : emails[ ( -- )
>     [ queuechars $@ bounds ] 2literal POSTPONE 2literal
>     POSTPONE do POSTPONE i POSTPONE c@ POSTPONE queue[ ; immediate
>   : ]emails ( -- )
>     POSTPONE ]queue POSTPONE loop POSTPONE /queue ; immediate
> 
> is built on queue[ ... ]queue
> 
>   : queue[ ( c -- )
>     POSTPONE open-queue POSTPONE input-path POSTPONE file[
>     POSTPONE -H? POSTPONE if ; immediate
>   : ]queue ( -- )
>     POSTPONE then POSTPONE ]file ; immediate
> 
> is built on file[ ... ]file
> 
>   : file[ ( path-fid -- )
>     POSTPONE dir[  POSTPONE file?  POSTPONE if ; immediate
>   : ]file ( -- )
>     POSTPONE then  POSTPONE ]dir ; immediate
> 
> is built on dir[ ... ]dir
> 
>   : dir[ ( path-fid -- )
>     POSTPONE >r
>     POSTPONE begin POSTPONE r@ POSTPONE getdents POSTPONE -getdents-error
>     POSTPONE DUP POSTPONE 0> POSTPONE while POSTPONE :getdents POSTPONE ! POSTPONE dirents[ ; immediate
>   : ]dir ( -- )
>     POSTPONE ]dirents POSTPONE repeat POSTPONE r> POSTPONE drop ;
>   immediate
> 
> is built on dirents[ ... ]dirents
> 
>   \ dirents has already been called and the buffer has content
>   : dirents[ ( -- )
>     POSTPONE 'getdents POSTPONE >o POSTPONE begin ; immediate
>       ( -- )  \ the current object is linux-dirent
>   : ]dirents ( -- )
>     POSTPONE next POSTPONE empty? POSTPONE until POSTPONE o> ;
>   immediate
> 
> 
> Without testing, I think the following is about what this would look
> like in an xt-passing style:
> 
>   : email ( -- )  matched off
>     [: rules-apply? if purge  matched ++ then ;] do-emails
>     matched ? ." emails purged" cr ;
>   
>   : do-emails { xt -- }
>     [ queuechars $@ bounds ] 2literal do
>        xt i c@ do-queue
>     loop ;
>   
>   : do-queue ( xt c -- )
>     open-queue input-path
>     [: ( xt ) >r -H? if r@ execute then r> ;] swap do-files
>     ( xt ) drop ;
>   
>   : do-files ( xt path-fid -- )
>     [: ( xt ) >r file? if r@ execute then r> ;] swap do-dir
>     ( xt ) drop ;
>   
>   : do-dir ( xt path-fid -- )
>     >r begin r@ getdents -getdents-error dup 0> while
>       :getdents !
>       ( xt ) dup >r do-dirents r>
>     repeat r> drop ;
>   
>   : do-dirents ( xt -- )
>     'getdents >o >r begin
>       r@ execute
>     next empty? until r> drop o> ;
> 
> 
> Is that ... better?  For all that it isn't littered with POSTPONE,
> it seems more complex.  I would feel more uncomfortable about having
> all of this in an speed-critical loop. (Not that this is one; the
> unlinkat() syscalls in PURGE completely dominate the time spent by
> the loop.)
> 
> It seems to have been easier to see how the POSTPONEs collapsed into
> the user of emails[ ... ]emails, than to follow the original
> quotation's path through all this.  (ciforth's SEE doesn't produce
> great results on the POSTPONE code, but probably it would be pretty
> clear with gforth's SEE)
> 
> How would it be improved with XT and YC ?
> 
> 
> -- Julian

Hi!

From my humble understanding of yours cod I'll do sometrhing like:

: YCC  ( xt HiLim StartIdx -- )  DO I swap execute LOOP drop ;

        DEFER payload
: entry        ( -- )
  file? IF
        -H? IF
               payload 
         THEN
  THEN
  next empty? IF 0 ELSE XT dup THEN
;
: dirents       ( -- )
  'getdents >o  ['] entry dup YC  o>
;
: dir		( path-fid -- path-fid )
  >R
  R@ getdents -getdents-error  dup 0>
  IF    :getdents ! dirents  R> XT dup
  ELSE	R> 0  THEN
;
: (emails)      ( u -- )
  c@ open-queue input-path ['] dir dup YC drop
  XT
;
: emails	( -- )
 ['] (emails) queuechars $@ bounds YCC /queue
;

          VARIABLE Matched
: email           ( xt -- )
  IS payload 
  Matched off
  emails
  Matched ? ." emails purged" cr
;
:noname  rules-apply? IF purge Matched ++  THEN;  email

Enjoying forth,
humptydumpty

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

#45211 — Re: : YC ( .. xt xt |0 -- .. ) BEGIN WHILE execute REPEAT ;

Julian Fondren wrote:

>   variable matched
>   : email ( -- )  matched off
>     emails[ rules-apply? if purge  matched ++ then ]emails
>     matched ? ." emails purged" cr ;
> 
> Where emails[ ... ]emails
> 
>   : emails[ ( -- )
>     [ queuechars $@ bounds ] 2literal POSTPONE 2literal
>     POSTPONE do POSTPONE i POSTPONE c@ POSTPONE queue[ ; immediate
>   : ]emails ( -- )
>     POSTPONE ]queue POSTPONE loop POSTPONE /queue ; immediate
> 
> is built on queue[ ... ]queue
> 
>   : queue[ ( c -- )
>     POSTPONE open-queue POSTPONE input-path POSTPONE file[
>     POSTPONE -H? POSTPONE if ; immediate
>   : ]queue ( -- )
>     POSTPONE then POSTPONE ]file ; immediate
> 
> is built on file[ ... ]file
> 
>   : file[ ( path-fid -- )
>     POSTPONE dir[  POSTPONE file?  POSTPONE if ; immediate
>   : ]file ( -- )
>     POSTPONE then  POSTPONE ]dir ; immediate
> 
> is built on dir[ ... ]dir
> 
>   : dir[ ( path-fid -- )
>     POSTPONE >r
>     POSTPONE begin POSTPONE r@ POSTPONE getdents POSTPONE -getdents-error
>     POSTPONE DUP POSTPONE 0> POSTPONE while POSTPONE :getdents POSTPONE ! POSTPONE dirents[ ; immediate
>   : ]dir ( -- )
>     POSTPONE ]dirents POSTPONE repeat POSTPONE r> POSTPONE drop ;
>   immediate
> 
> is built on dirents[ ... ]dirents
> 
>   \ dirents has already been called and the buffer has content
>   : dirents[ ( -- )
>     POSTPONE 'getdents POSTPONE >o POSTPONE begin ; immediate
>       ( -- )  \ the current object is linux-dirent
>   : ]dirents ( -- )
>     POSTPONE next POSTPONE empty? POSTPONE until POSTPONE o> ;
>   immediate


Ruby:

Let's say that we want to "purge" files in the current directory
that are larger than 40,000 bytes.

To purge, we'll simply move the file to the subdirectory named
"purged".

def purge_files path
  Dir[path].select{|x| File.file? x}.
  each{|file_name|
    if yield(file_name)
      File.rename(file_name, "purged/#{file_name}")
    end}
end

purge_files("*"){|f| File.size(f) > 40_000}


-- 
Amazon bans book.  After nearly a month on the site, all traces of the book and
its 80 reviews have been removed.
http://jamesfetzer.blogspot.com/2015/11/debunking-sandy-hook-debunkers-5.html
https://www.youtube.com/watch?v=EEl_1HWFRfo

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

#45216 — Re: : YC ( .. xt xt |0 -- .. ) BEGIN WHILE execute REPEAT ;

On Sunday, January 31, 2016 at 4:14:25 AM UTC-6, WJ wrote:
> Ruby:
> 
> Let's say that we want to "purge" files in the current directory
> that are larger than 40,000 bytes.
> 
> To purge, we'll simply move the file to the subdirectory named
> "purged".
> 
> def purge_files path
>   Dir[path].select{|x| File.file? x}.
>   each{|file_name|
>     if yield(file_name)
>       File.rename(file_name, "purged/#{file_name}")
>     end}
> end
> 
> purge_files("*"){|f| File.size(f) > 40_000}

  $ ls
  purged/  purge.rb
  $ dd if=/dev/zero of=big bs=1000 count=41
  41+0 records in
  41+0 records out
  41000 bytes (41 kB) copied, 0.000299873 s, 137 MB/s
  $ ruby purge.rb 
  $ find 
  .
  ./purged
  ./purged/big
  ./purge.rb
  $ ln -s purged/big big
  $ ruby purge.rb 
  $ find
  .
  ./purged
  ./purged/big
  ./purge.rb
  $ file purged/big
  purged/big: broken symbolic link to purged/big

Given a symlink, this tests the size of the file the symlink
points to -- and then moves the symlink, if that file is large
enough.  If there's already a file at the destination of the
rename, then that file is clobbered.

Under Linux, the renameat2 system call accepts a flag that'll
prevent you from clobbering a file on a rename.  If you can't
use that, your alternatives are A) to live with the race
conditions involved with separately testing for a file's
existence and renaming a file, or B) forking and asking
something else (like /usr/bin/mv) to do the renameat2 for you.

ruby is reasonable though with its syscalls when it finally
gets around to executing your program (before it gets to your
program, it wanders around inspecting gems, and it opens some
pipes and spawns a thread).  It doesn't stat files twice, once
for the size test and once for the filetype test. If both are
removed (replaced f.e. with tests against the filename) it
doesn't stat the files at all.

(My perl competitor has loads of unnecessary stats and ioctls,
with no requirement for them in the code itself.)

But ruby builds a giant list of files just to throw it away,
and it does so before your program can do anything with the
files.

In an empty directory:

  $ /usr/bin/time -f "real %e\nuser %U\nsys %S\nmem %M kB\n" ruby ../purge.rb
  real 0.03
  user 0.03
  sys 0.00
  mem 8996 kB

In a directory with 300k files:

  $ /usr/bin/time -f "real %e\nuser %U\nsys %S\nmem %M kB\n" ruby purge.rb
  real 0.37
  user 0.27
  sys 0.10
  mem 32520 kB

That's not a big deal.  It's just kinda lame.


Anyway, I don't actually want a stat, but for completeness will
probably add one anyway.  It'd look something like this, with
unwritten words in all caps:

  files[ LSTAT FILE.SIZE 40000 > ?rm ]files

( PURGE is an email-specific word that removes three separate
files from the exim spool directory, per email removed.)


-- Julian

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

#45217 — Re: : YC ( .. xt xt |0 -- .. ) BEGIN WHILE execute REPEAT ;

On Sunday, January 31, 2016 at 10:04:16 AM UTC-6, Julian Fondren wrote:
>   files[ LSTAT FILE.SIZE 40000 > ?rm ]files

Incidentally, the entire program would really just be the
following definition in a file by itself:

  : fourty-thousand-bytes-is-enough-for-anybody ( -- )
    "." open-path
    file[ LSTAT FILE.SIZE 40000 > ?rm ]file ;

And would be compiled to an executable with

  ./lina -c 40000-limiter.fs

The first thing my build system does is to build the Forth the
app needs.  The probably doesn't sound like a big deal, but it
really does a number on boilerplate.


-- Julian

[toc] | [prev] | [standalone]

Page 2 of 2 — ← Prev page 1 [2]

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

csiph-web