PasteRack.org
Paste # 72726
2014-09-01 00:30:18

Fork as a new paste.

Paste viewed 12 times.


Embed:

  1. #lang racket
  2. (require racket/control)
  3.  
  4.  
  5.  
  6. (define cont (make-parameter (lambda () (error "no cont"))))
  7. (define defs (make-parameter (hash)))
  8. (define label (make-parameter 0))
  9. (define env (make-parameter (hash)))
  10. (define trace-memo (make-parameter '()))
  11.  
  12. (define (trace x)
  13.   (shift k (parameterize* ([label (+ 1 (label))]
  14.                            [trace-memo (append
  15.                                              (trace-memo)
  16.                                              (list (list (label) x)))]) (k (label)))))
  17.  
  18.  
  19. (define (def n v)
  20.   (shift k
  21.        (parameterize ([defs (hash-set (defs) n v)])
  22.          (k '()))))
  23.  
  24. (define (ref v)
  25.   (hash-ref (env) exp))
  26.  
  27. (define code1
  28.   '(seq (def done x x)
  29.         (seq (def loop y (ifz y
  30.                               (done 0)
  31.                               (loop (- y 1))))
  32.              (loop 4))))
  33.  
  34. (define (eval1 exp)
  35.   (match exp
  36.     [(? integer?) exp]
  37.     [(? symbol?) (hash-ref (env) exp)]
  38.     [`(- ,x ,y) (- (eval1 x) (eval1 y))]
  39.     [`(,(and p (? symbol?)) ,arg)
  40.      (match-let ([`(lam ,v ,b) (hash-ref (defs) p)])
  41.        (parameterize ([env (hash-set (hash) v (eval1 arg))])
  42.          (eval1 b)))]
  43.     [`(ifz ,x ,p ,f)
  44.      (if (= 0 (eval1 x))
  45.          (eval1 p)
  46.          (eval1 f))]
  47.     [`(seq ,a ,b) (eval1 a) (eval1 b)]
  48.     [`(def ,n ,v ,b) (def n `(lam ,v ,b))]))
  49.  
  50.  
  51. (define (eval2 exp)
  52.   (match exp
  53.     [(? integer?) exp]
  54.     [(? symbol?) exp]
  55.     [`(- ,x ,y) `(- ,(eval2 x) ,(eval2 y))]
  56.     [`(,(and p (? symbol?)) ,arg) exp]
  57.     [`(lam ,v ,b) `(lambda (,v) ,(eval2 b))]
  58.     [`(ifz ,x ,p ,f)
  59.      `(if (= 0 ,(eval2 x))
  60.          ,(eval2 p)
  61.          ,(eval2 f))]
  62.     [`(seq ,a ,b) (eval2 a) (eval2 b)]
  63.     [`(def ,n ,v ,b) (def n (eval2 `(lam ,v ,b)))]))
  64.  
  65.  
  66.  
  67.  
  68.  
  69. (define (defs-result x) (list (defs) x))
  70.  
  71. (define (run eval x)
  72.   (reset (defs-result (eval x))))
  73. ;;(run eval2 code1)
  74.  
  75. (define curdef (make-parameter '()))
  76.  
  77. (define (eval3 exp)
  78.   (match exp
  79.     [(? integer?) exp]
  80.     [(? symbol?)
  81.      (if (hash-has-key? (env) exp)
  82.          (hash-ref (env) exp)
  83.          (error (~a "variable not in scope: " exp " (in def: " (curdef) ")")))]
  84.     [`(- ,x ,y) `(- ,(eval3 x) ,(eval3 y))]
  85.     [`(,(and p (? symbol?)) ,arg) exp]
  86.     [`(lam ,ps ,b)
  87.      (let ([alpha-pairs (map (lambda (x) (list x (gensym))) ps)])
  88.        (parameterize ([env (foldl (lambda (c m) (hash-set m (first c) (second c))) (env) alpha-pairs)])
  89.          `(lambda ,(map second alpha-pairs) ,(eval3 b))))]
  90.     [`(ifz ,x ,p ,f)
  91.      `(if (= 0 ,(eval3 x))
  92.          ,(eval3 p)
  93.          ,(eval3 f))]
  94.     [`(seq ,a ,b) (eval3 a) (eval3 b)]
  95.     [`(seq ,a ,es ...) (eval3 a) (eval3 `(seq ,@es))]
  96.     [`(def ,n ,ps ,b)
  97.      (parameterize ([curdef n])
  98.        (def n (eval3 `(lam ,ps ,b))))]))
  99.  
  100. (define code2
  101.   '(seq (def done (x) x)
  102.         (def loop (y) (ifz y
  103.                            (done 0)
  104.                            (loop (- y 1))))
  105.         (loop 4)))
  106.  
  107. (run eval3 code2)

=>

'(#hash((done . (lambda (g74) g74))

        (loop . (lambda (g75) (if (= 0 g75) (done 0) (loop (- y 1))))))

  (loop 4))