Modifying the interpreter in Scheme - scheme

Question

I'm totally new in Scheme and interpreters. My job is modifying the following code. If I run
(run "sub1(12,2,3,4)")
in Drracket, it returns 11. I need to modify the interpreter so that it behaves correctly for a single numeric argument, but returns 0 otherwise (that is, whenever the number of arguments is different from 1, or the argument is of incompatible type)
I understand different modules of the code, but I'm totally confused how to modify it. It would be great if you can help me or give me a pointer to some similar things.
#lang eopl
;;;;;;;;;;;;;;;; top level and tests ;;;;;;;;;;;;;;;;
(define run
(lambda (string)
(eval-program (scan&parse string))))
;; needed for testing
(define equal-external-reps? equal?)
;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
(define the-lexical-spec
'((whitespace (whitespace) skip)
(comment ("%" (arbno (not #\newline))) skip)
(identifier
(letter (arbno (or letter digit "_" "-" "?")))
symbol)
(number (digit (arbno digit)) number)))
(define the-grammar
'((program (expression) a-program)
(expression (number) lit-exp)
(expression (identifier) var-exp)
(expression
(primitive "(" (separated-list expression ",") ")")
primapp-exp)
(expression
("if" expression "then" expression "else" expression)
if-exp)
(expression
("let" (arbno identifier "=" expression) "in" expression)
let-exp)
(expression
("proc" "(" (separated-list identifier ",") ")" expression)
proc-exp)
(expression
("(" expression (arbno expression) ")")
app-exp)
(expression
("begin" expression (arbno ";" expression) "end")
begin-exp)
(primitive ("+") add-prim)
(primitive ("-") subtract-prim)
(primitive ("*") mult-prim)
(primitive ("add1") incr-prim)
(primitive ("sub1") decr-prim)
(primitive ("zero?") zero-test-prim)
))
(sllgen:make-define-datatypes the-lexical-spec the-grammar)
(define show-the-datatypes
(lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
(define scan&parse
(sllgen:make-string-parser the-lexical-spec the-grammar))
(define just-scan
(sllgen:make-string-scanner the-lexical-spec the-grammar))
;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
(define eval-program
(lambda (pgm)
(cases program pgm
(a-program (body)
(eval-expression body (init-env))))))
(define eval-expression
(lambda (exp env)
(cases expression exp
(lit-exp (datum) datum)
(var-exp (id) (apply-env env id))
(primapp-exp (prim rands)
(let ((args (eval-rands rands env)))
(apply-primitive prim args)))
(if-exp (test-exp true-exp false-exp) ;\new4
(if (true-value? (eval-expression test-exp env))
(eval-expression true-exp env)
(eval-expression false-exp env)))
(begin-exp (exp1 exps)
(let loop ((acc (eval-expression exp1 env))
(exps exps))
(if (null? exps) acc
(loop (eval-expression (car exps) env) (cdr exps)))))
(let-exp (ids rands body) ;\new3
(let ((args (eval-rands rands env)))
(eval-expression body (extend-env ids args env))))
(proc-exp (ids body) (closure ids body env)) ;\new1
(app-exp (rator rands) ;\new7
(let ((proc (eval-expression rator env))
(args (eval-rands rands env)))
(if (procval? proc)
(apply-procval proc args)
(eopl:error 'eval-expression
"Attempt to apply non-procedure ~s" proc))))
;&
(else (eopl:error 'eval-expression "Not here:~s" exp))
)))
;;;; Right now a prefix must appear earlier in the file.
(define eval-rands
(lambda (rands env)
(map (lambda (x) (eval-rand x env)) rands)))
(define eval-rand
(lambda (rand env)
(eval-expression rand env)))
(define apply-primitive
(lambda (prim args)
(cases primitive prim
(add-prim () (+ (car args) (cadr args)))
(subtract-prim () (- (car args) (cadr args)))
(mult-prim () (* (car args) (cadr args)))
(incr-prim () (+ (car args) 1))
(decr-prim () (- (car args) 1))
;&
(zero-test-prim () (if (zero? (car args)) 1 0))
)))
(define init-env
(lambda ()
(extend-env
'(i v x)
'(1 5 10)
(empty-env))))
;;;;;;;;;;;;;;;; booleans ;;;;;;;;;;;;;;;;
(define true-value?
(lambda (x)
(not (zero? x))))
;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
(define-datatype procval procval?
(closure
(ids (list-of symbol?))
(body expression?)
(env environment?)))
(define apply-procval
(lambda (proc args)
(cases procval proc
(closure (ids body env)
(eval-expression body (extend-env ids args env))))))
;;;;;;;;;;;;;;;; environments ;;;;;;;;;;;;;;;;
(define-datatype environment environment?
(empty-env-record)
(extended-env-record
(syms (list-of symbol?))
(vec vector?) ; can use this for anything.
(env environment?))
)
(define empty-env
(lambda ()
(empty-env-record)))
(define extend-env
(lambda (syms vals env)
(extended-env-record syms (list->vector vals) env)))
(define apply-env
(lambda (env sym)
(cases environment env
(empty-env-record ()
(eopl:error 'apply-env "No binding for ~s" sym))
(extended-env-record (syms vals env)
(let ((position (rib-find-position sym syms)))
(if (number? position)
(vector-ref vals position)
(apply-env env sym)))))))
(define rib-find-position
(lambda (sym los)
(list-find-position sym los)))
(define list-find-position
(lambda (sym los)
(list-index (lambda (sym1) (eqv? sym1 sym)) los)))
(define list-index
(lambda (pred ls)
(cond
((null? ls) #f)
((pred (car ls)) 0)
(else (let ((list-index-r (list-index pred (cdr ls))))
(if (number? list-index-r)
(+ list-index-r 1)
#f))))))
(define iota
(lambda (end)
(let loop ((next 0))
(if (>= next end) '()
(cons next (loop (+ 1 next)))))))
(define difference
(lambda (set1 set2)
(cond
((null? set1) '())
((memv (car set1) set2)
(difference (cdr set1) set2))
(else (cons (car set1) (difference (cdr set1) set2))))))

Answer 1

You could change as follows:
(define apply-primitive
[... part of code ...]
(decr-prim () (if (and (= (length args) 1) (number? (car args)))
(- (car args) 1)
0))
[... rest of code ...]
I assume the other primitives should be changed accordingly, this will only change sub1.