Added support for LFE (Lisp Flavored Erlang).

samples/LFE/gps1.lfe

@@ -0,0 +1,104 @@
+;;; -*- Mode: LFE; -*-
+;;; Code from Paradigms of Artificial Intelligence Programming
+;;; Copyright (c) 1991 Peter Norvig
+
+;;;; File gps1.lisp: First version of GPS (General Problem Solver)
+
+;;;; Converted to LFE by Robert Virding
+
+;; Define macros for global variable access. This is a hack and very naughty!
+(defsyntax defvar
+  ([name val] (let ((v val)) (put 'name v) v)))
+
+(defsyntax setvar
+  ([name val] (let ((v val)) (put 'name v) v)))
+
+(defsyntax getvar
+  ([name] (get 'name)))
+
+;; Module definition.
+
+(defmodule gps1
+  (export (gps 2) (gps 3) (school-ops 0))
+  (import (from lists (member 2) (all 2) (any 2))
+      ;; Rename lists functions to be more CL like.
+      (rename lists ((all 2) every) ((any 2) some) ((filter 2) find-all))))
+
+;; An operation.
+(defrecord op
+  action preconds add-list del-list)
+
+;; General Problem Solver: achieve all goals using *ops*.
+(defun gps (state goals ops)
+  ;; Set global variables
+  (defvar *state* state)    ;The current state: a list of conditions.
+  (defvar *ops* ops)        ;A list of available operators.
+  (if (every (fun achieve 1) goals) 'solved))
+
+(defun gps (state goals)
+  ;; Set global variables, but use existing *ops*
+  (defvar *state* state)    ;The current state: a list of conditions.
+  (if (every (fun achieve 1) goals) 'solved))
+
+;; A goal is achieved if it already holds or if there is an
+;; appropriate op for it that is applicable."
+(defun achieve (goal)
+  (orelse (member goal (getvar *state*))
+      (some (fun apply-op 1)
+        (find-all (lambda (op) (appropriate-p goal op))
+              (getvar *ops*)))))
+
+;; An op is appropriate to a goal if it is in its add list.
+(defun appropriate-p (goal op)
+  (member goal (op-add-list op)))
+
+;; Print a message and update *state* if op is applicable.
+(defun apply-op (op)
+  (if (every (fun achieve 1) (op-preconds op))
+    (progn
+      (: io fwrite '"executing ~p\n" (list (op-action op)))
+      (setvar *state* (set-difference (getvar *state*) (op-del-list op)))
+      (setvar *state* (union (getvar *state*) (op-add-list op)))
+      'true)))
+
+;; Define the set functions to work on list, a listsets module really.
+(defun set-difference
+  ([(cons e es) s2]
+   (if (member e s2)
+     (set-difference es s2)
+     (cons e (set-difference es s2))))
+  ([() s2] ()))
+
+(defun union
+  ([(cons e es) s2]
+   (if (member e s2) (union es s2) (cons e (union es s2))))
+  ([() s2] ()))
+
+;;; ==============================
+
+(defun school-ops ()
+  (list
+    (make-op action 'drive-son-to-school
+         preconds '(son-at-home car-works)
+         add-list '(son-at-school)
+         del-list '(son-at-home))
+    (make-op action 'shop-installs-battery
+         preconds '(car-needs-battery shop-knows-problem shop-has-money)
+         add-list '(car-works)
+         del-list ())
+    (make-op action 'tell-shop-problem
+         preconds '(in-communication-with-shop)
+         add-list '(shop-knows-problem)
+         del-list ())
+    (make-op action 'telephone-shop
+         preconds '(know-phone-number)
+         add-list '(in-communication-with-shop)
+         del-list ())
+    (make-op action 'look-up-number
+         preconds '(have-phone-book)
+         add-list '(know-phone-number)
+         del-list ())
+    (make-op action 'give-shop-money
+         preconds '(have-money)
+         add-list '(shop-has-money)
+         del-list '(have-money))))