I have defined a microscopic verson of scheme that utilizes amb. I am currently using Dr. Scheme.
This is my definition:
(define (amb-eval s environment succeed fail)
(cond ((not (pair? s))
(succeed
(cond ((eq? s '#t) '#t)
((eq? s '()) '())
((eq? s '#f) '#f)
((number? s) s)
((string? s) s)
(else (micro-value s environment)))
fail))
((eq? (car s) 'quote) (succeed (cadr s) fail))
((eq? (car s) 'cond)
(micro-evalcond (cdr s) environment succeed fail))
((eq? (car s) 'set!)
(micro-set! (cadr s) (caddr s) environment succeed fail))
((eq? (car s) 'begin)
(micro-evalbegin (cdr s) environment succeed fail))
((eq? (car s) 'define)
(amb-eval (definition-val s)
environment
(lambda (val fail)
(micro-define-var (definition-var s) val environment)
(succeed 'ok fail))
fail))
((eq? (car s) 'unknown) (fail))
((eq? (car s) 'amb)
(micro-amb (cdr s) environment succeed fail))
((eq? (car s) 'lambda)
(succeed
(list 'procedure (cadr s) (cons 'begin (cddr s)) environment)
fail))
(else
(amb-eval (car s)
environment
(lambda (proc fail)
(get-args (cdr s)
environment
(lambda (args fail)
(micro-apply proc
args
environment
succeed
fail))
fail))
fail))))
(define (get-args arglist env succeed fail)
(if (null? arglist)
(succeed () fail)
(amb-eval (car arglist)
env
(lambda (arg fail)
(get-args (cdr arglist)
env
(lambda (args fail)
(succeed (cons arg args) fail))
fail))
fail)))
(define (micro-apply function args environment succeed fail)
(cond ((not (pair? function))
(display "ERROR: ")
(display function)
(display " is not a function")
(newline)
(fail))
((eq? (car function) 'primitive)
(succeed (apply (cadr function) args) fail))
((eq? (car function) 'procedure)
(amb-eval (caddr function)
(micro-bind (cadr function)
args
(cadddr function))
succeed
fail))))
(define (micro-amb choices env succeed fail)
(if (null? choices)
(fail)
(amb-eval (car choices)
env
succeed
(lambda ()
(micro-amb (cdr choices)
env
succeed
fail)))))
(define global-frame
(map (lambda (x) (list x 'primitive (eval x)))
'(car cdr cons pair? not exit null? eq? * +)))
(define global-environment (list global-frame))
(define (micro-r-e-p)
(define (main-loop try-again)
(newline)
(display "ambmicro> ")
(let ((s (read)))
(cond ((equal? s '(exit))
(display "Leaving ambmicro")
(newline))
((eq? s 'try-again) (try-again))
(else
(display "new problem")
(newline)
(amb-eval s
global-environment
(lambda (val next-try)
(micro-print val)
(main-loop next-try))
(lambda ()
(display "no more values for ")
(micro-print s)
(micro-r-e-p)))))))
(main-loop (lambda ()
(display "no current problem")
(newline)
(micro-r-e-p))))
(define (micro-evalcond clauses environment succeed fail)
(cond ((null? clauses) (succeed #f fail))
((eq? (caar clauses) 'else)
(micro-evalbegin (cdar clauses) environment succeed fail))
(else (amb-eval (caar clauses)
environment
(lambda (val fail)
(if val
(micro-evalbegin (cdar clauses)
environment
succeed
fail)
(micro-evalcond (cdr clauses)
environment
succeed
fail)))
fail))))
; An environment is a list of frames. A frame is a list of var-value
; pairs (an assoc list).
(define (micro-bind key-list value-list environment)
(define (micro-binder key-list value-list) ; returns a new frame
(cond ((or (null? key-list) (null? value-list))
'())
(else (cons (cons (car key-list) (car value-list))
(micro-binder (cdr key-list)
(cdr value-list))))))
(cons (micro-binder key-list value-list) environment))
(define (micro-get-var-val var environment)
(if (null? environment)
#f
(let ((vv (assoc var (car environment))))
(if vv
vv
(micro-get-var-val var (cdr environment))))))
(define (micro-value var environment)
(let ((vv (micro-get-var-val var environment)))
(if vv
(cdr vv)
(begin
(display "ERROR: No value for ")
(display var)
(display " found")
(newline)
'unknown))))
(define (micro-set! var val env succeed fail)
(let ((entry (micro-get-var-val var env)))
(if entry
(let ((old-val (cdr entry)))
(amb-eval val
env
(lambda (val fail)
(set-cdr! entry val)
(succeed 'ok
(lambda ()
(set-cdr! entry old-val)
(fail))))
fail))
(begin
(display "ERROR: variable ")
(display var)
(display " not previously defined")
(newline)
(fail)))))
(define (micro-evalbegin exprs env succeed fail)
(if (null? (cdr exprs))
(amb-eval (car exprs) env succeed fail)
(amb-eval (car exprs)
env
(lambda (val fail)
(micro-evalbegin (cdr exprs)
env
succeed
fail))
fail)))
(define (definition-var s)
(if (symbol? (cadr s))
(cadr s)
(caadr s)))
(define (definition-val s)
(if (symbol? (cadr s))
(caddr s)
(cons 'lambda (cons (cdadr s) (cddr s)))))
(define (micro-define-var var val env)
(let ((vv (assoc var (car env)))) ; search only first frame
(if vv
(set-cdr! vv val)
(set-car! env (cons (cons var val) (car env))))))
(define (micro-print x)
(cond ((not (pair? x)) (display x))
((eq? (car x) 'procedure)
(display "(procedure ")
(micro-print-help (list (cadr x) (caddr x)))
(display " <an environment>)"))
(else (display "(")
(micro-print-help x)
(display ")"))))
(define (micro-print-help x)
(if (pair? x)
(begin (micro-print (car x))
(if (pair? (cdr x))
(display " ")
(if (not (null? (cdr x))) (display " . ")))
(micro-print-help (cdr x)))
(if (not (null? x)) (display x))))
I am looking to add a way to implement require.
Require can be implemented while I'm running ambmicro but has to be re-entered everytime I use ambmicro. I'm looking to define it in ambeval but am unsure how.
Any help/suggestions would be helpful.
Jake