Advertisement
Guest User

Untitled

a guest
Jan 22nd, 2018
141
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Scheme 8.01 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) (+ 0.0 (/ x y)) ))
  52.         (^       ,expt)
  53.         (ceil    ,ceiling)
  54.         (exp     ,exp)
  55.         (floor   ,floor)
  56.         (log     ,log)
  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.    ;;(printf (pair? expr))
  189.    (cond ((null? expr) #f)
  190.        ((symbol? (car expr)) ;; if we see a variable, put in var table
  191.            ;; (begin
  192.                ;;  (print"symbol -interp let ~n")
  193.                  (symbol-put! *variable-table* (car expr)  (eval-expr (cadr expr))));;))
  194.         ((pair? (car expr)) ;; if we see a list recur into that expr and also recur on whatever is after
  195.             (begin
  196.                  (print "pair interp-let ~n")
  197.                  (interpret-let (car expr))
  198.                  (interpret-let (cdr expr))))
  199.         ((number? (car expr));; if we see a num this is an error
  200.             (printf "error, a number may not be the head of a list"))
  201.         ((hash-has-key? *function-table* (car expr)) ;; if we see somesort of operation do it
  202.              (eval-expr expr))
  203.         (else #f))      
  204. )
  205.  
  206. ;; implementing DIM statement
  207. (define (interpret-dim expr)
  208.     ;; what do we put here? do we make a vector? a list?
  209.     (printf "dim-interpretting.. ~s ~n" expr)
  210.     (symbol-put! *variable-table* (car expr) (make-vector (cadr expr) [car expr]))
  211. )
  212.  
  213. (define (eval-expr expr)
  214.    (printf "evaluating...~s ~n" expr)
  215.    (cond ((number? expr) expr)
  216.          ((symbol? expr)
  217.             (if (hash-has-key? *variable-table* expr)
  218.                 (symbol-get *variable-table* expr)
  219.                 (hash-ref *function-table* expr #f)))
  220.          ((pair? expr)  
  221.                 (if (eq? (car expr) `let)
  222.                     (interpret-let (cdr expr))
  223.                     (if (eq? (car expr) `dim)
  224.                         (interpret-dim (cadr expr))
  225.                         (if (hash-has-key? *function-table* (car expr))
  226.                            (apply (symbol-get *function-table* (car expr)) (map eval-expr (cdr expr)))                                                        ;;(apply (hash-ref *function-table* (car expr)))
  227.                            (map eval-expr (cdr expr))))))
  228.          ((null? expr) #f)
  229.          (else  expr))
  230.  
  231. )
  232.  
  233. (define (main arglist)
  234.     (if (or (null? arglist) (not (null? (cdr arglist))))
  235.         (usage-exit)
  236.         (let* ((sbprogfile (car arglist))
  237.                (program (readlist-from-inputfile sbprogfile)))
  238.               (write-program-by-line sbprogfile program))))
  239.  
  240. (main (vector->list (current-command-line-arguments)))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement