[MLton] bug report
John Reppy
jhr@cs.uchicago.edu
Fri, 22 Apr 2005 09:15:26 -0500
--Apple-Mail-3-580656474
Content-Transfer-Encoding: 7bit
Content-Type: text/plain;
charset=US-ASCII;
format=flowed
On MacOS X 10.3.9, I did
mlton -profile alloc -output ast.prof astar.mlb
but when I run ast.prof, I get a core dump (BTW, time
profiling works for this program). Here is what gdb
says:
(gdb) run 200
Starting program: /Users/jhr/AStar/SML/ast.prof
Reading symbols for shared libraries +.. done
Program received signal EXC_BAD_ACCESS, Could not access memory.
0x0003527c in GC_profileInc ()
(gdb) where
#0 0x0003527c in GC_profileInc ()
#1 0x00038490 in answer ()
#2 0x000386cc in IntInf_mul ()
#3 0x0002b73c in Chunk1 ()
#4 0x00030de4 in main ()
#5 0x00002448 in _start (argc=1, argv=0xbffff8d4, envp=0xbffff8dc) at
/SourceCache/Csu/Csu-47/crt.c:267
#6 0x8fe1a278 in __dyld__dyld_start ()
(gdb)
I'm attaching the code. I'm using the SML/NJ library from mlton.org.
- John
--Apple-Mail-3-580656474
Content-Transfer-Encoding: 7bit
Content-Type: application/octet-stream;
x-unix-mode=0664;
name="astar.mlb"
Content-Disposition: attachment;
filename=astar.mlb
local
basis l11 =
bas
(* $/basis.cm ====> *) $(MLTON_ROOT)/basis/basis.mlb
end
basis l4 =
bas
(* $/smlnj-lib.cm ====> *) $(SMLNJ_LIB)/Util/smlnj-lib.mlb
end
in
local
$(MLTON_ROOT)/basis/pervasive.mlb
local
open l4
in
functor gs_0 = HashTableFn
end
local
open l4
in
functor gs_1 = LeftPriorityQFn
end
local
open l11
in
structure gs_2 = Word8Array
end
local
open l4
in
structure gs_3 = Format
end
local
open l11
in
structure gs_4 = Word8
end
local
open l11
in
structure gs_5 = Vector
end
local
open l11
in
structure gs_6 = TextIO
end
local
open l4
in
structure gs_7 = Random
end
local
open l11
in
structure gs_8 = Option
end
local
open l11
in
structure gs_9 = Word
end
local
open l11
in
structure gs_10 = Time
end
local
open l11
in
structure gs_11 = Real
end
local
open l11
in
structure gs_12 = List
end
local
open l11
in
structure gs_13 = Int
end
local
open l11
in
structure gs_14 = OS
end
local
structure Format = gs_3
functor HashTableFn = gs_0
structure Int = gs_13
functor LeftPriorityQFn = gs_1
structure List = gs_12
structure OS = gs_14
structure Option = gs_8
structure Random = gs_7
structure Real = gs_11
structure TextIO = gs_6
structure Time = gs_10
structure Vector = gs_5
structure Word = gs_9
structure Word8 = gs_4
structure Word8Array = gs_2
astar.sml
in
structure gs_15 = AStar
end
local
open l11
in
structure gs_16 = CommandLine
end
local
structure AStar = gs_15
structure CommandLine = gs_16
mlton-main.sml
in
structure gs_17 = Main
end
in
structure AStar = gs_15
structure Main = gs_17
end
end
--Apple-Mail-3-580656474
Content-Transfer-Encoding: 7bit
Content-Type: application/smil;
x-unix-mode=0664;
name="astar.sml"
Content-Disposition: attachment;
filename=astar.sml
structure AStar (*: sig
val main : (string * string list) -> OS.Process.status
val test : int list -> unit
end*) = struct
val size = 4
structure A = Word8Array
type tiles = A.array
fun sameState (k1 : tiles, k2 : tiles) = let
fun eq i = (i >= size*size)
orelse ((A.sub(k1, i) = A.sub(k2, i)) andalso eq(i+1))
in
eq 0
end
datatype node = ND of {
tiles : tiles,
parent : node option,
dist : int,
prio : int
}
(* return true if two nodes are labeled by the same state *)
fun eqState (ND{tiles=s1, ...}, ND{tiles=s2, ...}) = sameState(s1, s2)
structure PQ = LeftPriorityQFn (
struct
type priority = int
(* smaller is better *)
fun compare (a : int, b : int) = if (a < b) then GREATER else LESS
type item = node
fun priority (ND{prio, ...}) = prio
end)
(* create a new state, where the ith and jth tile have been swapped.
* We assume that the ith tile is the empty tile.
*)
fun swapTiles (tiles : tiles, i, j) = let
val tiles' = A.array(size*size, 0w0)
in
A.copy {src=tiles, dst=tiles', di=0};
A.update(tiles', i, A.sub(tiles', j));
A.update(tiles', j, 0w0);
tiles'
end
(* a hash table to represent the set of states seen so far *)
structure StateSet = HashTableFn (
struct
type hash_key = tiles
fun hashVal (tiles : tiles) =
A.foldl
(fn (t, h) => h * 0w7 + Word.fromLargeWord(Word8.toLargeWord t))
0w0
tiles
val sameKey = sameState
end)
val goalState = A.tabulate(size*size, Word8.fromInt)
fun displayState tiles = (
print "---\n";
A.appi (fn (i, t) => (
print (Format.format "%02d " [Format.WORD8 t]);
if (i mod size) = (size-1) then print "\n" else ()
)) tiles;
print "---\n");
fun display (ND{tiles, ...}) = displayState tiles
(* manhattan distance heuristic *)
fun md (tiles : tiles) = let
fun dist (i, j, 0w0) = 0
| dist (i, j, t) = let val t = Word8.toIntX t
in Int.abs((t mod size) - j) + Int.abs((t div size) - i) end
fun loopi (i, d) = if (i < size)
then let
fun loopj (j, d) = if (j < size)
then loopj (j+1, d + dist(i, j, A.sub(tiles, i*size + j)))
else d
in
loopi (i+1, loopj (0, d))
end
else d
in
loopi (0, 0)
end
val moves = let
fun ccons (false, _, l) = l
| ccons (true, m, l) = m::l
fun next i =
ccons (i >= size, i-size, (* up *)
ccons (i < size*(size-1), i+size, (* down *)
ccons (i mod size <> 0, i-1, (* left *)
ccons (i mod size <> size-1, i+1, (* right *)
nil))))
in
Vector.tabulate(size*size, next)
end
(* create a child node, where the ith and jth tiles are swapped. We assume
* that the ith tile is the empty square.
*)
fun child (nd as ND{tiles, dist, ...}, i, j) = let
val tiles' = swapTiles (tiles, i, j)
val dist' = dist + 1
in
ND{
tiles = tiles',
parent = SOME nd,
dist = dist',
prio = dist' + md tiles'
}
end
(* given a node, return a list its children *)
fun children (nd as ND{tiles, ...}) = let
val SOME(i, _) = A.findi (fn (_, 0w0) => true | _ => false) tiles
in
List.map (fn j => child(nd, i, j)) (Vector.sub(moves, i))
end
(* trace the moves of a solution *)
fun solution (nd as ND{parent, ...}) = (
Option.app solution parent;
display nd)
(* search *)
fun astar initTiles = let
val t0 = Time.now()
val stateSet = StateSet.mkTable(100000, Fail "state set")
val inSet = StateSet.inDomain stateSet
val add = let val add' = StateSet.insert stateSet
in
fn tiles => add' (tiles, ())
end
val initPrio = md initTiles
val initNd = ND{tiles = initTiles, parent = NONE, dist = 0, prio = initPrio}
fun search (pq, nExpanded) = let
val (nd as ND{tiles, ...}, pq) = PQ.remove pq
in
if sameState(tiles, goalState)
then (nd, nExpanded)
else if inSet tiles
then search(pq, nExpanded)
else let
val nExpanded = nExpanded+1
in
add tiles;
if (nExpanded mod 1000000) = 0
then print(Format.format "expanded %d million nodes\n"
[Format.INT(nExpanded div 1000000)])
else ();
search (List.foldl PQ.insert pq (children nd), nExpanded)
end
end
val _ = print(Format.format "heuristic of start: %d\n" [Format.INT initPrio]);
val (final as ND{dist, ...}, nExpanded) = search (PQ.fromList[initNd], 0)
val t1 = Time.now()
val time = Time.toReal(Time.-(t1, t0))
in
(*
print "** solution **\n";
solution final;
*)
print(Format.format "expanded %d nodes\n" [Format.INT nExpanded]);
print(Format.format "%d nodes per second\n" [Format.INT(Real.floor(real nExpanded / time))]);
print(Format.format "distance %d\n" [Format.INT dist])
end
fun run start = (
print ("** start **\n");
displayState start;
astar start)
(* pick a random starting point nsteps from the goal *)
fun randomStart nSteps = let
val rand = Random.rand (17, 23)
fun f (0, _, state) = state
| f (n, i, state) = let
val mvs = Vector.sub(moves, i)
val j = List.nth(mvs, Real.floor(real(length mvs) * Random.randReal rand))
in
f (n-1, j, swapTiles(state, i, j))
end
in
f (nSteps, 0, goalState)
end
fun usage () = (
TextIO.output(TextIO.stdErr, "usage: astar steps");
OS.Process.failure)
fun main (_, [nSteps]) = (case Int.fromString nSteps
of SOME nSteps => (
run (randomStart nSteps);
OS.Process.success)
| _ => usage()
(* end case *))
| main _ = usage()
fun test init = let
val tiles = A.fromList (List.map Word8.fromInt init)
in
if (A.length tiles <> size*size)
then raise Size
else ();
run tiles
end
end
--Apple-Mail-3-580656474
Content-Transfer-Encoding: 7bit
Content-Type: application/smil;
x-unix-mode=0664;
name="mlton-main.sml"
Content-Disposition: attachment;
filename=mlton-main.sml
structure Main =
struct
val _ = AStar.main (CommandLine.name(), CommandLine.arguments());
end
--Apple-Mail-3-580656474--