Posted By

clementi on 02/11/09


Tagged


Versions (?)

Interpreter for Lectures 15-16


 / Published in: Scheme
 

  1. ;;================================================================================
  2. ;;== Lecture 15 Interpreter ==
  3. ;;================================================================================
  4.  
  5. ;;================================================================================
  6. ;;== Top Level ==
  7. ;;================================================================================
  8.  
  9. (define run
  10. (lambda (string)
  11. (eval-program (scan&parse string))))
  12.  
  13. ;;================================================================================
  14. ;;== Grammatical Specification ==
  15. ;;================================================================================
  16.  
  17. (define the-lexical-spec
  18. '((whitespace (whitespace) skip)
  19. (comment ("%" (arbno (not #\newline))) skip)
  20. (identifier (letter (arbno (or letter digit "_" "-" "?"))) symbol)
  21. (number (digit (arbno digit)) number)))
  22.  
  23. (define the-grammar
  24. '((program (expression) a-program)
  25.  
  26. (expression (number) lit-exp)
  27. (expression (identifier) var-exp)
  28. (expression (primitive "(" (separated-list expression ",") ")") primapp-exp)
  29.  
  30. (primitive ("+") add-prim)
  31. (primitive ("-") subtract-prim)
  32. (primitive ("*") mult-prim)
  33. (primitive ("add1") incr-prim)
  34. (primitive ("sub1") decr-prim)
  35.  
  36. ))
  37.  
  38. (sllgen:make-define-datatypes the-lexical-spec the-grammar)
  39.  
  40. (define show-the-datatypes
  41. (lambda ()
  42. (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
  43.  
  44. (define scan&parse
  45. (sllgen:make-string-parser the-lexical-spec the-grammar))
  46.  
  47. (define just-scan
  48. (sllgen:make-string-scanner the-lexical-spec the-grammar))
  49.  
  50. (define read-eval-print
  51. (sllgen:make-rep-loop "--> "
  52. (lambda (pgm) (eval-program pgm))
  53. (sllgen:make-stream-parser the-lexical-spec the-grammar)))
  54.  
  55. ;;================================================================================
  56. ;;== The Interpreter ==
  57. ;;================================================================================
  58.  
  59. (define eval-program
  60. (lambda (pgm)
  61. (cases program pgm
  62. (a-program (body) (eval-expression body (init-env))))))
  63.  
  64. (define eval-expression
  65. (lambda (exp env)
  66. (cases expression exp
  67. (lit-exp (datum) datum)
  68. (var-exp (id) (apply-env env id))
  69. (primapp-exp (prim rands) (let ((args (eval-rands rands env)))
  70. (apply-primitive prim args)))
  71. (else (eopl:error 'eval-expression "Not here:~s" exp))
  72. )))
  73.  
  74. (define eval-rands ;; Evaluate all of the expressions in the list --rands--
  75. (lambda (rands env)
  76. (map (lambda (x) (eval-rand x env)) rands)))
  77.  
  78. (define eval-rand ;; Evaluate an expression --rand-- ;; Just a wrapper for eval-expression
  79. (lambda (rand env)
  80. (eval-expression rand env)))
  81.  
  82. (define apply-primitive ;; Apply a primitive procedure to a list of expressed values --args--
  83. (lambda (prim args)
  84. (cases primitive prim
  85. (add-prim () (+ (car args) (cadr args)))
  86. (subtract-prim () (- (car args) (cadr args)))
  87. (mult-prim () (* (car args) (cadr args)))
  88. (incr-prim () (+ (car args) 1))
  89. (decr-prim () (- (car args) 1))
  90. )))
  91.  
  92. ;;================================================================================
  93. ;;== Environments ==
  94. ;;================================================================================
  95.  
  96. (define init-env ;; Parameterless function that creates an initial environment
  97. (lambda ()
  98. (extend-env '(i v x)
  99. '(1 5 10)
  100. (empty-env))))
  101.  
  102. (define-datatype environment environment?
  103. (empty-env-record)
  104. (extended-env-record (syms (list-of symbol?))
  105. (vals vector?) ;; You can put any type of expressed value in here
  106. (env environment?)))
  107.  
  108. (define empty-env
  109. (lambda ()
  110. (empty-env-record)))
  111.  
  112. (define extend-env ;; Add variables to an environment
  113. (lambda (syms vals env)
  114. (extended-env-record syms (list->vector vals) env)))
  115.  
  116. (define apply-env ;; Looks up a variable in an environment
  117. (lambda (env sym)
  118. (cases environment env
  119. (empty-env-record () (eopl:error 'apply-env "No binding for ~s" sym))
  120. (extended-env-record (syms vals env) (let ((position (rib-find-position sym syms)))
  121. (if (number? position)
  122. (vector-ref vals position)
  123. (apply-env env sym)))))))
  124.  
  125. ;; apply-env helper functions
  126. (define rib-find-position
  127. (lambda (sym los)
  128. (list-find-position sym los)))
  129.  
  130. (define list-find-position
  131. (lambda (sym los)
  132. (list-index (lambda (sym1) (eqv? sym1 sym)) los)))
  133.  
  134. (define list-index
  135. (lambda (pred ls)
  136. (cond ((null? ls) #f)
  137. ((pred (car ls)) 0)
  138. (else (let ((list-index-r (list-index pred (cdr ls))))
  139. (if (number? list-index-r)
  140. (+ list-index-r 1)
  141. #f))))))

Report this snippet  

You need to login to post a comment.