aboutsummaryrefslogtreecommitdiff
path: root/amforth-6.5/examples/queens.frt
diff options
context:
space:
mode:
authorDimitri Sokolyuk <demon@dim13.org>2017-08-19 12:15:28 +0200
committerDimitri Sokolyuk <demon@dim13.org>2017-08-19 12:15:28 +0200
commit67d25d837ac55f28a366c0a3b262e439a6e75fc3 (patch)
treedf7715c7724c5935ab87c807f3b8b4ef529315e3 /amforth-6.5/examples/queens.frt
parente0d6784e89dba33226c0edb815bb974486fa7c48 (diff)
Add AmForth
Diffstat (limited to 'amforth-6.5/examples/queens.frt')
-rw-r--r--amforth-6.5/examples/queens.frt54
1 files changed, 54 insertions, 0 deletions
diff --git a/amforth-6.5/examples/queens.frt b/amforth-6.5/examples/queens.frt
new file mode 100644
index 0000000..e20b05d
--- /dev/null
+++ b/amforth-6.5/examples/queens.frt
@@ -0,0 +1,54 @@
+\ Copyright (c) 2007 the authors listed at the following URL, and/or
+\ the authors of referenced articles or incorporated external code:
+\ http://en.literateprograms.org/Eight_queens_puzzle_(Forth)?action=history&offset=20070512025943
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+\ IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+\ CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+\ TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+\ SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ Retrieved from: http://en.literateprograms.org/Eight_queens_puzzle_(Forth)?oldid=10015
+marker queen
+
+ : bits ( bits -- mask ) 1 swap lshift 1- ;
+ : lowBit ( mask -- bit ) dup negate and ;
+ : lowBit- ( mask -- mask ) dup 1- and ;
+ : third ( a b c -- a b c a ) 2 pick ;
+
+ variable solutions
+ variable nodes
+ : poss ( a b c -- a b c a&b&c ) dup 2over and and ;
+
+ : next3 ( dl dr f Qfilebit -- dl dr f dl' dr' f' )
+ invert >r
+ third r@ and 2* 1+
+ third r@ and 2/
+ third r> and ;
+
+ : try ( dl dr f -- ) \ bitmasks for unused diagonals and files
+ dup if 1 nodes +! poss
+ begin ?dup while
+ dup >r lowBit next3 recurse r> lowBit-
+ repeat
+ else ( .sol) 1 solutions +! then
+ drop drop drop ;
+
+ : queens ( n -- ) >r
+ 0 solutions ! 0 nodes !
+ -1 dup r@ bits try
+ r> . ." queens: " solutions @ u. ." solutions, " nodes @ u. ." nodes" ;
+