diff --git a/edls.rkt b/edls.rkt new file mode 100644 index 0000000..7bd183d --- /dev/null +++ b/edls.rkt @@ -0,0 +1,222 @@ +#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. + +(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))))