Advertisement
Guest User

this is the print worker

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