在計劃中修改口譯員

Question

我在計劃和口譯員中是全新的。我的工作是修改以下代碼。如果我運行

(run "sub1(12,2,3,4)") 

在Drracket

，它返回11.我需要，使其能正常運行的單個數字參數修改的解釋，但在其他方面（即，每當參數的數目是不同的返回0 1，或參數是不兼容的類型） 我瞭解代碼的不同模塊，但我完全困惑如何修改它。如果你能幫助我或者給我一些指向類似的東西的指針，那將是非常棒的。

#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

你可以改變如下：

(define apply-primitive 
    [... part of code ...] 
     (decr-prim () (if (and (= (length args) 1) (number? (car args))) 
         (- (car args) 1) 
         0)) 
    [... rest of code ...] 

我假定其他原語應作相應改變，這隻會改變sub1。