Advertisement
Guest User

Untitled

a guest
Jan 23rd, 2018
80
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Scheme 12.86 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 program)
  80.     (printf "get-label... ~s~n~n" program)
  81.     (if (null? program) ;; if we passed in nothing
  82.         #f
  83.         (if (null? (cdr (car program))) ;; if just a line number
  84.             (get-label (cdr program))
  85.             (if (symbol? (cadr (car program)));; if we encounter a label
  86.                 (if (null? (cdr program)) ;; if there is nothing after label
  87.                     (begin ;; nothing after label
  88.                         (printf "~n ~n ~n ~n :) ~n") (symbol-put! *label-table* (cadr (car program)) (cdr (car program))) )  
  89.                     (begin ;; something after label
  90.                         (symbol-put! *label-table* (cadr (car program)) (cons (caddr (car program)) (cdr program))) (get-label (cdr program))))
  91.                 (get-label (cdr program))))));; if we didn't encounter a label
  92.  
  93. (define (get-stmt line-list)
  94.     (if (null? (cdr line-list))
  95.         null
  96.         (if (null? (cadr line-list))
  97.             null
  98.             (if (not (symbol? (cadr line-list)))
  99.                 (cadr line-list)
  100.                 null))))
  101.  
  102. ;; goal find first smt on a line and evaluate the statement
  103. (define (get-stmt line)
  104.      (if (null? (cdr line))
  105.         null
  106.         (if (null? (cadr line))
  107.             null
  108.             (if (symbol? (cadr line)) ;; if a label
  109.                 (cddr line);; return the next item
  110.                 (cadr line))))) ;; otherwise return stmt vthis may be wrong
  111.  
  112. ;; this method runs a single line of code
  113. ;; for this we first check if there is a label
  114. ;; or if there is a stmt
  115. ;; then we get the stmt and check the car of it
  116. ;; see if the cadr is equal to one of the six  key words
  117. ;; depending on which one we perform at action with the items
  118. ;; after the car
  119. ;; then look for next item on that list of line
  120.  
  121. ;; if the cdr is null
  122. ;; - skip
  123. ;; now check if there is a label or no label
  124.  
  125.  
  126.  
  127. ;; (begin (printf"statement not null "))  <---trash stmnt]
  128. ;; printf("The interpreter line was not null")))
  129. ;;(define (interpret-line line)
  130. ;;    (if (null? (  get-stmt line))
  131. ;;        null))
  132.        
  133.     ;;;;;;
  134. ;;        ())
  135. ;;    ( if (eq? (car (get-stmt line)) ("print"))
  136. ;;          (printf "~s~n" cadr (get-stmt line))
  137. ;;          ()) ;; do nothing, IDK IF U CAN DO THIS
  138. ;;    ( if) ;;  more if statements follow
  139.  
  140.  
  141.  
  142. (define *stderr* (current-error-port))
  143.  
  144. (define *run-file*
  145.     (let-values
  146.         (((dirpath basepath root?)
  147.             (split-path (find-system-path 'run-file))))
  148.         (path->string basepath))
  149. )
  150.  
  151. (define (die list)
  152.     (for-each (lambda (item) (display item *stderr*)) list)
  153.     (newline *stderr*)
  154.     (exit 1)
  155. )
  156.  
  157. (define (usage-exit)
  158.     (die `("Usage: " ,*run-file* " filename"))
  159. )
  160.  
  161. (define (readlist-from-inputfile filename)
  162.     (let ((inputfile (open-input-file filename)))  
  163.          (if (not (input-port? inputfile))
  164.              (die `(,*run-file* ": " ,filename ": open failed"))
  165.              (let ((program (read inputfile)))
  166.                   (close-input-port inputfile)
  167.                          program))))
  168.  
  169. (define (write-program-by-line filename program)
  170.     (printf "==================================================~n")
  171.     (printf "~a: ~s~n" *run-file* filename)
  172.     (printf "==================================================~n")
  173.     (printf "(~n")
  174.     ;; this map function returns a list named 'program' which is the result of the procedure
  175.     ;; (map (lambda (line) (printf "~s~n" line)) program) ;; this is where we print out each line
  176.     ;; first pass grabbing labels
  177.     ;; second pass interpret
  178.     ;;(map (lambda (line) (get-stmt line)) program)
  179.     ;;(map (lambda (line) ()))
  180.     ;; (printf ")~n Output: ~n")
  181.    
  182.     (get-label program)    
  183.     (eval-stmt program)
  184.  )
  185.  
  186.  
  187. ;; implementing LET statement
  188. (define (interpret-let expr)
  189.    (printf "let-interpretting.. ~s ~n" expr)
  190.    (printf "car is ~s ~n" (car expr))
  191.    (printf "cdr is ~s ~n" (cdr expr))
  192.    
  193.    (cond ((symbol? (car expr)) ;; if we are given a variable
  194.             (symbol-put! *variable-table* (car expr)  (eval-expr (cadr expr))))
  195.          ((pair? (car expr)) ;; if we are given an array
  196.                 (vector-set! (symbol-get *variable-table* (car (car expr)))
  197.                     (eval-expr(cadr (car expr))) (eval-expr(cadr expr))))                                         ;;(symbol-put! *variable-table* (car expr)  (eval-expr (cadr expr)))))
  198.          (else #f))      
  199. )
  200.  
  201. ;; implementing DIM statement
  202. (define (interpret-dim expr)
  203.     ;; what do we put here? do we make a vector? a list?
  204.     (printf "dim-interpretting.. ~s ~n" expr)
  205.     (symbol-put! *variable-table* (car expr) (make-vector (cadr expr) [car expr]))
  206. )
  207.  
  208. ;; implementing GOTO statement
  209. (define (interpret-goto expr)
  210.     (printf "~ninterpretting-goto.. ~s ~n" expr)
  211.     (printf "interpretting-goto.. ~s ~n" (symbol-get *label-table* expr))
  212.     (eval-expr (symbol-get *label-table* expr))
  213. )
  214.  
  215. (define (interpret-if expr)
  216.     (if (eq? #t ((car (car expr)) (cadr (car expr))  (caddr (car expr))))
  217.         (interpret-goto car (cddr expr))
  218.         #f)
  219.     )
  220.  
  221. (define (interpret-print expr) #f)    
  222.  
  223. (define (interpret-input expr) #f)        
  224.        
  225.  
  226.  
  227. (define (terminate-program)
  228.     (exit))
  229.  
  230. (define (eval-stmt program)
  231.     (printf "evaluating statement ~s~n" program)
  232.     (cond ((null? (cdr program)) (exit));; stops infinite loop
  233.           ((null? (cdr (car program)))
  234.              (eval-stmt (cdr program)))
  235.           ((symbol? (car (car (cdr (car program)))))
  236.              
  237.              (cond ((eq? (car (car (cdr (car program)))) 'if)
  238.                         (interpret-if (cadr (cdr (car program)))))
  239.                        
  240.                    ((eq? (car (car (cdr (car program)))) 'goto)
  241.                         (interpret-goto (cadr (car (car (cdr (car program)))))))
  242.                        
  243.                    ((eq? (car (car (cdr (car program)))) 'let)
  244.                         (begin
  245.                             (interpret-let (cdr (car (car (cdr (car program))))))
  246.                             (eval-stmt (cdr program))))
  247.  
  248.                    ((eq? (car (car (cdr (car program)))) 'dim)
  249.                         (begin
  250.                             (interpret-dim (cadr (car (car (cdr (car program))))))
  251.                             (eval-stmt (cdr program))))
  252.  
  253.                    ((eq? (car (car (cdr (car program)))) 'print)
  254.                         (begin
  255.                             (interpret-print (cadr (cdr (car program))))
  256.                             (eval-stmt (cdr program))))
  257.  
  258.                    ((eq? (car (car (cdr (car program)))) 'input)
  259.                         (begin
  260.                             (interpret-input (cadr (cdr (car program))))
  261.                             (eval-stmt (cdr program))))
  262.  
  263.                    (else (printf "error symbol undefined"))
  264.                        ))
  265.           (else (eval-stmt (cdr program)))))
  266.  
  267.  
  268. (define (eval-expr expr)
  269.    (printf "evaluating...~s ~n" expr)
  270.    (cond ((number? expr) expr) ;; if its JUST a number
  271.          ((hash-has-key? *variable-table* (car expr)) ;; if its JUST a variable
  272.             (symbol-get *variable-table* (car expr)))
  273.          ((pair? expr)
  274.             (cond ((hash-has-key? *variable-table* (car expr)) ;; if its a memory operation
  275.                        (vector-ref (symbol-get *variable-table* (car expr)) (eval-expr(cadr expr))))
  276.                   ((hash-has-key? *function-table* (car expr)) ;; if its a function
  277.                         (apply (symbol-get *function-table* (car expr)) (map eval-expr (cdr expr))))                                                        ;;(apply (hash-ref *function-table* (car expr)))
  278.                   (else (map eval-expr (cdr expr))))) ;;IDK nested expr???
  279.          (else expr))) ;; IDK string or something else??
  280.  
  281.                  
  282.  
  283.  
  284.  
  285.  
  286.    
  287. (define (eval-expr2 expr)
  288.    (printf "evaluating...~s ~n" expr)
  289.    (cond ((number? expr) expr)
  290.          ;;((null? (cdr expr)) terminate-program)
  291.          ((symbol? expr)
  292.             (if (hash-has-key? *variable-table* expr)
  293.                 (symbol-get *variable-table* expr)
  294.                 (hash-ref *function-table* expr #f)))
  295.           ((pair? expr)
  296.             (cond ((hash-has-key? *variable-table* (car expr))
  297.                         (vector-ref (symbol-get *variable-table* (car expr)) (eval-expr(cadr expr))))
  298.                   ((eq? (car expr) `let)
  299.                         (interpret-let (cdr expr)))
  300.                   ((eq? (car expr) `dim)
  301.                         (interpret-dim (cadr expr)))
  302.                   ((eq? (car expr) `goto)
  303.                         (interpret-goto (cadr expr)))
  304.                   ((hash-has-key? *function-table* (car expr))
  305.                         (apply (symbol-get *function-table* (car expr)) (map eval-expr (cdr expr))))                                                        ;;(apply (hash-ref *function-table* (car expr)))
  306.                   (else (map eval-expr (cdr expr)))))      
  307.          ((null? expr) #f)
  308.          (else  expr))
  309. )
  310.  
  311.  
  312. (define (eval-expr2 expr)
  313.    (printf "evaluating...~s ~n" expr)
  314.    (cond ((number? expr) expr)
  315.          ;;((null? (cdr expr)) terminate-program)
  316.          ((symbol? expr)
  317.             (if (hash-has-key? *variable-table* expr)
  318.                 (symbol-get *variable-table* expr)
  319.                 (hash-ref *function-table* expr #f)))
  320.           ((pair? expr)
  321.             (cond ((hash-has-key? *variable-table* (car expr))
  322.                         (vector-ref (symbol-get *variable-table* (car expr)) (eval-expr(cadr expr))))
  323.                   ((eq? (car expr) `let)
  324.                         (interpret-let (cdr expr)))
  325.                   ((eq? (car expr) `dim)
  326.                         (interpret-dim (cadr expr)))
  327.                   ((eq? (car expr) `goto)
  328.                         (interpret-goto (cadr expr)))
  329.                   ((hash-has-key? *function-table* (car expr))
  330.                         (apply (symbol-get *function-table* (car expr)) (map eval-expr (cdr expr))))                                                        ;;(apply (hash-ref *function-table* (car expr)))
  331.                   (else (map eval-expr (cdr expr)))))      
  332.          ((null? expr) #f)
  333.          (else  expr))
  334. )
  335.  
  336.  
  337. (define (main arglist)
  338.     (if (or (null? arglist) (not (null? (cdr arglist))))
  339.         (usage-exit)
  340.         (let* ((sbprogfile (car arglist))
  341.                (program (readlist-from-inputfile sbprogfile)))
  342.               (write-program-by-line sbprogfile program))))
  343.  
  344. (main (vector->list (current-command-line-arguments)))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement