daily pastebin goal
28%
SHARE
TWEET

Untitled

a guest Oct 19th, 2018 76 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. (define (interp expr)
  2.   (local [(define lookup
  3.             ;; lookup looks up a variable name in a env
  4.             (lambda (id env)
  5.               (type-case Env env
  6.                 [mtEnv () (error "free variable")]
  7.                 [anEnv (name value anotherEnv) (if (symbol=? id name)
  8.                                                    value
  9.                                                    (lookup id anotherEnv))])))
  10.           (define sample-from-dist (get-default-sampler))
  11.  
  12.           ;; ISE Env number -> ValueXState
  13.           ;; helper for interp
  14.           (define interp-helper
  15.             (lambda (expr env state)
  16.               (type-case ISE expr
  17.                 [id (name) (vals (lookup name env) state)]
  18.                 [num (n) (vals (numV n) state)]
  19.                 [binop (op lhs rhs)
  20.                        (local [(define result (interp-helper lhs env state))
  21.                                (define lhsV (vals-val result))
  22.                                (define S1 (vals-state result))]
  23.                          (type-case ISE-Value lhsV
  24.                            [numV (n1)
  25.                                  (local [(define result (interp-helper rhs env S1)) ; state -> S1
  26.                                          (define rhsV (vals-val result))
  27.                                          (define S2 (vals-state result))]
  28.                                    (type-case ISE-Value rhsV
  29.                                      [numV (n2) (vals (wrapResult (op n1 n2)) S2)] ; state -> S2
  30.                                      [rejected () (vals (rejected) 0)]
  31.                                      [else (error "non-numerical value in binop rhs")]))]
  32.                            [rejected () (vals (rejected) 0)]
  33.                            [else (error "non-numerical value in binop lhs")]))]
  34.                 [ifelse (cond conseq altern)
  35.                         (local [(define result (interp-helper cond env state))
  36.                                 (define condV (vals-val result))
  37.                                 (define S1 (vals-state result))]
  38.                           (type-case ISE-Value condV
  39.                             [numV (n) (if (not (= n 0))
  40.                                           (interp-helper conseq env state)
  41.                                           (interp-helper altern env state))]
  42.                             [rejected () (vals (rejected) 0)]
  43.                             [else (error "non-boolean value in ifelse test")]))]
  44.                 [fun (param body) (vals (closureV param body env) state)]
  45.                 [app (f arg)
  46.                      (local [(define first (interp-helper f env state))
  47.                              (define fV (vals-val first))
  48.                              (define S1 (vals-state first))
  49.                              (define second (interp-helper arg env S1)) ; state -> S1
  50.                              (define argV (vals-val second))
  51.                              (define S2 (vals-state second))]
  52.                        (cond [(or (rejected? fV) (rejected? argV)) (vals (rejected) 0)]
  53.                              [(not (closureV? fV)) (error 'app "Function has to be a closureV!")]
  54.                              [else
  55.                               (let* ([param  (closureV-param fV)]
  56.                                      [body   (closureV-body fV)]
  57.                                      [cEnv   (closureV-env fV)]
  58.                                      [newEnv (anEnv param argV cEnv)])
  59.                                 (interp-helper body newEnv S2))]))] ; state -> S2
  60.                 [with (bnd body)
  61.                       (interp-helper (app (fun (binding-name bnd) body)
  62.                                           (binding-named-expr bnd))
  63.                                      env
  64.                                      state)]
  65.                 [distribution (elems)
  66.                               (local [;; ISE Env number -> (vals (listof ISE-Value) number)
  67.                                       ;; Evaluates a list of ISE's to a list of ISE-Value's and resulting state
  68.                                       (define (interp-list exprs env state)
  69.                                         (if (empty? exprs)
  70.                                             (values empty state)
  71.                                             (local [(define firstResult (interp-helper (first exprs) env state))
  72.                                                     (define expr-val (vals-val firstResult))
  73.                                                     (define expr-state (vals-state firstResult))
  74.                                                     (define-values (rest-vals rest-state) (interp-list (rest exprs) env expr-state))]
  75.                                               (values (cons expr-val rest-vals) state))))
  76.  
  77.                                       (define-values (elemsV S1) (interp-list elems env state))]
  78.                                 (if (or (empty? elemsV) (member (rejected) elemsV))
  79.                                     (vals (rejected) 0)
  80.                                     (vals (distV elemsV) state)))]
  81.                 [sample (e)
  82.                         (local [(define result (interp-helper e env state))
  83.                                 (define v (vals-val result))
  84.                                 (define S1 (vals-state result))]
  85.                           (type-case ISE-Value v
  86.                             [rejected () (vals (rejected) 0)]
  87.                             [distV (listVals)
  88.                                    (if (empty? listVals)
  89.                                        (error "Cannot sample empty distribution")
  90.                                        (vals (sample-from-dist listVals) S1))] ;state -> S1
  91.                             [else (error "Can only sample distributions")]))]
  92.                 [defquery (body) (vals (thunkV body env) state)]
  93.                 [infer (n query) (error "TODO")]
  94.                 [rec-begin (expr next)
  95.                            (local [(define first (interp-helper expr env state))
  96.                                    ;(define fv (vals-val first))
  97.                                    (define fs (vals-state first))
  98.                                    (define second (interp-helper next env fs))
  99.                                    (define sv (vals-val second))
  100.                                    (define ss (vals-state second))]
  101.                              (vals second ss))]
  102.                 [observe (dist pred) (error "TODO")])))]
  103.     ;; start with an empty env and weight of 1
  104.     (interp-helper expr (mtEnv) 1)))
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top