Advertisement
Guest User

Untitled

a guest
May 27th, 2017
71
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Racket 1.50 KB | None | 0 0
  1. #lang racket
  2. (require (planet dyoo/simply-scheme:2:2))
  3.  
  4. (define (parse expr)
  5.   (parse-helper expr '() '()))
  6.  
  7. (define (parse-helper expr operators operands)
  8.   (cond ((null? expr)
  9.      (if (null? operators)
  10.          (car operands)
  11.          (handle-op '() operators operands)))
  12.     ((number? (car expr))
  13.      (parse-helper (cdr expr)
  14.                operators
  15.                (cons (make-node (car expr) '()) operands)))
  16.     ((list? (car expr))
  17.      (parse-helper (cdr expr)
  18.                operators
  19.                (cons (parse (car expr)) operands)))
  20.     (else (if (or (null? operators)
  21.               (> (precedence (car expr))
  22.              (precedence (car operators))))
  23.           (parse-helper (cdr expr)
  24.                 (cons (car expr) operators)
  25.                 operands)
  26.           (handle-op expr operators operands)))))
  27.  
  28. (define (handle-op expr operators operands)
  29.   (parse-helper expr
  30.         (cdr operators)
  31.         (cons (make-node (car operators)
  32.                  (list (cadr operands) (car operands)))
  33.               (cddr operands))))
  34.  
  35. (define (precedence oper)
  36.   (if (member? oper '(+ -)) 1 2))
  37.  
  38. (define (compute tree)
  39.   (if (number? (datum tree))
  40.       (datum tree)
  41.       ((function-named-by (datum tree))
  42.          (compute (car (children tree)))
  43.          (compute (cadr (children tree))))))
  44.  
  45. (define (function-named-by oper)
  46.   (cond ((equal? oper '+) +)
  47.     ((equal? oper '-) -)
  48.     ((equal? oper '*) *)
  49.     ((equal? oper '/) /)
  50.     (else (error "no such operator as" oper))))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement