Advertisement
Guest User

Untitled

a guest
Jan 22nd, 2018
93
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Scheme 7.88 KB | None | 0 0
  1. #!/afs/cats.ucsc.edu/courses/cmps112-wm/usr/racket/bin/mzscheme -qr
  2. ;; $Id: sbi.scm,v 1.3 2016-09-23 18:23:20-07 - - $
  3. ;;
  4. ;; NAME
  5. ;;    sbi.scm - silly basic interpreter
  6. ;;
  7. ;; SYNOPSIS
  8. ;;    sbi.scm filename.sbir
  9. ;;
  10. ;; DESCRIPTION
  11. ;;    The file mentioned in argv[1] is read and assumed to be an SBIR
  12. ;;    program, which is the executed.  Currently it is only printed.
  13. ;;
  14.  
  15.  
  16. ;; here we create our tables
  17. (define *label-table* (make-hash))
  18. (define *variable-table* (make-hash))
  19. (define *function-table* (make-hash))
  20.  
  21.  
  22. ;; here we fill the function table with the prelim. functions
  23. ;; I think we write somethin like this to uses functions
  24. ;; (printf "2 ^ 16 = ~s~n" ((symbol-get '^) 2.0 16.0))
  25.  
  26. ;; I changed symbol-get and symbol-put to require the table
  27. ;; that their grabbing from so that way we could use them for
  28. ;; other hash tables :-)
  29. (define (symbol-get table key)
  30.         (hash-ref table key))
  31.  
  32. (define (symbol-put! table key value)
  33.         (printf "~n~nputting ~s in table:~s  as ~s~n~n" key table value)
  34.         (hash-set! table key value))
  35.  
  36. (for-each
  37.     (lambda (pair)
  38.             (symbol-put! *function-table* (car pair) (cadr pair)))
  39.     `(
  40.  
  41.         (log10_2 0.301029995663981195213738894724493026768189881)
  42.         (sqrt_2  1.414213562373095048801688724209698078569671875)
  43.         (div     ,(lambda (x y) (floor (/ x y))))
  44.         (log10   ,(lambda (x) (/ (log x) (log 10.0))))
  45.         (mod     ,(lambda (x y) (- x (* (div x y) y))))
  46.         (quot    ,(lambda (x y) (truncate (/ x y))))
  47.         (rem     ,(lambda (x y) (- x (* (quot x y) y))))
  48.         (+       ,+)
  49.         (*       ,*)
  50.         (-       ,-)
  51.         (/       ,(lambda (x y) (/ x (+ y 0.0) )))
  52.         (^       ,expt)
  53.         (ceil    ,ceiling)
  54.         (exp     ,exp)
  55.         (floor   ,floor)
  56.         (log     ,log) ;; add zero to x similarly to how we did /
  57.         (sqrt    ,sqrt)
  58.         (sin     ,sin)
  59.         (cos     ,cos)
  60.         (tan     ,tan)
  61.         (atan    ,atan)
  62.         (let     , (lambda x (interpret-let x)))
  63.         (print   , (lambda x (displayln x)));; (lambda x (apply displayln x)))  
  64.  
  65.      ))
  66. ;; now we fill the variable table with the prelim values pi & e
  67. (for-each
  68.     (lambda (pair)
  69.             (symbol-put! *variable-table* (car pair) (cadr pair)))
  70.     `(
  71.  
  72.         (e       2.718281828459045235360287471352662497757247093)
  73.         (pi      3.141592653589793238462643383279502884197169399)
  74. ))
  75.  
  76.  
  77. ;; here I create 'methods'
  78. ;; label table
  79. (define (get-label line-list)
  80.     (if (null? (cdr line-list))
  81.         null
  82.         (if (null? (cadr line-list))
  83.             null
  84.             (if (symbol? (cadr line-list))
  85.                 (hash-set! *label-table* (cadr line-list) (cddr line-list))
  86.                 null))))
  87.  
  88. (define (get-stmt line-list)
  89.     (if (null? (cdr line-list))
  90.         null
  91.         (if (null? (cadr line-list))
  92.             null
  93.             (if (not (symbol? (cadr line-list)))
  94.                 (cadr line-list)
  95.                 null))))
  96.  
  97.  
  98. ;; goal find first smt on a line and evaluate the statement
  99. (define (get-stmt line)
  100.      (if (null? (cdr line))
  101.         null
  102.         (if (null? (cadr line))
  103.             null
  104.             (if (symbol? (cadr line)) ;; if a label
  105.                 (cddr line);; return the next item
  106.                 (cadr line))))) ;; otherwise return stmt vthis may be wrong
  107.  
  108. ;; this method runs a single line of code
  109. ;; for this we first check if there is a label
  110. ;; or if there is a stmt
  111. ;; then we get the stmt and check the car of it
  112. ;; see if the cadr is equal to one of the six  key words
  113. ;; depending on which one we perform at action with the items
  114. ;; after the car
  115. ;; then look for next item on that list of line
  116.  
  117. ;; if the cdr is null
  118. ;; - skip
  119. ;; now check if there is a label or no label
  120.  
  121.  
  122.  
  123. ;; (begin (printf"statement not null "))  <---trash stmnt]
  124. ;; printf("The interpreter line was not null")))
  125. ;;(define (interpret-line line)
  126. ;;    (if (null? (  get-stmt line))
  127. ;;        null))
  128.        
  129.     ;;;;;;
  130. ;;        ())
  131. ;;    ( if (eq? (car (get-stmt line)) ("print"))
  132. ;;          (printf "~s~n" cadr (get-stmt line))
  133. ;;          ()) ;; do nothing, IDK IF U CAN DO THIS
  134. ;;    ( if) ;;  more if statements follow
  135.  
  136.  
  137.  
  138. (define *stderr* (current-error-port))
  139.  
  140. (define *run-file*
  141.     (let-values
  142.         (((dirpath basepath root?)
  143.             (split-path (find-system-path 'run-file))))
  144.         (path->string basepath))
  145. )
  146.  
  147. (define (die list)
  148.     (for-each (lambda (item) (display item *stderr*)) list)
  149.     (newline *stderr*)
  150.     (exit 1)
  151. )
  152.  
  153. (define (usage-exit)
  154.     (die `("Usage: " ,*run-file* " filename"))
  155. )
  156.  
  157. (define (readlist-from-inputfile filename)
  158.     (let ((inputfile (open-input-file filename)))  
  159.          (if (not (input-port? inputfile))
  160.              (die `(,*run-file* ": " ,filename ": open failed"))
  161.              (let ((program (read inputfile)))
  162.                   (close-input-port inputfile)
  163.                          program))))
  164.  
  165. (define (write-program-by-line filename program)
  166.     (printf "==================================================~n")
  167.     (printf "~a: ~s~n" *run-file* filename)
  168.     (printf "==================================================~n")
  169.     (printf "(~n")
  170.     ;; this map function returns a list named 'program' which is the result of the procedure
  171.     ;; (map (lambda (line) (printf "~s~n" line)) program) ;; this is where we print out each line
  172.     ;; first pass grabbing labels
  173.     ;; second pass interpret
  174.     ;;(map (lambda (line) (get-stmt line)) program)
  175.     ;;(map (lambda (line) ()))
  176.     ;; (printf ")~n Output: ~n")
  177.    
  178.     ;;(map (lambda (line) (get-label line)) program)    
  179.     (eval-expr program)
  180.  )
  181.  
  182.  
  183. ;; implementing LET statement
  184. (define (interpret-let expr)
  185.    (printf "let-interpretting.. ~s ~n" expr)
  186.    (printf "car is ~s ~n" (car expr))
  187.    (printf "cdr is ~s ~n" (cdr expr))
  188.    
  189.    (cond ((symbol? (car expr)) ;; if we are given a variable
  190.             (symbol-put! *variable-table* (car expr)  (eval-expr (cadr expr))))
  191.          ((pair? (car expr)) ;; if we are given an array
  192.                 (vector-set! (symbol-get *variable-table* (car (car expr)))
  193.                     (eval-expr(cadr (car expr))) (eval-expr(cadr expr))))                                         ;;(symbol-put! *variable-table* (car expr)  (eval-expr (cadr expr)))))
  194.          (else #f))      
  195. )
  196.  
  197. ;; implementing DIM statement
  198. (define (interpret-dim expr)
  199.     ;; what do we put here? do we make a vector? a list?
  200.     (printf "dim-interpretting.. ~s ~n" expr)
  201.     (symbol-put! *variable-table* (car expr) (make-vector (cadr expr) [car expr]))
  202. )
  203.  
  204. (define (eval-expr expr)
  205.    (printf "evaluating...~s ~n" expr)
  206.    (cond ((number? expr) expr)
  207.          ((symbol? expr)
  208.             (if (hash-has-key? *variable-table* expr)
  209.                 (symbol-get *variable-table* expr)
  210.                 (hash-ref *function-table* expr #f)))
  211.          ((pair? expr)
  212.             (if (hash-has-key? *variable-table* (car expr))
  213.                 (vector-ref (symbol-get *variable-table* (car expr)) (eval-expr(cadr expr)))
  214.                 (if (eq? (car expr) `let)
  215.                     (interpret-let (cdr expr))
  216.                     (if (eq? (car expr) `dim)
  217.                         (interpret-dim (cadr expr))
  218.                         (if (hash-has-key? *function-table* (car expr))
  219.                            (apply (symbol-get *function-table* (car expr)) (map eval-expr (cdr expr)))                                                        ;;(apply (hash-ref *function-table* (car expr)))
  220.                            (map eval-expr (cdr expr)))))))
  221.          ((null? expr) #f)
  222.          (else  expr))
  223.  
  224. )
  225.  
  226. (define (main arglist)
  227.     (if (or (null? arglist) (not (null? (cdr arglist))))
  228.         (usage-exit)
  229.         (let* ((sbprogfile (car arglist))
  230.                (program (readlist-from-inputfile sbprogfile)))
  231.               (write-program-by-line sbprogfile program))))
  232.  
  233. (main (vector->list (current-command-line-arguments)))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement