From 4d00c1bb5e1ef362b67998f61e629262d497fcf0 Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Mon, 8 Apr 2013 19:00:18 -0600 Subject: [PATCH] trying to get the module output working. --- whalesong/repl-prototype/htdocs/repl.js | 6 ++- whalesong/repl-prototype/htdocs/rpc.js | 27 +++++++++- .../repl-prototype/modularize-input-port.rkt | 53 +++++++++++++++++++ whalesong/repl-prototype/server.rkt | 44 +++++++++------ 4 files changed, 111 insertions(+), 19 deletions(-) create mode 100644 whalesong/repl-prototype/modularize-input-port.rkt diff --git a/whalesong/repl-prototype/htdocs/repl.js b/whalesong/repl-prototype/htdocs/repl.js index b341f32..b07cf74 100644 --- a/whalesong/repl-prototype/htdocs/repl.js +++ b/whalesong/repl-prototype/htdocs/repl.js @@ -142,7 +142,7 @@ var that = this; if (compiledResult.type === 'error') { return onDoneFail(compiledResult); - } else { + } else if (compiledResult.type === 'repl') { // compiledResult.compiledCodes is an array of function chunks. // The evaluation leaves the value register of the machine // to contain the list of values from toplevel evaluation. @@ -165,6 +165,10 @@ codeFunction(that.M, onGoodEvaluation, onBadEvaluation); }, onDoneSuccess); + } else if (compiledResult.type === 'module') { + throw new Error("internal error: not yet implemented"); + } else { + throw new Error("internal error: unexpected compilation result"); } }; diff --git a/whalesong/repl-prototype/htdocs/rpc.js b/whalesong/repl-prototype/htdocs/rpc.js index 9f05467..34a897d 100644 --- a/whalesong/repl-prototype/htdocs/rpc.js +++ b/whalesong/repl-prototype/htdocs/rpc.js @@ -17,12 +17,37 @@ }); }; + + + var moduleCompile = function(options, onDone, onDoneError) { + jQuery.ajax({ 'url': url, + 'cache': false, + 'success': function(data, textStatus, jqXHR) { + onDone(data); + }, + 'error': function(jqXHR, textStatus, errorThrown) { + onDoneError(errorThrown); + }, + 'data': {'name' : options.name, // source + 'mname' : options.mname, + 'lang' : options.lang, + 'src' : options.code, + 'm' : 't'}, + 'dataType': 'json', + 'type' : 'post' + }); + }; + + + + // If we're in the context of an iframe, provide an easyXDM // interface to the compiler. if (window.top !== window) { new easyXDM.Rpc({}, { local: { - 'replCompile': { method: replCompile } + 'replCompile': { method: replCompile }, + 'moduleCompile': { method: moduleCompile } } }); } diff --git a/whalesong/repl-prototype/modularize-input-port.rkt b/whalesong/repl-prototype/modularize-input-port.rkt new file mode 100644 index 0000000..f0d1a99 --- /dev/null +++ b/whalesong/repl-prototype/modularize-input-port.rkt @@ -0,0 +1,53 @@ +#lang racket/base + +(require racket/port + racket/contract) + +(provide (contract-out [modularize-input-port (-> + #:module-name symbol? + #:input-port input-port? + #:semantics-module symbol? + input-port?)])) + +;; Add a module wrapper around s-expression-based toplevel code, but +;; preserving original source locations as best as we can. +(define (modularize-input-port #:module-name name ;; symbol + #:input-port ip ;; input port + #:semantics-module semantics-module) ;; symbol + (define header (format "(module ~s ~s\n" name semantics-module)) + (define lang-ip (open-input-string header)) + + (define concatenated-port (input-port-append #f lang-ip ip (open-input-string ")"))) + (define (count-concatenated-port) + (port-count-lines! concatenated-port)) + + (define (get-location) + (define-values (line column position) (port-next-location concatenated-port)) + (cond [(not (and line column position)) + (values #f #f #f)] + [(<= position (string-length header)) + (values #f #f #f)] + [else + (port-next-location ip)])) + + (define-values (starting-line starting-col starting-pos) + (port-next-location ip)) + (transplant-input-port concatenated-port + get-location + (or starting-pos 1) + #f + count-concatenated-port)) + + +(module* test racket/base + (require (submod "..") + racket/port) + (define original-ip (open-input-string "(+ 1\n 2)")) + (port-count-lines! original-ip) + (define relocated-ip (relocate-input-port original-ip 5 1 200)) + (port-count-lines! relocated-ip) + (define new-ip (modularize-input-port #:module-name 'test + #:input-port relocated-ip #;original-ip + #:semantics-module 'wescheme)) + (port-count-lines! new-ip) + (read-syntax #f new-ip)) diff --git a/whalesong/repl-prototype/server.rkt b/whalesong/repl-prototype/server.rkt index 30d9cdc..95abd7a 100644 --- a/whalesong/repl-prototype/server.rkt +++ b/whalesong/repl-prototype/server.rkt @@ -1,7 +1,6 @@ #lang racket/base -(require "repl-compile.rkt" - json +(require json file/gzip racket/runtime-path racket/port @@ -9,6 +8,8 @@ racket/pretty web-server/servlet-env web-server/servlet + "repl-compile.rkt" + "modularize-input-port.rkt" "../make/make-structs.rkt" "../js-assembler/package.rkt" "../parser/parse-bytecode.rkt" @@ -63,14 +64,18 @@ out)) +(define (lookup-binding req id) + (if (exists-binding? 'id (request-bindings req)) + (extract-binding/single 'id (request-bindings req)) + #f)) (define (start req) (define-values (response op) (make-port-response #:mime-type #"text/json" #:with-cors? #t)) - (define name (if (exists-binding? 'name (request-bindings req)) - (extract-binding/single 'name (request-bindings req)) - #f)) - (define text-src (extract-binding/single 'src (request-bindings req))) + (define source-name (lookup-binding req 'name)) + (define mname (lookup-binding req 'mname)) + (define lang (lookup-binding req 'lang)) + (define src (extract-binding/single 'src (request-bindings req))) (define as-mod? (match (extract-bindings 'm (request-bindings req)) [(list (or "t" "true")) #t] @@ -81,11 +86,11 @@ 'message (exn-message exn)) op))]) (cond [(not as-mod?) - (define ip (open-input-string text-src)) + (define ip (open-input-string src)) (port-count-lines! ip) (define assembled-codes (let loop () - (define sexp (read-syntax name ip)) + (define sexp (read-syntax source-name ip)) (cond [(eof-object? sexp) '()] [else @@ -104,17 +109,22 @@ 'compiledCodes assembled-codes) op)] [else - (define program-port (open-output-string)) + (define program-input-port + (let* ([ip (open-input-string src)]) + (port-count-lines! ip) + (modularize-input-port #:module-name (string->symbol mname) + #:input-port ip + #:semantics-module 'whalesong))) + (define program-output-port (open-output-string))[ (package (SexpSource (parameterize ([read-accept-reader #t]) - (read (open-input-string (string-append "#lang whalesong\n" text-src))))) + (read-syntax source-name program-input-port))) #:should-follow-children? (lambda (src) #f) - #:output-port program-port) + #:output-port program-output-port) (write-json (hash 'type "module" - 'compiledModule (get-output-string program-port)) - op) - ])) - ;; Send it back as json text.... - + 'module-name (string->symbol mname) + 'provides () ;; FIXME! + 'compiledModule (get-output-string program-output-port)) + op)])) (close-output-port op) response) @@ -140,4 +150,4 @@ [("-p" "--port") p "Port (default 8000)" (current-port (string->number p))])) (start-server #:port (current-port))) - \ No newline at end of file +