Permalink
Browse files

Change macro loading so that it works for

compiled files and reloading.
  • Loading branch information...
bvds committed Mar 9, 2012
1 parent c3c376d commit 8eca2938e100587021f5179ee7617a38a14799db
Showing with 243 additions and 260 deletions.
  1. +3 −12 Base/Utility.cl
  2. +12 −7 HelpStructs/ErrorInterp.cl
  3. +16 −13 KB/reset-KB.cl
  4. +21 −26 Knowledge/ErrorClass.cl
  5. +7 −7 Knowledge/Nogood.cl
  6. +129 −141 Knowledge/Ontology.cl
  7. +30 −33 Knowledge/Operators.cl
  8. +21 −15 Knowledge/Problem.cl
  9. +4 −6 Knowledge/nlg.cl
View
@@ -208,10 +208,6 @@
(apply #'concatenate (cons 'string strings)))
-(defmacro postpend (Dest val)
- "Push but for the end."
- `(setq ,Dest ,`(append ,Dest (list ,Val))))
-
(defun contains-sym (Exp Sym)
"Return t iff Exp contains the symbol Sym."
(and (not (null Exp))
@@ -404,16 +400,11 @@
(append (nth n init) (list (nth n (car lists))))))
(listpair-list-o-lists R (cdr lists))))))
-
(defun qlist (lst)
(if (= (length lst) 1)
(eval `(list '',(car lst)))
(eval `(cons '',(car lst) ,`(qlist ',(cdr lst))))))
-
-;;-----------------------------------------------------------------------------
-;; code by collin Lynch.
-(defun func-eval (expressions)
- "Evaluate the expression by wrapping it as a funcall and applying."
- (funcall (append '(lambda ()) expressions)))
-
+(defun alistp (x)
+ "determine if x is an alist"
+ (and (listp x) (every #'consp x)))
View
@@ -23,14 +23,19 @@
;;
(defstruct (ErrorInterp (:print-function write-ErrorInterp))
- Intended ; interpretation of student's intended action
- Remediation ; a tutor turn. Typically contains a hint sequence
- Diagnosis ; a cons containing name and parameters, for assoc.
- hints ; evaluates to a hint sequence
- Order ; alist of specifications to determine priority
- State ; (The following list is obsolete)
-;;; One of forbidden, premature, premature-subst, done-already, inefficient or none
+ Intended ;interpretation of student's intended action
+ Remediation ;a tutor turn or a function that evaluates to one
+ Diagnosis ;a cons containing name and parameters, for assoc
+ hints ;evaluates to a hint sequence
+ Order ;alist of specifications to determine priority
+ State ;(The following list is obsolete)
+ ;; One of forbidden, premature, premature-subst, done-already,
+ ;; inefficient or none
)
+
+(defun ErrorInterp-remediate (x)
+ (let ((y (ErrorInterp-remediation x)))
+ (if (functionp y) (funcall y) y)))
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
View
@@ -22,22 +22,25 @@
;;;; This must be run before other problems in the module
;;;;
-;; loading this file resets the problem database:
-(clear-problem-registry)
-;; clear out the old operators on load so that the new ones can be defined.
-(clear-ops)
-;; Reset ontology database on each load of this file.
-(clear-ontology)
-;; reset NewtonsNogoods list
-(clear-nogoods)
-;; reset post-processing operations
-(clear-post-processing)
-;; reset entry tests
-(clear-entry-tests)
+(defun reset-kb ()
+ ;; loading this file resets the problem database:
+ (clear-problem-registry)
+ ;; clear out the old operators on load so that the new ones can be defined.
+ (clear-ops)
+ ;; Reset ontology database on each load of this file.
+ (clear-ontology)
+ ;; reset NewtonsNogoods list
+ (clear-nogoods)
+ ;; reset post-processing operations
+ (clear-post-processing)
+ ;; reset entry tests
+ (clear-entry-tests))
+
;;;
;;; It may be convenient to define this in the initialization file
;;;
(defun rkb ()
"Reset the lists in KB and reload all files using asdf"
- (asdf:operate 'asdf:load-op 'problems))
+ (reset-kb)
+ (asdf:operate 'asdf:load-source-op 'problems))
View
@@ -20,7 +20,7 @@
;;; Defines the struct and the macro for defining error classes, which
;;; appear in errors.cl and are interpreted by whatswrong.cl
-(defvar **entry-tests**)
+(defvar **entry-tests** ())
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
@@ -61,38 +61,33 @@
(defmacro def-Error-Class (name arguments conditions &key (Probability 0.1)
(Utility 1.0))
- `(push (make-EntryTest :name (quote ,name)
- :arguments (quote ,arguments)
- :preconditions (quote ,conditions)
- :apply 'no-match
- :state '+incorrect+ ;these are all errors
- :hint (quote ,(cons name arguments))
- :order (quote ((expected-utility .
- (* ,probability ,utility))))
- )
- **entry-tests**))
+ ;; Doesn't really need to be at end ...
+ `(push-to-end (make-EntryTest :name ',name
+ :arguments ',arguments
+ :preconditions ',conditions
+ :apply 'no-match
+ :state '+incorrect+ ;these are all errors
+ :hint ',(cons name arguments)
+ :order '((expected-utility .
+ (* ,probability ,utility))))
+ **entry-tests** :key #'EntryTest-name))
;;;
;;; More general utility to perform tests
;;;
(defmacro def-entry-test (name arguments &key preconditions apply state hint
- (order '((global . 1))))
- `(progn
- ;; remove any existing test of this name (allowing updates).
- (setf **entry-tests** (remove (quote ,name) **entry-tests**
- :key #'EntryTest-name))
-
- (push (make-EntryTest :name (quote ,name)
- :arguments (quote ,arguments)
- :preconditions (quote ,preconditions)
- :apply (quote ,apply)
- :state (quote ,state)
- :hint (quote (make-hint-seq ,hint))
- :order (quote ,order)
- )
- **entry-tests**)))
+ (order '((global . 1))))
+ ;; Doesn't really need to be at end ...
+ `(push-to-end (make-EntryTest :name ',name
+ :arguments ',arguments
+ :preconditions ',preconditions
+ :apply ',apply
+ :state ',state
+ :hint '(make-hint-seq ,hint)
+ :order ',order)
+ **entry-tests** :key #'EntryTest-name))
(defun print-error-names ()
View
@@ -71,7 +71,7 @@
;;=============================================================================
;; Nogoood parameters.
-(defparameter *nogoods* ())
+(defvar *nogoods* ())
(defparameter *print-nogood-messages* () "If a nogood is signalled print out the nogood message.")
;;=============================================================================
@@ -103,12 +103,12 @@
;; Define a nogood and register it in the system for later use.
(defmacro defnogood (label triggers &key (specs nil) (message nil))
- (let ((ng (make-nogood :label Label ;;Generate a new nogood struct.
- :triggers triggers
- :specs specs
- :message message)))
- (push ng *nogoods*) ;;Store the struct.
- ng)) ;;and return it.
+ `(let ((ng (make-nogood :label ',Label ;Generate a new nogood struct.
+ :triggers ',triggers
+ :specs ',specs
+ :message ',message)))
+ ;; Doesn't need to be at end.
+ (push-to-end ng *nogoods* :key #'nogood-label))) ;Store the struct.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Oops, something went wrong.

0 comments on commit 8eca293

Please sign in to comment.