Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #!/afs/cats.ucsc.edu/courses/cmps112-wm/usr/racket/bin/mzscheme -qr
- ;; $Id: sbi.scm,v 1.3 2016-09-23 18:23:20-07 - - $
- ;;
- ;; NAME
- ;; sbi.scm - silly basic interpreter
- ;;
- ;; SYNOPSIS
- ;; sbi.scm filename.sbir
- ;;
- ;; DESCRIPTION
- ;; The file mentioned in argv[1] is read and assumed to be an SBIR
- ;; program, which is the executed. Currently it is only printed.
- ;;
- ;; here we create our tables
- (define *label-table* (make-hash))
- (define *variable-table* (make-hash))
- (define *function-table* (make-hash))
- ;; here we fill the function table with the prelim. functions
- ;; I think we write somethin like this to uses functions
- ;; (printf "2 ^ 16 = ~s~n" ((symbol-get '^) 2.0 16.0))
- ;; I changed symbol-get and symbol-put to require the table
- ;; that their grabbing from so that way we could use them for
- ;; other hash tables :-)
- (define (symbol-get table key)
- (hash-ref table key))
- (define (symbol-put! table key value)
- (printf "~n~nputting ~s in table:~s as ~s~n~n" key table value)
- (hash-set! table key value))
- (for-each
- (lambda (pair)
- (symbol-put! *function-table* (car pair) (cadr pair)))
- `(
- (log10_2 0.301029995663981195213738894724493026768189881)
- (sqrt_2 1.414213562373095048801688724209698078569671875)
- (div ,(lambda (x y) (floor (/ x y))))
- (log10 ,(lambda (x) (/ (log x) (log 10.0))))
- (mod ,(lambda (x y) (- x (* (div x y) y))))
- (quot ,(lambda (x y) (truncate (/ x y))))
- (rem ,(lambda (x y) (- x (* (quot x y) y))))
- (+ ,+)
- (* ,*)
- (- ,-)
- (/ ,(lambda (x y) (/ x (+ y 0.0) )))
- (^ ,expt)
- (ceil ,ceiling)
- (exp ,exp)
- (floor ,floor)
- (log ,log) ;; add zero to x similarly to how we did /
- (sqrt ,sqrt)
- (sin ,sin)
- (cos ,cos)
- (tan ,tan)
- (atan ,atan)
- (let , (lambda x (interpret-let x)))
- (print ,(lambda x (interpret-print x)))
- ))
- ;; now we fill the variable table with the prelim values pi & e
- (for-each
- (lambda (pair)
- (symbol-put! *variable-table* (car pair) (cadr pair)))
- `(
- (e 2.718281828459045235360287471352662497757247093)
- (pi 3.141592653589793238462643383279502884197169399)
- ))
- ;; here I create 'methods'
- ;; label table
- (define (get-label program)
- (printf "get-label... ~s~n~n" program)
- (if (null? program) ;; if we passed in nothing
- #f
- (if (null? (cdr (car program))) ;; if just a line number
- (get-label (cdr program))
- (if (symbol? (cadr (car program)));; if we encounter a label
- (begin ;; something after label
- (symbol-put! *label-table* (cadr (car program)) (cdr program)) (get-label (cdr program)))
- (get-label (cdr program))))));; if we didn't encounter a label
- (define (get-stmt line-list)
- (if (null? (cdr line-list))
- null
- (if (null? (cadr line-list))
- null
- (if (not (symbol? (cadr line-list)))
- (cadr line-list)
- null))))
- ;; goal find first smt on a line and evaluate the statement
- (define (get-stmt line)
- (if (null? (cdr line))
- null
- (if (null? (cadr line))
- null
- (if (symbol? (cadr line)) ;; if a label
- (cddr line);; return the next item
- (cadr line))))) ;; otherwise return stmt vthis may be wrong
- ;; this method runs a single line of code
- ;; for this we first check if there is a label
- ;; or if there is a stmt
- ;; then we get the stmt and check the car of it
- ;; see if the cadr is equal to one of the six key words
- ;; depending on which one we perform at action with the items
- ;; after the car
- ;; then look for next item on that list of line
- ;; if the cdr is null
- ;; - skip
- ;; now check if there is a label or no label
- ;; (begin (printf"statement not null ")) <---trash stmnt]
- ;; printf("The interpreter line was not null")))
- ;;(define (interpret-line line)
- ;; (if (null? ( get-stmt line))
- ;; null))
- ;;;;;;
- ;; ())
- ;; ( if (eq? (car (get-stmt line)) ("print"))
- ;; (printf "~s~n" cadr (get-stmt line))
- ;; ()) ;; do nothing, IDK IF U CAN DO THIS
- ;; ( if) ;; more if statements follow
- (define *stderr* (current-error-port))
- (define *run-file*
- (let-values
- (((dirpath basepath root?)
- (split-path (find-system-path 'run-file))))
- (path->string basepath))
- )
- (define (die list)
- (for-each (lambda (item) (display item *stderr*)) list)
- (newline *stderr*)
- (exit 1)
- )
- (define (usage-exit)
- (die `("Usage: " ,*run-file* " filename"))
- )
- (define (readlist-from-inputfile filename)
- (let ((inputfile (open-input-file filename)))
- (if (not (input-port? inputfile))
- (die `(,*run-file* ": " ,filename ": open failed"))
- (let ((program (read inputfile)))
- (close-input-port inputfile)
- program))))
- (define (write-program-by-line filename program)
- (printf "==================================================~n")
- (printf "~a: ~s~n" *run-file* filename)
- (printf "==================================================~n")
- (printf "(~n")
- ;; this map function returns a list named 'program' which is the result of the procedure
- ;; (map (lambda (line) (printf "~s~n" line)) program) ;; this is where we print out each line
- ;; first pass grabbing labels
- ;; second pass interpret
- ;;(map (lambda (line) (get-stmt line)) program)
- ;;(map (lambda (line) ()))
- ;; (printf ")~n Output: ~n")
- (get-label program)
- (eval-stmt program)
- )
- ;; implementing LET statement
- (define (interpret-let expr)
- (printf "let-interpretting.. ~s ~n" expr)
- (printf "car is ~s ~n" (car expr))
- (printf "cdr is ~s ~n" (cdr expr))
- (cond ((symbol? (car expr)) ;; if we are given a variable
- (symbol-put! *variable-table* (car expr) (eval-expr (cadr expr))))
- ((pair? (car expr)) ;; if we are given an array
- (vector-set! (symbol-get *variable-table* (car (car expr)))
- (eval-expr(cadr (car expr))) (eval-expr(cadr expr)))) ;;(symbol-put! *variable-table* (car expr) (eval-expr (cadr expr)))))
- (else #f))
- )
- ;; implementing DIM statement
- (define (interpret-dim expr)
- ;; what do we put here? do we make a vector? a list?
- (printf "dim-interpretting.. ~s ~n" expr)
- (symbol-put! *variable-table* (car expr) (make-vector (cadr expr) [car expr]))
- )
- ;; implementing GOTO statement
- (define (interpret-goto expr)
- (printf "~ninterpretting-goto.. ~s ~n" expr)
- (printf "interpretting-goto.. ~s ~n" (symbol-get *label-table* expr))
- (eval-stmt (symbol-get *label-table* expr))
- )
- (define (interpret-if expr)
- (if (eq? #t ((car (car expr)) (cadr (car expr)) (caddr (car expr))))
- (interpret-goto car (cddr expr))
- #f)
- )
- ;;(define (interpret-print expr) #f)
- ;; implementing PRINT statment
- ;; interpret-print takes in list x and recursively calls display
- ;; when x == '() prints a newline and returns
- (define (interpret-print x)
- (if (null? x)
- (newline)
- (begin
- (display(car x))
- (interpret-print (cdr x) )
- )
- )
- )
- (define (interpret-input expr) #f)
- (define (terminate-program)
- (exit))
- (define (eval-stmt program)
- (printf "evaluating statement ~s~n" program)
- (cond ((null? program) (exit))
- ;;((null? (cdr program)) (exit));; stops infinite loop
- ((null? (cdr (car program)))
- (eval-stmt (cdr program)))
- ((symbol? (car (car (cdr (car program)))))
- (cond ((eq? (car (car (cdr (car program)))) 'if)
- (interpret-if (cdr (cdr (car program)))))
- ((eq? (car (car (cdr (car program)))) 'goto)
- (interpret-goto (cadr (car (cdr (car program))))))
- ((eq? (car (car (cdr (car program)))) 'let)
- (begin
- (interpret-let (cdr (car (cdr (car program)))))
- (eval-stmt (cdr program))))
- ((eq? (car (car (cdr (car program)))) 'dim)
- (begin
- (interpret-dim (cdr (car (cdr (car program)))))
- (eval-stmt (cdr program))))
- ((eq? (car (car (cdr (car program)))) 'print)
- (begin
- (printf "calling print on: ~s~n~n" (cdr (car (cdr (car program)))))
- (interpret-print (cdr (car (cdr (car program)))))
- (eval-stmt (cdr program))))
- ((eq? (car (car (cdr (car program)))) 'input)
- (begin
- (interpret-input (cadr (cdr (car program))))
- (eval-stmt (cdr program))))
- (else (printf "error symbol undefined"))
- ))
- (else (eval-stmt (cdr program)))))
- (define (eval-expr expr)
- (printf "evaluating...~s ~n" expr)
- (cond ((number? expr) expr) ;; if its JUST a number
- ((hash-has-key? *variable-table* expr) ;; if its JUST a variable
- (symbol-get *variable-table* expr))
- ((pair? expr)
- (cond ((hash-has-key? *variable-table* (car expr)) ;; if its a memory operation
- (vector-ref (symbol-get *variable-table* (car expr)) (eval-expr(cadr expr))))
- ((hash-has-key? *function-table* (car expr)) ;; if its a function
- (apply (symbol-get *function-table* (car expr)) (map eval-expr (cdr expr)))) ;;(apply (hash-ref *function-table* (car expr)))
- (else (map eval-expr (cdr expr))))) ;;IDK nested expr???
- (else expr))) ;; IDK string or something else??
- (define (eval-expr2 expr)
- (printf "evaluating...~s ~n" expr)
- (cond ((number? expr) expr)
- ;;((null? (cdr expr)) terminate-program)
- ((symbol? expr)
- (if (hash-has-key? *variable-table* expr)
- (symbol-get *variable-table* expr)
- (hash-ref *function-table* expr #f)))
- ((pair? expr)
- (cond ((hash-has-key? *variable-table* (car expr))
- (vector-ref (symbol-get *variable-table* (car expr)) (eval-expr(cadr expr))))
- ((eq? (car expr) `let)
- (interpret-let (cdr expr)))
- ((eq? (car expr) `dim)
- (interpret-dim (cadr expr)))
- ((eq? (car expr) `goto)
- (interpret-goto (cadr expr)))
- ((hash-has-key? *function-table* (car expr))
- (apply (symbol-get *function-table* (car expr)) (map eval-expr (cdr expr)))) ;;(apply (hash-ref *function-table* (car expr)))
- (else (map eval-expr (cdr expr)))))
- ((null? expr) #f)
- (else expr))
- )
- (define (eval-expr2 expr)
- (printf "evaluating...~s ~n" expr)
- (cond ((number? expr) expr)
- ;;((null? (cdr expr)) terminate-program)
- ((symbol? expr)
- (if (hash-has-key? *variable-table* expr)
- (symbol-get *variable-table* expr)
- (hash-ref *function-table* expr #f)))
- ((pair? expr)
- (cond ((hash-has-key? *variable-table* (car expr))
- (vector-ref (symbol-get *variable-table* (car expr)) (eval-expr(cadr expr))))
- ((eq? (car expr) `let)
- (interpret-let (cdr expr)))
- ((eq? (car expr) `dim)
- (interpret-dim (cadr expr)))
- ((eq? (car expr) `goto)
- (interpret-goto (cadr expr)))
- ((hash-has-key? *function-table* (car expr))
- (apply (symbol-get *function-table* (car expr)) (map eval-expr (cdr expr)))) ;;(apply (hash-ref *function-table* (car expr)))
- (else (map eval-expr (cdr expr)))))
- ((null? expr) #f)
- (else expr))
- )
- (define (main arglist)
- (if (or (null? arglist) (not (null? (cdr arglist))))
- (usage-exit)
- (let* ((sbprogfile (car arglist))
- (program (readlist-from-inputfile sbprogfile)))
- (write-program-by-line sbprogfile program))))
- (main (vector->list (current-command-line-arguments)))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement