Finish implementation of query inside amb-evaluator
parent
1416e3c913
commit
8139622b44
|
@ -137,9 +137,15 @@
|
|||
;;(put 'lisp-value 'qeval lisp-value)
|
||||
|
||||
(define (execute exp)
|
||||
(display "EXECUTE ") (display exp) (newline)
|
||||
(apply (eval (predicate exp) user-initial-environment)
|
||||
(args exp)))
|
||||
(let ((op (car exp)))
|
||||
(cond
|
||||
((eq? op '<) (< (cadr exp) (cadr (cdr exp))))
|
||||
((eq? op '>) (> (cadr exp) (cadr (cdr exp))))
|
||||
(else
|
||||
(display "list-value OP not supported ")
|
||||
(display op)
|
||||
(newline)
|
||||
#f))))
|
||||
|
||||
(define (always-true ignore frame-list) frame-list)
|
||||
|
||||
|
@ -298,7 +304,7 @@
|
|||
(define (add-rule! rule)
|
||||
(store-rule-in-index rule)
|
||||
(let ((old-rules THE-RULES))
|
||||
(set! THE-RULES (stream rule old-rules))
|
||||
(set! THE-RULES (cons rule old-rules))
|
||||
'ok))
|
||||
|
||||
(define (store-assertion-in-index assertion)
|
||||
|
@ -681,19 +687,30 @@
|
|||
|
||||
(initialize-data-base microshaft-data-base)
|
||||
|
||||
;; We are insided the non-deterministic evaluator here.
|
||||
|
||||
(display "\nex-4.78 - non-deterministic-query\n")
|
||||
(display "[installed-query-system]\n")
|
||||
|
||||
; Query is working within non-deterministic evaluator. Now we can switch to
|
||||
; amb.
|
||||
|
||||
(eval-query
|
||||
'(rule (big-shot ?p)
|
||||
(and (job ?p (?div1 . ?rest1))
|
||||
(supervisor ?p ?boss)
|
||||
(job ?boss (?div2 . ?rest2))
|
||||
(not (same ?div1 ?div2)))))
|
||||
|
||||
(eval-query
|
||||
'(and (salary (Bitdiddle Ben) ?ben-amount)
|
||||
(salary ?person ?amount)
|
||||
(lisp-value > ?amount ?ben-amount)))
|
||||
|
||||
(display "[done]\n")
|
||||
(eval-query '(big-shot ?x))
|
||||
(newline)
|
||||
))
|
||||
|
||||
(display "\nex-4.78 - non-deterministic-query\n")
|
||||
|
||||
; I am trying to get the query evaluator working within the non-deterministic
|
||||
; evaluator. The next step is to implement analyze-or in the non-deterministic
|
||||
; evaluator.
|
||||
|
||||
(display "\nex-4.79\n")
|
||||
|
||||
|
||||
|
|
|
@ -329,8 +329,6 @@
|
|||
(apply-in-underlying-scheme
|
||||
(primitive-implementation proc) args))
|
||||
|
||||
|
||||
|
||||
(define input-prompt ";;; M-Eval input:")
|
||||
(define output-prompt ";;; M-Eval value:")
|
||||
|
||||
|
@ -394,7 +392,6 @@
|
|||
((if-fail? exp) (analyze-if-fail exp))
|
||||
((lambda? exp) (analyze-lambda exp))
|
||||
((begin? exp) (analyze-sequence (begin-actions exp)))
|
||||
((apply? exp) (analyze-apply (cdr exp)))
|
||||
((cond? exp) (analyze (cond->if exp)))
|
||||
((let? exp) (analyze (let->combination exp))) ;**
|
||||
((amb? exp) (analyze-amb exp)) ;**
|
||||
|
@ -406,12 +403,6 @@
|
|||
(else
|
||||
(error "Unknown expression type -- ANALYZE" exp))))
|
||||
|
||||
(define (apply? exp) (tagged-list? exp 'apply))
|
||||
(define (analyze-apply exp)
|
||||
(display "ANALYZE-APPLY ") (newline)
|
||||
(display exp)
|
||||
(lambda (env succeed fail) (succeed #t fail)))
|
||||
|
||||
(define (ambeval exp env succeed fail)
|
||||
((analyze exp) env succeed fail))
|
||||
|
||||
|
@ -682,8 +673,10 @@
|
|||
(list 'abs abs)
|
||||
(list 'assoc assoc)
|
||||
(list 'append append)
|
||||
(list 'caddr caddr)
|
||||
(list 'cadr cadr)
|
||||
(list 'car car)
|
||||
(list 'cddr cddr)
|
||||
(list 'cdr cdr)
|
||||
(list 'cons cons)
|
||||
(list 'display display)
|
||||
|
|
Loading…
Reference in New Issue