\ by Kresimir Kasal

create sudoku ( enter sudoku here )
2 c, 0 c, 0 c, 6 c, 7 c, 0 c, 0 c, 0 c, 0 c, 
0 c, 0 c, 6 c, 0 c, 0 c, 0 c, 2 c, 0 c, 1 c, 
4 c, 0 c, 0 c, 0 c, 0 c, 0 c, 8 c, 0 c, 0 c, 
5 c, 0 c, 0 c, 0 c, 0 c, 9 c, 3 c, 0 c, 0 c, 
0 c, 3 c, 0 c, 0 c, 0 c, 0 c, 0 c, 5 c, 0 c, 
0 c, 0 c, 2 c, 8 c, 0 c, 0 c, 0 c, 0 c, 7 c, 
0 c, 0 c, 1 c, 0 c, 0 c, 0 c, 0 c, 0 c, 4 c, 
7 c, 0 c, 8 c, 0 c, 0 c, 0 c, 6 c, 0 c, 0 c, 
0 c, 0 c, 0 c, 0 c, 5 c, 3 c, 0 c, 0 c, 8 c, 

: printLine ( addr -- )
	9 0 ?do dup i + c@ . loop CR drop ;

: printSudoku ( -- )
	CR 9 0 ?do sudoku 9 i * + printLine loop ;

: singleRow ( addr num -- flag ) ( 0 = not valid, 1 = valid )
	swap 9 0 ?do 2dup i + c@ = if 2drop 0 unloop exit else endif loop 2drop 1 ;

: singleCol ( addr num -- flag )
	swap 9 0 ?do 2dup 9 i * + c@ = if 2drop 0 unloop exit else endif loop 2drop 1 ;

: calcBox ( cell -- box )
	27 /mod 27 * swap 9 mod 3 / 3 * + ;

: singleBox ( addr num -- flag )
	swap 3 0 ?do 2dup i + c@ = if 2drop 0 unloop exit else endif loop
	12 9 ?do 2dup i + c@ = if 2drop 0 unloop exit else endif loop
	21 18 ?do 2dup i + c@ = if 2drop 0 unloop exit else endif loop 2drop 1 ;

: getFreeField ( -- pos )
	 81 0 ?do sudoku i + c@ 0 = if i unloop exit else endif loop 81 ; 

: getColAddr ( cell -- addr )
	9 mod sudoku + ;

: getRowAddr ( cell -- addr )
	9 / 9 * sudoku + ;

: checkValidity ( cell num -- flag )
	2dup 2dup swap getColAddr swap singleCol 1 = 
		if swap getRowAddr swap singleRow 1 = 
			if swap calcBox sudoku + swap singleBox 1 = 
				if 1 
				else 0 
				endif 
			else 2drop 0 
			endif
		else 2drop 2drop 0
		endif ;

: solver ( -- ) recursive
	getFreeField dup 81 = if drop printSudoku exit
	else 10 1 ?do dup i checkValidity 1 = 
		if dup sudoku + i swap c! solver dup sudoku + 0 swap c! 
		endif
		loop 
	endif drop ;

printSudoku CR
solver CR
bye