Yes
This commit is contained in:
@@ -15,6 +15,8 @@
|
|||||||
| { <TOY> <TOY> ... }
|
| { <TOY> <TOY> ... }
|
||||||
|#
|
|#
|
||||||
|
|
||||||
|
(define-type BINDINGS (Listof (Listof Symbol)))
|
||||||
|
|
||||||
;; A matching abstract syntax tree datatype:
|
;; A matching abstract syntax tree datatype:
|
||||||
(define-type TOY
|
(define-type TOY
|
||||||
[Num Number]
|
[Num Number]
|
||||||
@@ -185,23 +187,23 @@
|
|||||||
;; a global flag that can disable the compiler
|
;; a global flag that can disable the compiler
|
||||||
(define compiler-enabled? (box #f))
|
(define compiler-enabled? (box #f))
|
||||||
|
|
||||||
(: compile-body : (Listof TOY) -> (ENV -> VAL))
|
(: compile-body : (Listof TOY) BINDINGS -> (ENV -> VAL))
|
||||||
;; compiles a list of expressions to a single Racket function.
|
;; compiles a list of expressions to a single Racket function.
|
||||||
(define (compile-body exprs)
|
(define (compile-body exprs bin)
|
||||||
(unless (unbox compiler-enabled?)
|
(unless (unbox compiler-enabled?)
|
||||||
(error 'compile-body "compiler disabled"))
|
(error 'compile-body "compiler disabled"))
|
||||||
(let ([compiled-1st (compile (first exprs))]
|
(let ([compiled-1st (compile (first exprs) bin)]
|
||||||
[rest (rest exprs)])
|
[rest (rest exprs)])
|
||||||
(if (null? rest)
|
(if (null? rest)
|
||||||
compiled-1st
|
compiled-1st
|
||||||
(let ([compiled-rest (compile-body rest)])
|
(let ([compiled-rest (compile-body rest bin)])
|
||||||
(lambda (env)
|
(lambda (env)
|
||||||
(define ignored (compiled-1st env))
|
(define ignored (compiled-1st env))
|
||||||
(compiled-rest env))))))
|
(compiled-rest env))))))
|
||||||
|
|
||||||
(: compile-get-boxes : (Listof TOY) -> (ENV -> (Listof (Boxof VAL))))
|
(: compile-get-boxes : (Listof TOY) BINDINGS -> (ENV -> (Listof (Boxof VAL))))
|
||||||
;; utility for applying rfun
|
;; utility for applying rfun
|
||||||
(define (compile-get-boxes exprs)
|
(define (compile-get-boxes exprs bin)
|
||||||
(: compile-getter : TOY -> (ENV -> (Boxof VAL)))
|
(: compile-getter : TOY -> (ENV -> (Boxof VAL)))
|
||||||
(define (compile-getter expr)
|
(define (compile-getter expr)
|
||||||
(cases expr
|
(cases expr
|
||||||
@@ -218,9 +220,9 @@
|
|||||||
(map (lambda ([get-box : (ENV -> (Boxof VAL))]) (get-box env))
|
(map (lambda ([get-box : (ENV -> (Boxof VAL))]) (get-box env))
|
||||||
getters))))
|
getters))))
|
||||||
|
|
||||||
(: compile : TOY -> (ENV -> VAL))
|
(: compile : TOY BINDINGS -> (ENV -> VAL))
|
||||||
;; compiles TOY expressions to Racket functions.
|
;; compiles TOY expressions to Racket functions.
|
||||||
(define (compile expr)
|
(define (compile expr bin)
|
||||||
;; convenient helper for running compiled code
|
;; convenient helper for running compiled code
|
||||||
(: caller : ENV -> ((ENV -> VAL) -> VAL))
|
(: caller : ENV -> ((ENV -> VAL) -> VAL))
|
||||||
(define (caller env)
|
(define (caller env)
|
||||||
|
|||||||
Reference in New Issue
Block a user