(module rulesets mzscheme
(provide (all-defined))
(require "patterns.ss")
(require "argument-lists.ss")
(define-struct ruleset
(name rules namespace)
(make-inspector))
(define-struct rule
(name ruleset goals preconditions actions)
(make-inspector))
(define (add-rule name ruleset goals preconditions actions)
(let ((rule (make-rule name ruleset goals preconditions actions)))
(set-ruleset-rules! ruleset
(append! (ruleset-rules ruleset)
(list rule)))))
(define-syntax define-ruleset
(syntax-rules ()
((define-ruleset name)
(define name
(make-ruleset ',name
'()
(current-namespace))))))
(define-syntax define-rule
(syntax-rules (<== ==>)
( (define-rule (name ruleset)
item)
(add-rule 'name
ruleset
'(item)
'()
#f))
( (define-rule (name ruleset)
item-1 item-2 ...)
(define-rule
"gather goals or data"
(name ruleset)
(item-1)
item-2 ...))
( (define-rule
"gather goals or data"
(name ruleset)
(goal ...))
(add-rule 'name
ruleset
'(goal ...)
'()
#f))
( (define-rule
"gather goals or data"
(name ruleset)
(goal ...)
<== item)
(add-rule 'name
ruleset
'(goal ...)
'(item)
#f))
( (define-rule
"gather goals or data"
(name ruleset)
(goal ...)
<== item-1 item-2 ...)
(define-rule
"gather data or actions"
(name ruleset)
(goal ...)
(item-1)
item-2 ...))
( (define-rule
"gather goals or data"
(name ruleset)
(data ...)
==> item ...)
(add-rule 'name
ruleset
'()
'(data ...)
#'(item ...)))
( (define-rule
"gather goals or data"
(name ruleset)
(goal-or-data ...)
item-1 item-2 ...)
(define-rule
"gather goals or data"
(name ruleset)
(goal-or-data ... item-1)
item-2 ...))
( (define-rule
"gather data or actions"
(name ruleset)
(goal ...)
(data ...))
(add-rule 'name
ruleset
'(goal ...)
'(data ...)
#f))
( (define-rule
"gather-data-or-actions"
(name ruleset)
(goal ...)
(data ...)
==> action ...)
(add-rule 'name
ruleset
'(goal ...)
'(data ...)
#'(action ...)))
( (define-rule
"gather data or actions"
(name ruleset)
(goal ...)
(data-or-action ...)
item-1 item-2 ...)
(define-rule
"gather data or actions"
(name ruleset)
(goal ...)
(data-or-action ... item-1)
item-2 ...))))
)