racket - Modifying the interpreter in Scheme -


i'm totally new in scheme , interpreters. job modifying following code. if run

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

in drracket, returns 11. need modify interpreter behaves correctly single numeric argument, returns 0 otherwise (that is, whenever number of arguments different 1, or argument of incompatible type) understand different modules of code, i'm totally confused how modify it. great if can me or give me pointer similar things.

#lang eopl  ;;;;;;;;;;;;;;;; top level , tests ;;;;;;;;;;;;;;;;  (define run   (lambda (string)     (eval-program (scan&parse string))))   ;; needed 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))    ;;;;;;;;;;;;;;;; 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 apply non-procedure ~s" proc))))  ;&             (else (eopl:error 'eval-expression "not here:~s" exp))       )))  ;;;; right prefix must appear earlier in 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 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 ~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)))))) 

you change 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 other primitives should changed accordingly, change sub1.


Comments

Popular posts from this blog

python - mat is not a numerical tuple : openCV error -

c# - MSAA finds controls UI Automation doesn't -

wordpress - .htaccess: RewriteRule: bad flag delimiters -