suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

trying to get the module output working.

Browse Source
This commit is contained in:
Danny Yoo 2013-04-08 19:00:18 -06:00
parent 45aeb7d12a
commit 4d00c1bb5e
4 changed files with 111 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
whalesong/repl-prototype/htdocs/repl.js
View File

@ -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");
}
};

27
whalesong/repl-prototype/htdocs/rpc.js
View File

@ -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 }
}
});
}

53
whalesong/repl-prototype/modularize-input-port.rkt Normal file
View File

@ -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))

44
whalesong/repl-prototype/server.rkt
View File

@ -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)))