PasteRack.org
Paste # 59339
2017-09-09 18:18:40

Fork as a new paste.

Paste viewed 82 times.


Embed:

  1. #lang racket
  2.  
  3. ;; A BSL-var-expr is one of:
  4. ;;  Number
  5. ;;  Symbol
  6. ;;  (make-add BSL-var-expr BSL-var-expr)
  7. ;;  (make-mul BSL-var-expr BSL-var-expr)
  8. ;; - (make-aplikation name arg)
  9.  
  10.  
  11. (define-struct add [left right])
  12. (define-struct mul [left right])
  13. (define-struct aplikation [name arg])
  14.  
  15. (define(subst ex x v)
  16.   (cond
  17.     ((number? ex)ex)
  18.     ((add? ex)(make-add(subst(add-left ex)x v)
  19.                        (subst(add-right ex)x v)))
  20.     ((mul? ex)(make-mul(subst(mul-left ex)x v)
  21.                        (subst(mul-right ex)x v)))
  22.     ((symbol? ex)(if(symbol=? ex x)v ex))
  23.     ((aplikation? ex)(make-aplikation (aplikation-name ex) (subst(aplikation-arg ex)x v)))))
  24.  
  25. (define(eval-var-lookup ex da)
  26.   (cond
  27.     ((number? ex)ex)
  28.     ((add? ex)(+(eval-var-lookup(add-left ex)da)
  29.                 (eval-var-lookup(add-right ex)da)))
  30.     ((mul? ex)(*(eval-var-lookup(mul-left ex)da)
  31.                 (eval-var-lookup(mul-right ex)da)))
  32.     ((symbol? ex)(if(not(list?(assq ex da)))
  33.                     (error "blad")
  34.                     (cadr(assq ex da))))))
  35.  
  36. ;; 357
  37. (define(eval-definition1 ex f x b)
  38.   (cond
  39.     ((number? ex)ex)
  40.     ((add? ex)(+(eval-definition1(add-left ex)f x b)
  41.                 (eval-definition1(add-right ex)f x b)))
  42.     ((mul? ex)(*(eval-definition1(mul-left ex)f x b)
  43.                 (eval-definition1(mul-right ex)f x b)))
  44.     ((aplikation? ex)
  45.      (if(not(equal?(aplikation-name ex)f))
  46.         (error "blad")
  47.         (local ((define value (eval-definition1(aplikation-arg ex) f x b))
  48.                 (define plugd (subst b x value)))
  49.           (eval-definition1 plugd f x b))))))
  50.  
  51.  
  52. ;; dziala
  53. ;;(eval-definition1 (make-aplikation 'plus-nine (make-add 1 1)) 'plus-nine 'p (make-add 9 'p))

=>