243 lines
8.8 KiB
Racket
243 lines
8.8 KiB
Racket
#lang racket/base
|
|
;; Extensible Denotational Language Specifications
|
|
|
|
;; The paper "Extensible Denotational Language Specifications", by
|
|
;; Cartwright & Felleisen (1994), henceforth "EDLS", presents a
|
|
;; picture of an extensible interpreter for programming languages. The
|
|
;; interpreter can be extended with new syntactic forms (and their
|
|
;; meanings), new actions (and their effects), and new kinds of
|
|
;; resources to be placed under its control.
|
|
|
|
;; Rather than interpreting an extensible collection of syntax here,
|
|
;; we call Racket code directly. Extension at the syntactic level is
|
|
;; provided by Racket's macros. The purpose of this code is to provide
|
|
;; a structured model of the extensible actions and extensible
|
|
;; resource-management facets of the EDLS design. We use delimited
|
|
;; continuations to transfer control between the "pure" facet (the
|
|
;; interpretation of programs) and the impure or operational facets
|
|
;; (the performing of actions, and management of resources).
|
|
|
|
;; TODO: investigate continuation barriers, to avoid throws out
|
|
;; through the current interpreter/VM. Actually, think harder about
|
|
;; what even needs protecting - it's not clear.
|
|
|
|
;; TODO: what happens when an interactor, performing an action, raises
|
|
;; an exception? What should happen? In some sense it's the fault of
|
|
;; the invoker of the action, isn't it? Consider binding a UDP socket
|
|
;; to a port already in use. Alternatively, consider some internal
|
|
;; error in the interactor: then it's not the fault of the invoker at
|
|
;; all.
|
|
|
|
;; TODO: pull in scheduler and event-stream ideas from Olin's papers
|
|
|
|
;; TODO: consider splitting lookup from apply in
|
|
;; action-handlers. Consider, for instance, replicating action
|
|
;; streams: you might want to check for DNU before replicating the
|
|
;; pending action.
|
|
|
|
;; TODO: think about using a private prompt tag, and what the
|
|
;; consequences for cross-virtual-level interaction are if multiple
|
|
;; prompt tags are in play. This will force some thinking about
|
|
;; continuation barriers, too.
|
|
|
|
;; TODO: think about how a weak table might be exposed as a
|
|
;; resource. Its implementation depends on primitive weakness! (Or on
|
|
;; a transitively-provided weak service.)
|
|
|
|
#|
|
|
|
|
Things that can wake up some continuations:
|
|
|
|
- external events (CML-style, timeouts)
|
|
- internal events (completion of a write or similar)
|
|
- unguarded continuations (spawned threads, basically)
|
|
|
|
|
|
Are these containery things the conversation/chatrooms of racket-ssh?
|
|
|
|
|#
|
|
|
|
;; From the fine manual: "The protocol for vs supplied to an abort is
|
|
;; specific to the prompt-tag. When abort-current-continuation is used
|
|
;; with (default-continuation-prompt-tag), generally, a single thunk
|
|
;; should be supplied that is suitable for use with the default prompt
|
|
;; handler. Similarly, when call-with-continuation-prompt is used with
|
|
;; (default-continuation-prompt-tag), the associated handler should
|
|
;; generally accept a single thunk argument."
|
|
|
|
;; Semantic framework from EDLS:
|
|
;;
|
|
;; computation : (+ (make-value value) (make-effect action (-> value computation)))
|
|
;; program-meaning : (-> program (* (+ value error) resources)
|
|
;; expression-meaning : (-> expr env computation)
|
|
;; admin : (-> (* computation resources) (* (+ value error) resources))
|
|
;; handler : (-> computation (-> value computation) computation)
|
|
;;
|
|
;; Handler is used to stitch stack frames together into a composed
|
|
;; continuation, something that we're doing here natively with
|
|
;; Racket's composable continuations.
|
|
;;
|
|
;; If we're going to make values self-representing, then we need to
|
|
;; ensure that all effects are disjoint from values. The way to do
|
|
;; that is to control the abort/prompt-tag protocol closely, so that
|
|
;; regular values returned are distinguished from actions thrown. That
|
|
;; way, no value is forbidden to the userland, including descriptions
|
|
;; of actions.
|
|
|
|
;; Can we say that the *communications facility* in EDLS is
|
|
;; underpowered? It's point-to-point and relies on noninterference
|
|
;; between action-handling extensions. Since each extension is
|
|
;; logically managing its own resources, it feels like we have a kind
|
|
;; of network-layer here IF we enforce separation of the managed
|
|
;; resources so there are no cross-channels.
|
|
;;
|
|
;; The reason I'm interested in this approach is to get some kind of
|
|
;; objcap-oriented interface not only to the substrate but to the
|
|
;; extensions embedded in the substrate. Consider the DNS-server case,
|
|
;; where a socket needs to be opened and then straight-line
|
|
;; interactions with the socket take place. Now consider the DNS-proxy
|
|
;; case, where not only does a socket (or more than one!) need to be
|
|
;; created, but complex conversional contexts are built up as each
|
|
;; query arrives and is processed. As DJB observes, a single query can
|
|
;; in principle result in unbounded recursion as "glue" records are
|
|
;; looked up. It kind of makes sense to have each conversational
|
|
;; context as a separate entity, managing its own resources, embedded
|
|
;; in the substrate.
|
|
|
|
(require racket/match)
|
|
(require racket/class)
|
|
|
|
(define interactor<%>
|
|
(interface ()
|
|
perform-action))
|
|
|
|
(define action-prompt (make-continuation-prompt-tag 'interactor-action))
|
|
|
|
(define (perform-action . action-pieces)
|
|
(call-with-composable-continuation
|
|
(lambda (k)
|
|
(abort-current-continuation action-prompt
|
|
(lambda () (values action-pieces k))))
|
|
action-prompt))
|
|
|
|
(define (run/interactor boot interactor)
|
|
(call-with-continuation-barrier
|
|
(lambda ()
|
|
(let loop ((next-step-thunk (lambda () (values (boot) #f)))
|
|
(interactor interactor))
|
|
(define-values (computation-step-result computation-step-continuation)
|
|
(call-with-continuation-prompt next-step-thunk action-prompt))
|
|
(cond
|
|
((eq? computation-step-continuation #f)
|
|
;; The computation is finished, and has yielded a result.
|
|
computation-step-result)
|
|
(else
|
|
;; The computation is not finished, but is waiting for an
|
|
;; action to complete.
|
|
(send interactor perform-action
|
|
computation-step-result
|
|
(lambda (action-result-value new-interactor)
|
|
(loop (lambda () (computation-step-continuation action-result-value))
|
|
new-interactor))
|
|
(lambda ()
|
|
(error 'run/interactor "Action not interpretable by context: ~v"
|
|
computation-step-result)))))))))
|
|
|
|
(define cells%
|
|
(class* object% (interactor<%>)
|
|
(init-field next-name)
|
|
(init-field mapping)
|
|
(super-new)
|
|
(define/public (perform-action action k-ok k-dnu)
|
|
(match action
|
|
(`(new ,initial-value)
|
|
(k-ok next-name (make-object cells%
|
|
(+ next-name 1)
|
|
(hash-set mapping next-name initial-value))))
|
|
(`(get ,n)
|
|
(if (hash-has-key? mapping n)
|
|
(k-ok (hash-ref mapping n) this)
|
|
(error 'cells% "Cell name ~v not found (on get)" n)))
|
|
(`(set ,n ,new-value)
|
|
(if (hash-has-key? mapping n)
|
|
(k-ok new-value (make-object cells%
|
|
next-name
|
|
(hash-set mapping n new-value)))
|
|
(error 'cells% "Cell name ~v not found (on set)" n)))
|
|
(else
|
|
(k-dnu))))))
|
|
|
|
(define (new-cell [initial-value (void)])
|
|
(perform-action 'new initial-value))
|
|
|
|
(define (get-cell c)
|
|
(perform-action 'get c))
|
|
|
|
(define (set-cell! c v)
|
|
(perform-action 'set c v))
|
|
|
|
(define (empty-cells)
|
|
(make-object cells% 0 (hash)))
|
|
|
|
(define combine%
|
|
(class* object% (interactor<%>)
|
|
(init-field children)
|
|
(super-new)
|
|
(define/public (perform-action action k-ok k-dnu)
|
|
(let search ((remaining children)
|
|
(examined '()))
|
|
(cond
|
|
((null? remaining) (k-dnu))
|
|
(else
|
|
(define child (car remaining))
|
|
(define rest (cdr remaining))
|
|
(send child perform-action
|
|
action
|
|
(lambda (result new-child)
|
|
(k-ok result
|
|
(make-object combine% (append (reverse examined) (cons new-child rest)))))
|
|
(lambda ()
|
|
(search rest (cons child examined))))))))))
|
|
|
|
(define (combine-interactors is)
|
|
(make-object combine% is))
|
|
|
|
(define udp%
|
|
(class* object% (interactor<%>)
|
|
(struct handle (socket)) ;; generative: new predicate etc. per udp% instance!
|
|
(super-new)
|
|
(define/public (perform-action action k-ok k-dnu)
|
|
(match action
|
|
(`(new)
|
|
(k-ok (handle (udp-open-socket #f #f)) this))
|
|
(`(bind ,(handle s) ,port)
|
|
(k-ok (udp-bind! s #f port) this))
|
|
(`(send ,(handle s) ,host ,port ,packet)
|
|
(k-ok (udp-send-to s host port packet) this))
|
|
(`(recv ,(handle s) ,packet-size-limit)
|
|
(define buffer (make-bytes packet-size-limit))
|
|
(define-values (packet-length source-hostname source-port)
|
|
(udp-receive! s buffer))
|
|
(k-ok (list source-hostname source-port (subbytes buffer 0 packet-length)) this))
|
|
(else (k-dnu))))))
|
|
|
|
(run/interactor (lambda () 1234)
|
|
(empty-cells))
|
|
|
|
(run/interactor (lambda ()
|
|
(let ((x (new-cell)))
|
|
(set-cell! x 1)
|
|
(set-cell! x (+ 1 (get-cell x)))
|
|
(+ 1000 (get-cell x))))
|
|
(empty-cells))
|
|
|
|
(run/interactor (lambda ()
|
|
(let ((x (new-cell 'initial-x-value))
|
|
(y (new-cell 'initial-y-value)))
|
|
(set-cell! x 1)
|
|
(set-cell! y 1000)
|
|
(set-cell! x (+ 1 (get-cell x)))
|
|
(+ (get-cell x)
|
|
(get-cell y))))
|
|
(combine-interactors (list (empty-cells))))
|