Friday, June 27, 2014

more sudoku



I wonder if I doing this to save time ?

Anyway - here is some revisions to objects from before ---- no laughs ----
still incomplete -


\ collector.fs
cr s" loading collector.fs " type cr

include oof.fs

\  we reserve a set of memory locations to back
\  up the collection state at any given time :
\  this is passed to the collection object in init

create vbp 9 cells allot
create vbpx 9 cells allot

object class precollect
   method @1
   method !1
   method @2
   method !2
   method @3
   method !3
   method @4
   method !4
   method @5
   method !5
   method @6
   method !6
   method @7
   method !7
   method @8
   method !8
   method @9
   method !9
   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
   method restore-current
   method nextvalinc
   method mode-set-1
   method mode-init
   method mode-get
   method mode-get-prt
   method mode-swt
class;

precollect class collector
     cell var v1
     cell var v2
     cell var v3
     cell var v4
     cell var v5
     cell var v6
     cell var v7
     cell var v8
     cell var v9
     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
how:

: @1 v1 @ ;
: !1 v1 ! ;
: @2 v2 @ ;
: !2 v2 ! ;
: @3 v3 @ ;
: !3 v3 ! ;
: @4 v4 @ ;
: !4 v4 ! ;
: @5 v5 @ ;
: !5 v5 ! ;
: @6 v6 @ ;
: !6 v6 ! ;
: @7 v7 @ ;
: !7 v7 ! ;
: @8 v8 @ ;
: !8 v8 ! ;
: @9 v9 @ ;
: !9 v9 ! ;

: nextval@ nextval @ ;
: nextval! nextval ! ;
: nextvalinc nextval@ 1 + nextval! ;
: sv-next@ sv-next @ ;
: sv-next! sv-next ! ;

: nv!  nextval@ 1 = if !1 else nextval@
                2 = if !2 else nextval@
                3 = if !3 else nextval@
                4 = if !4 else nextval@
                5 = if !5 else nextval@
                6 = if !6 else nextval@
                7 = if !7 else nextval@
                8 = if !8 else nextval@

                9 = if !9
                then then then then then then then then then ;

: nv@  nextval@ 1 = if @1 else nextval@
                2 = if @2 else nextval@
                3 = if @3 else nextval@
                4 = if @4 else nextval@
                5 = if @5 else nextval@
                6 = if @6 else nextval@
                7 = if @7 else nextval@
                8 = if @8 else nextval@

                9 = if @9
                then then then then then then then then then ;

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

: store-input check-unique 0 = if inpv @ nv! nextval@ 1 + nextval! then ;
: backup-current-vpb sv-nextval 9 0 ?do i nextval! 1 + nv@ lclvbp nextval@ + ! loop reset-nextval ;

: restore-current-vpb sv-nextval 9 0 ? do i dup nextval! mode-get 0 = if lclvbp + @ else lclvbp + @ then nextvalinc nv! loop reset-nextval ;

: backup-current-vpbx sv-nextval 9 0 ?do i nextval! 1 + nv@ lclvbpx nextval@ + ! loop reset-nextval ;

: restore-current-vpbx sv-nextval 9 0 ? do i dup nextval! mode-get 0 = if lclvbpx + @ else lclvbpx + @ then nextvalinc nv! loop reset-nextval ;

: backup-current mode-get 0 = if backup-current-vpb else backup-current-vpbx then ;
: restore-current mode-get 0 = if restore-current-vpb else restore-current-vpbx then ;


: mode-set-1 1 mode ! ;
: mode-init  0 mode ! ;
: mode-get   mode @ ;
: mode-get-prt mode @ . ;
: mode-swt mode-get = 0 if mode-set-1 else mode-init then ;

: check-possible mode-init backup-current mode-set-1 restore-current nextval @ 1 - mode-int restore-current ;


: store-possible-lcl 1 fnd ! mode-init backup-current mode-set-1 restore-current np! nextval @ 1 + nextval ! backup-current mode-init restore-current ;

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


\ in order for find possible to work the mode of the object must change -
\ because - possible values end up in a different container -
\ to make this simpiliar a change must be made to the backup and restore ----
\  so that if the mode is 0 it goes to lclvbp and if 1 if goes to lclvbpx
\  initially in find possible the mode is 0 then you do a backup - then change mode to 1 store and do a backup - the mode 0 restore -
\  to sent things back.

: init lclvbpx ! lclvbp ! reset-all cr s" init collector " type cr ;



class;

cr s" collector class loaded " type cr

collector : mycollector1
collector : mycollector2
collector : mycollector3
collector : mycollector4
collector : mycollector5
collector : mycollector6
collector : mycollector7
collector : mycollector8
collector : mycollector9

collector class collectorcollector
   cell var collector-pointer
class;

No comments:

Post a Comment