Here I present a General Problem Solver (GPS) written in OCaml. You can find some references at the Wikipedia article and a Scheme implementation by John Stone here. The example I give at the end is from Peter Norvig. Please note that this is the naive version of the GPS (Peter Norvig's version 1, gps1.lisp); it solves the goals in order but does not guarantee that the goals will all be in the stack when the function returns. It suffers from what Norvig calls the "Clobbered Sibling Goal" problem.

You may download the source code.

First, a couple of definitions.

exception Failed_path

type op =
{
  name : string;
  preconditions : string list;
  add : string list;
  delete : string list;
}

Failed_path isn't too special, we simply use it when a path of decisions is faulty and we need to backtrack and use a different path to our goal. An op, or operator, is a named structure that will "operate" on string lists, treating them as sets. Preconditions are what must be in the state for the op to be followed, add is what is added to the state when you follow the op, and delete is what you remove from the state when you follow the op. List.append works as union, and cons works to add an element, but we will need a difference function ( \ or - in set algebra). For small problems this is okay.

let difference a b =
  List.fold_left
    (fun accum a ->
      if List.mem a b
      then accum
      else a::accum
    )
    []
    a

Now a note on how the GPS works generally. A GPS requires a starting state (in this case, a list of strings), a list of goals, and a list of ops. The goals are attained one by one via a depth-first search through the ops. The ops constitute a digraph and the initial state determines where in the graph you can start your search. The GPS algorithm travels the digraph until it finds a path such that the stack contains the goals in order. Successive goals may be removed from the stack on the way to the next goal. The GPS function returns a tuple containing the path taken and the final state.

First lets consider the case of trying to satisfy a single goal:

let rec achieve goal state ops =

We know that if the goal is already in the state, then there is no work to do

if List.mem goal state
then ([],state)
else

Returning ([],state) means that we've taken no path through the ops and the state is unmodified.

Next we consider what to do when the goal is not yet reached. We search the ops for nodes such that they point to the goal:

let to_try =
  List.find_all
    (fun op ->
      List.mem goal op.add
    )
    ops
    in

If the list to_try is empty, we can forget this path through the ops.

if to_try = []
then raise Failed_path
else

The next step requires an understanding of the digraph defined by the ops and the state. We know where we want to be in the digraph, but we have to find a path through the digraph such that the state eventually contains the prerequisites for one of the ops that will add our goal to the state. This is a rather complex task, but the "achieve" function is co-recursive with an "achieve_all" function that happens to do exactly what we want.

Now I have to apologize to the functional purists out there, but I found the next portion of "achieve" to be easiest to write imperatively. It sets up an empty tuple ([],[]) that will be replaced if "achieve_all" is able to complete a path to our target op such that the state meets the target op's prerequisites. We'll pick the first matching path.

let choice = ref ([],[]) in
let len = List.length to_try in
let i = ref 0 in
while !i < len && !choice = ([],[]) do
  begin
    let op = List.nth to_try !i in
    try
      let (path,result) = achieve_all op.preconditions state ops in
      choice := (path @ [op.name], op.add @ (difference result op.delete))
    with
      Failed_path -> ()
  end;
  incr i;
done;
if !choice = ([],[]) then raise Failed_path else !choice

Notice the line that begins "choice :="; this is the only place where an op modifies the stack and is recorded on the path. The rest of the above code block is a while loop that checks the ops in "to_try" and modifies "choice" if it finds an acceptable path. Note that the while loop is where we catch Failed_path. Any failed path is ignored and the next candidate op is tried.

Save the definition of "achive_all", the GPS can achieve any single goal. Achieving a list of goals is the task of "achieve_all".

If there are no goals, there is nothing to do.

and achieve_all goals state ops =
  if goals = []
  then ([],state)
  else

The alternative is to fold_left over the list of goals, using "achieve" to solve them one at a time.

List.fold_left
  (fun (oldpath,oldresult) g ->
    let (path,result_state) = achieve g oldresult ops in
    (oldpath @ path, result_state)
  )
  ([],state)
  goals

That's it! Now we can try an example:

let driving_ops =
[make_op "drive son to school" ["son at home"; "car works"] ["son at school"] ["son at home"];
  make_op "shop installs battery" ["car needs battery";"shop knows problem";"shop has money"] ["car works"] ["car needs battery";"shop knows problem"];
  make_op "tell shop problem" ["in communication with shop"] ["shop knows problem"] [];
  make_op "telephone shop" ["know phone number"] ["in communication with shop"] [];
  make_op "look up number" ["have phone book"] ["know phone number"] [];
  make_op "give shop money" ["have money"] ["shop has money"] ["have money"]
]

let _ =
  achieve_all ["son at school"] ["son at home"; "car needs battery";"have money";"have phone book"] driving_ops

- : string list * string list =
(["look up number"; "telephone shop"; "tell shop problem"; "give shop money";
"shop installs battery"; "drive son to school"],
["son at school"; "shop has money"; "in communication with shop";
"have phone book"; "know phone number"; "car works"])