perl and forth

if you're look at the faq for blogging - i think it says somewhere no confessions.

certainly my confessions would be ( how easy is it to connect to a perl service ).

O I am sure that perl and forth are different --- yet I am a bit confused exactly

about how --- and can you break that thin gray line?

In fact is there a thin grey line?

I just think that if there is a thin grey line it something like ---

///   how is some old fashion notion --- a new fashion notion ///

like a cycling --- tensor - ( rotation ) ..

a link somewhere .

I have a lots to confess - so I won't.

Note: this somewhat anticpates itsy - vs parrot forth sometime in the future of this draft
which makes it almost daft.....

Forth on the Fifth

I was shooting for a forth on the fourth --- but, no way.  I guess I might have to wait
for another " Fourth/fourth "  ??????

Anyway, futzing quite along, I create this new object - which I need to futz with yet more
but just so I'm close to the fourth --- this is it:

\ sq-obj
object class pre-sq
   method set-sq
   method print-sq
   method load-sq
class;

pre-sq class sq-obj
     cell var offset
     cell var index1-1
     cell var index1-2
     cell var index2-1
     cell var index2-2
     cell var square-no
how:
: set-sq ( n -- )
     dup square-no ! 1 = if 0 offset ! 3 index1-1 ! 0 index1-2 ! 3 index2-1 ! 0 index2-2 ! else
         square-no @   2  = if 3 offset ! 3 index1-1 ! 0 index1-2 ! 3 index2-1 ! 0 index2-2 ! else
          square-no @  3 = if 6 offset ! 3 index1-1 ! 0 index1-2 ! 3 index2-1 ! 0 index2-2 ! else
         square-no @ 4  = if 0 offset ! 6 index1-1 ! 3 index1-2 ! 3 index2-1 ! 0 index2-2 ! else
          square-no @  5 = if 3 offset ! 3 index1-1 ! 0 index1-2 ! 3 index2-1 ! 0 index2-2 ! else
\  bologna, ketchup, and lettuce
           square-no @ 6  if 6 offset ! 3 index1-1 ! 0 index1-2 ! 3 index2-1 ! 0 index2-2 ! else
           square-no @ 7 = if 0 offset ! 9 index1-1 ! 6 index1-2 ! 3 index2-1 ! 0 index2-2 ! else
          square-no @  8  = if 3 offset ! 9 index1-1 ! 6 index1-2 ! 3 index2-1 ! 0 index2-2 ! else
          square-no @ 9 = if 6 offset ! 9 index1-1 ! 6 index1-2 ! 3 index2-1 ! 0 index2-2 ! then
                      then then then then then then then ;

: print-sq ( n -- ) set-sq
       index1-1 @ index1-2 @  ?do i line-no-here !
       index1-1 @ index1-2 @ ?do i column-calc2 + offset-here @ + c@ emit
       loop loop ;

class;
\  end class

And it's also interesting to note that index2-1 is alway 3 and index2-2 is always 0 ???

Pattern Matching

I am not sure what I'm looking at -------

Now back to my collector obsessions ---

Here it is modified to use the oof - array and that does somewhat reduce the size and complexity ---

Now the following will demonstrate an interesting point ---- the process of removing errors - when I change course in what I'm doing --- In this case I had the clever idea about changing state because I was eliminating some other code ( specifically - nzp@ )

Anyone, one more pattern to match:

\-- find not contained in one array and put it into a second array

\-- for sudoku solver

\-- arraycollector.fs

include oofarray.fs

create vbp_ 9 cells allot

create vbpx_ 9 cells allot

42 42 42 42 42 42 42 42 42 9 int new[] 9 array : vbp

42 42 42 42 42 42 42 42 42 9 int new[] 9 array : vbpx

obj class precollector

        method nextval@ 

   method nextval!

   method sv-next@

   method sv-next!

   method nv@

   method nv!

   method dump-collection

   method nextval-prt

   method reset-all

   method sv-nextval

   method reset-nextval

   method check-unique

   method store-input

   method backup-current-vpb

   method restore-current-vpb

   method backup-current-vpbx

   method restore-current-vpbx

   method backup-current

   method restore-current

   method nextvalinc

   method mode-set-1

   method mode-init

   method mode-get

   method mode-get-prt 

   method mode-swt

   method check-possible 

   method store-possible-lcl 

   method find-possible-lcl

   method get-first

   method set-this-collection-max

   method get-this-collection-max

   method process-empty-space

class;

precollector class arraycollector

     cell var nextval

     cell var sv-next

     cell var inpv

     cell var dupr 

     cell var lclvbp

     cell var lclvbpx

     cell var mode

     cell var fnd

     cell var collection-max

how:

: store-cell board line-no + col-no 9 * + nvp@ ! ;

: nextval@ nextval @ ;

: nextval! nextval ! ;

: nextvalinc nextval@ 1 + nextval! ;

: sv-next@ sv-next @ ;

: sv-next! sv-next ! ;

: nv!  nextval@ 1 - vbp ! ; 

: nv@  nextval@ 1 - vbp @ ;

: nvp!  nextval@ 1 - vpbx ! ; 

: nvp@  nextval@ 1 - vpbx @ ;

: reset-nextval sv-next@ nextval! ;

: sv-nextval nextval@ sv-next! ;

: nextval-prt cr s" nextval = " type nextval@ . ;

: reset-all 10 1 ?do i nextval! 42 nv! loop 1 nextval ! ;

: dump-collection sv-nextval 10 1 ?do i nextval! nv@ dup 10 < if . else emit then s" - " type loop reset-nextval ;

: check-unique inpv !  0 dupr ! sv-nextval

                     10 1 ?do i nextval! nv@ inpv @ = if 1 dupr ! leave then loop 

                        reset-nextval dupr @ ;

: get-first sv-nextval 1 nextval ! nv@ reset-nextval ;

: store-input check-unique 0 = if inpv @ nv! nextval@ 1 + nextval! then ;

: check-possible nextpval @ 1 - ;

: store-possible nvp! nextpval @ 1 + nextpval ! ;

: find-possible 0 fnd ! 10 1 ?do i dup check-val ! nextval! nv@ check-val @ = if 1 fnd ! then loop fnd @ 0 = if store-possible then ;

class;

Dipsy Doodle

This is actually about array using oof ---

or maybe oof arrays --- technically I'm not sure ---

for historical reference, this could be helpful -----

Covering Tommy Dorsey's 1937 hit, Larry Clinton & His Orchestra perform the titular big-band classic in the soundie Dipsy Doodle (1943). This number was often covered, notably by Ella Fitzgerald with Chick Webb's orchestra, & even by Bill Haley & the Comets, besides being goofed up by Homer & Jethro.
from : http://www.weirdwildrealm.com/f-larry-clinton.html



From some where - or maybe here - I acquired on oof array --- what I'm talking about :

https://github.com/BlastarIndia/Blastarix/blob/master/gforth-0.7.2/oofsampl.fs

and I created this " beasty " :

/ oofarray.fs
include oof.fs
: i! postpone ! ; immediate
: i@ postpone @ ; immediate
object class data \ abstract data class
        cell var ref \ reference counter
        method ! method @ method .
        method null method atom? method #
how: : atom? ( -- flag ) true ;
        : # ( -- n ) 0 ;
        : null ( -- addr ) new ;
class;
\ Data structures: int 30apr93py

data class int
        cell var value
how: : ! value i! ;
        : @ value i@ ;
        : . @ 0 .r ;
        : init ( data -- ) ! ;
        : dispose -1 ref +!
          ref i@ 0> 0= IF super dispose THEN ;
        : null 0 new ;
class;

\ Data sturctures: array 30apr93py

data class array
        data [] container
        cell var range
how: : ! container ! ;
        : @ container @ ;
        : . [char] [
                # 0 ?DO emit I container . [char] , LOOP drop ." ]" ;
        : init ( data n -- ) range i! bind container ;
        : dispose -1 ref +! ref i@ 0> 0=
          IF # 0 ?DO I container dispose LOOP
              super dispose THEN ;
        : null nil 0 new ;
        : # range i@ ;
        : atom? false ;
class;
\
\1 3 5 7 9 5 int new[] 5 array : lotus  ok
\lotus . [1,3,5,7,9] ok
\1 lotus @ . 3  ok
\cr 5 1 lotus ! lotus .

more latter - on this --- and where it's going ----

the Parrot and the Forth

Annoncement 2004 - pir perl , ( perl one pir two perl one pir two )
http://www.nntp.perl.org/group/perl.perl6.internals/2004/10/msg26380.html

Yes, and you might wonder - about what exactly all this means ---
Current details of course are available ---
and so - more details available ----


https://github.com/parrot/forth/commit/fe606b4ed478c1d21979d84b521b601ad7fd6fda

a preview of collector collector

So I have not yet completed an algorithm to search for the illusive
singleton in a collector collector --- but I have faith that it will
appear on the horizon --- Simply what I am trying to do is search
a succession of collectors --- ( 1.first elimate uniques til none found )
then eliminate the uniques - go back to  ) - find singletons - by searching
through each collector beginning with first value in first collector - and searching
for a duplicate - in another collector.

more from squareobj

the square object is evolving - to this creature :::::

\ sub square
\ https://groups.google.com/forum/#!topic/comp.lang.forth/_MAttQoY3pw
cr s" loading sub section squares " type
vbp collector : mycollector
object class square
     method check-terr1
     method check-terr2
     method check-terr3
     method check-blkn1
     method check-blkn2
     method check-blkn3
     method check-sq-1
     method check-sq-2
     method check-sq-3
     method check-sq-4
     method check-sq-5
     method check-sq-6
     method check-sq-7
     method check-sq-8
     method check-sq-9
     method check-sq

     method column-calc2
     method sq1-print
     method sq2-print
     method sq3-print
     method sq4-print
     method sq5-print
     method sq6-print
     method sq7-print
     method sq8-print
     method sq9-print

     method sq1-load
     method sq2-load
     method sq3-load
     method sq4-load
     method sq5-load
     method sq6-load
     method sq7-load
     method sq8-load
     method sq9-load
    
     method sq-load
     method init-sq-cycle  
     method next-square
     method square-get-anchor-row
     method square-get-anchor-row
     method square-get-anchor
     method row-no-inc
     method col-no-inc

     mthod next-cell-in-square
     method row-no-here@
     method col-no-here@

class;

square class squareobj

      cell var terr
      cell var blkn
      cell var col-no-here
      cell var line-no-here
      cell var col-no-anchor
      cell var line-no-anchor
      cell var board-addr-here
      cell var width-here
      cell var offset-here
      cell var sq-no
how :
: check-terr1 col-no-here @ < 3 if 1 terr ! then ;
: check-terr2 col-no-here @  3 6 within if 2 terr ! then ;
: check-terr3 col-no-here @ 6 9 within  if 3 terr ! then ;

: check-blkn1 line-no-here @ < 3 if 1 blkn ! then ;
: check-blkn2 line-no-here @ 3 6 within if 2 blkn ! then ;
: check-blkn3 line-no-here @ 6 9 within if 3 blkn ! then ;

: check-sq-1 terr @ 1 = if blkn @ 1 = if 1 else 0 then else 0 then ;

: check-sq-2 terr @ 1 = if blkn @ 2 = if 2 else 0 then else 0 then ;

: check-sq-3 terr @ 1 = if blkn @ 3 = if 3 else 0 then else 0 then ;

: check-sq-4 terr @ 2 = if blkn @ 1 = if 4 else 0 then else 0 then ;

: check-sq-5 terr @ 2 = if blkn @ 2 = if 5 else 0 then else 0 then ;

: check-sq-6 terr @ 2 = if blkn @ 3 = if 6 else 0 then else 0 then ;

: check-sq-7 terr @ 3 = if blkn @ 1 = if 7 else 0 then else 0 then ;

: check-sq-8 terr @ 3 = if blkn @ 2 = if 8 else 0 then else 0 then ;

: check-sq-9 terr @ 3 = if blkn @ 3 = if 9 else 0 then else 0 then ;

: check-sq col-no-here ! row-no-here !
     check-terr1
     check-terr2
     check-terr3
     check-blkn1
     check-blkn2
     check-blkn3    
     check-sq-1
     check-sq-2
     check-sq-3
     check-sq-4
     check-sq-5
     check-sq-6
     check-sq-7
     check-sq-8
     check-sq-9
        + + + + + + + + ;

: store-input-here mycollector store-input ;

: column-calc2 board-addr-here line-no-here @ width-here * + ;
\  offset-here
: sq1-print 3 0 ?do i line-no-here ! 3 0 ?do i column-calc2 + c@ emit loop loop ;
:  sq2-print 3 offset-here ! 3 0 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ emit loop loop ;
: sq3-print 6 offset-here ! 3 0 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ emit loop loop ;

: sq4-print 6 3 ?do i line-no-here ! 3 0 ?do i column-calc2 + c@ emit loop loop ;
:  sq5-print 3 offset-here ! 6 3 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ emit loop loop ;
: sq6-print 6 offset-here ! 6 3 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ emit loop loop ;

: sq7-print 9 6 ?do i line-no-here ! 3 0 ?do i column-calc2 + c@ emit loop loop ;
:  sq8-print 3 offset-here ! 9 6 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ emit loop loop ;
: sq9-print 6 offset-here ! 9 6 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ emit loop loop ;

: sq1-load 3 0 ?do i line-no-here ! 3 0 ?do i column-calc2 + c@ 42 <> if store-input-here then loop loop ;
:  sq2-load 3 offset-here ! 3 0 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ 42 <> if store-input-here then loop loop ;
: sq3-load 6 offset-here ! 3 0 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ 42 <> if store-input-here then loop loop ;

: sq4-load 6 3 ?do i line-no-here ! 3 0 ?do i column-calc2 + c@ 42 <> if store-input-here then loop loop ;
:  sq5-load 3 offset-here ! 6 3 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ 42 <> if store-input-here then loop loop ;
: sq6-load 6 offset-here ! 6 3 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ 42 <> if store-input-here then loop loop ;

: sq7-load 9 6 ?do i line-no-here ! 3 0 ?do i column-calc2 + c@ 42 <> if store-input-here then loop loop ;
:  sq8-load 3 offset-here ! 9 6 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ 42 <> if store-input-here then loop loop ;
: sq9-load 6 offset-here ! 9 6 ?do i line-no-here ! 3 0 ?do i column-calc2 + offset-here @ + c@ 42 <> if store-input-here then loop loop ;

: square-load sq-no !   sq-no @ 1 = if sq1-load else
                        sq-no @ 2 = if sq2-load else
                        sq-no @ 3 = if sq3-load else
                        sq-no @ 4 = if sq4-load else
                        sq-no @ 5 = if sq5-load else
                        sq-no @ 6 = if sq6-load else
                        sq-no @ 7 = if sq7-load else
                        sq-no @ 8 = if sq8-load else
                        sq-no @ 9 = if sq9-load then
                         then then then then then then then then ;

: init-sq-cycle 1 terr ! 1 blkn ! ;

: next-square blkn @ 1 + 4 = if terr @ 3 < if terr @ 1 + terr ! 1 blkn ! then then ;

/ the following will return col-no and row-no of "top-left" cell -
/ based on blkn and terr
/ 1 1 = col1 row1
/ 1 2 = col4 row1
/ 1 3 = col7 row1
/ 2 1 = col1 row4
/ 2 2 = col4 row4
/ 2 3 = col7 row4
/ 3 1 = col1 row7
/ 3 2 = col4 row7
/ 3 3 = col7 row7

: square-get-anchor-row terr @ 1 = if 1 row-no-anchor ! else terr @ 2 = if 4 row-no-anchor ! else terr @ 3 = if 7 row-no-anchor ! then then then ;
: square-get-anchor-col blkn @ 1 = if 1 line-no-anchor ! else blkn @ 2 = if 4 line-no-anchor ! else blkn @ 3 = if 7 line-no-anchor ! then then then ;
: square-get-anchor square-get-anchor-col line-no-anchor @ col-no-here ! square-get-anchor-row row-no-anchor @ row-no-here ! ;
: row-no-inc row-no-here @ 1 + row-no-here ! ;
: col-no-inc col-no-here @ 1 + col-no-here ! ;

: next-cell-in-square row-no-inc row-no-here @  row-no-anchor @ - 3 = if row-no-anchor @ row-no-here ! col-no-inc then ;
: row-no-here@ row-no-here @ ;
: col-no-here@ col-no-here @ ;
: init cr s" creating squareobj " type ;


class;