incomplete untested forth sudoku solver

This is an incomplete, untested, and, un-commented, and undocumented
sudoku solver in forth.   Not only that but it's actually amusing if
you read between the lines.   Of course, that my cause you to experience
excruciating headaches and possibly hallucinations .......
Remember if you use this code and you or your computer or your
family or friends begin to experience " black outs " it is not the direct
responsibility of the author, his computer, his family or his friends.

and thanks for the fish ....


9 constant width
81 constant size
42 constant empty
variable board size allot
board size empty fill
( read file into buffer )
variable buff 1000 allot
0 Value fh
s" sud_puzzle1" r/o open-file throw to fh

buff 1000 fh read-file throw drop
fh close-file throw
: buff-to-board
    size 0 ?do
buff i + @ board i + ! loop ;

variable line-no


: board-fetch
    board width line-no @ * + ;



: print-line
     line-no !
    width 0 ?do
board-fetch  i +   c@ emit loop ;

: print-board
    cr
    width 0 ?do
i print-line cr loop ;

: test-aster 42 = if s" eq " type else s" not eq " type then ;


: check-sq-1 col-no @ 3 < and line-no @ 3 < if 1  else 0 then ;

: check-sq-2 col-no @ 3 < and line-no @ 3  6 within if 2  else 0 then ;

: check-sq-3 col-no @ 3 < and line-no @ 6  9 within if 3  else 0 then ;

: check-sq-4 col-no @ 3  6 within and line-no @ 3 < if 4  else 0 then ;

: check-sq-5 col-no @ 3  6 within and line-no @ 3  6 within if 5  else 0 then ;

: check-sq-6 col-no @ 3 6 within and line-no @ 6  9 within if 6  else 0 then ;

: check-sq-7 col-no @ 6  9 within and line-no @ 3 < if 7  else 0 then ;

: check-sq-8 col-no @ 6 9 within and line-no @ 3 6 within if 8  else 0 then ;

: check-sq-9 col-no @ 6 9 within and line-no @ 6 9 within if 9  else 0 then ;


variable terr
variable blkn

: check-terr1 col-no @ < 3 if 1 terr ! then ;
: check-terr2 col-no @  3 6 within if 2 terr ! then ;
: check-terr3 col-no @ 6 9 within  if 3 terr ! then ;

: check-blkn1 line-no @ < 3 if 1 blkn ! then ;
: check-blkn2 line-no @ 3 6 within if 2 blkn ! then ;
: check-blkn3 line-no @ 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 ! line-no !
     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
        + + + + + + + + ;


variable v1
variable v2
variable v3
variable v4
variable v5
variable v6
variable v7
variable v8
variable v9

variable vp1
variable vp2
variable vp3
variable vp4
variable vp5
variable vp6
variable vp7
variable vp8
variable vp9

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


: @p1 vp1 @ ;
: !p1 vp1 ! ;
: @p2 vp2 @ ;
: !p2 vp2 ! ;
: @p3 vp3 @ ;
: !p3 vp3 ! ;
: @p4 vp4 @ ;
: !p4 vp4 ! ;
: @p5 vp1 @ ;
: !p5 vp1 ! ;
: @p6 vp6 @ ;
: !p6 vp6 ! ;
: @p7 vp7 @ ;
: !p7 vp7 ! ;
: @p8 vp8 @ ;
: !p8 vp8 ! ;
: @p9 vp9 @ ;
: !p9 vp9 ! ;



variable nextval
variable sv-nextval
variable nextavailable
variable inpv
variable dupr

: nextval@ nextval @ ;
: nextval! nextval ! ;
: sv-nextval@ sv-nextval @ ;
: sv-nextval! sv-nextval ! ;


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

: nvp!  nextpval@ 1 = if !p1 else nextpval@
                2 = if !p2 else nextpval@
                3 = if !p3 else nextpval@
                4 = if !p4 else nextpval@
                5 = if !p5 else nextpval@
                6 = if !p6 else nextpval@
                7 = if !p7 else nextpval@
                8 = if !p8 else nextpval@

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

: nvp@  nextpval@ 1 = if @p1 else nextpval@
                2 = if @p2 else nextpval@
                3 = if @p3 else nextpval@
                4 = if @p4 else nextpval@
                5 = if @p5 else nextpval@
                6 = if @p6 else nextpval@
                7 = if @p7 else nextpval@
                8 = if @p8 else nextpval@

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


: reset-nextval sv-nextval@ nextval! ;
: set-sv nextval@ sv-nextval! ;

: check-unique inpv !  0 dupr ! set-sv
                     10 1 ?do i nextval! nv@ inpv @ = if 1 dupr ! then loop
                        reset-nextval dupr @ ;

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

: load-from-row
              line-no !
               width 0 ?do
          board-fetch  i +  c@ dup current-val ! 42 <> if current-val @  store-input then loop ;



variable offset

: column-calc line-no ! board line-no @ width * + ;

: column-calc2 board line-no @ width * + ;

: print-column cr offset ! board offset @ + c@ emit cr
    width 1 ?do i column-calc offset @ + c@ emit cr loop ;

: load-from-column offset ! board offset @ + c@ dup current-val ! 42 <> if store-input then
                    9 1 ?do i column-calc offset @ + c@ dup current-val ! 42 <> if store-input then loop ;

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

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

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

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

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

: sq7-load 9 6 ?do i line-no ! 3 0 ?do i column-calc2 + c@ 42 <> if store-input then loop loop ;
:  sq8-load 3 offset ! 9 6 ?do i line-no ! 3 0 ?do i column-calc2 + offset @ + c@ 42 <> if store-input then loop loop ;
: sq9-load 6 offset ! 9 6 ?do i line-no ! 3 0 ?do i column-calc2 + offset @ + c@ 42 <> if store-input then loop loop ;
variable sq-no
: 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 ;

: fill-constraints check-sq square-load col-no @ load-from-column line-no @ load-from-row ;
variable fnd
variable nextpval
: 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 ;
: store-cell board line-no + col-no 9 * + nvp@ ! ;
: load-cell  check-possible 1 = if store-cell then ;