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

got the system to recognize resources; now to write them.

Browse Source
This commit is contained in:
Danny Yoo 2011-08-12 16:26:15 -04:00
parent efbacd0f68
commit ef0911ca61
9 changed files with 163 additions and 166 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
examples/using-resources.rkt
View File

@ -7,4 +7,4 @@
(image-url
(resource->url whale-resource)))
#;whale-image
whale-resource

3
js-assembler/assemble-helpers.rkt
View File

@ -130,6 +130,9 @@
(string-join (for/list ([a-byte val])
(number->string a-byte))
","))]
[(path? val)
(format "RUNTIME.makePath(~s)"
(path->string val))]
[else
(error 'assemble-const "Unsupported datum ~s" val)])))

219
js-assembler/package.rkt
View File

@ -9,10 +9,13 @@
"../compiler/expression-structs.rkt"
"../parser/path-rewriter.rkt"
"../parser/parse-bytecode.rkt"
"../resource/structs.rkt"
racket/match
racket/list
racket/promise
racket/set
(prefix-in query: "../lang/js/query.rkt")
(prefix-in resource-query: "../resource/query.rkt")
(planet dyoo/closure-compile:1:1)
(prefix-in runtime: "get-runtime.rkt")
(prefix-in racket: racket/base))
@ -54,11 +57,13 @@
(define (package-anonymous source-code
#:should-follow-children? should-follow?
#:output-port op)
#:output-port op
#:on-resource (on-resource (lambda (r) (void))))
(fprintf op "(function() {\n")
(package source-code
#:should-follow-children? should-follow?
#:output-port op)
#:output-port op
#:on-resource on-resource)
(fprintf op " return invoke; })\n"))
@ -67,23 +72,39 @@
;; Returns true if the source looks like a Javascript-implemented module.
(define (source-is-javascript-module? src)
(cond
[(StatementsSource? src)
#f]
[(MainModuleSource? src)
(source-is-javascript-module?
(MainModuleSource-source src))]
[(ModuleSource? src)
(query:has-javascript-implementation?
`(file ,(path->string (ModuleSource-path src))))]
[(SexpSource? src)
#f]
[(UninterpretedSource? src)
#f]))
[(StatementsSource? src)
#f]
[(MainModuleSource? src)
(source-is-javascript-module?
(MainModuleSource-source src))]
[(ModuleSource? src)
(query:has-javascript-implementation?
`(file ,(path->string (ModuleSource-path src))))]
[(SexpSource? src)
#f]
[(UninterpretedSource? src)
#f]))
(define (source-resources src)
(cond
[(StatementsSource? src)
empty]
[(MainModuleSource? src)
(source-resources
(MainModuleSource-source src))]
[(ModuleSource? src)
(resource-query:query
`(file ,(path->string (ModuleSource-path src))))]
[(SexpSource? src)
empty]
[(UninterpretedSource? src)
empty]))
;; get-javascript-implementation: source -> UninterpretedSource
(define (get-javascript-implementation src)
(define (get-provided-name-code bytecode)
(match bytecode
[(struct Top [_ (struct Module (name path prefix requires provides code))])
@ -96,20 +117,21 @@
[else
""]))
(cond
[(StatementsSource? src)
(error 'get-javascript-implementation src)]
[(MainModuleSource? src)
(get-javascript-implementation (MainModuleSource-source src))]
[(ModuleSource? src)
(let ([name (rewrite-path (ModuleSource-path src))]
[text (query:query `(file ,(path->string (ModuleSource-path src))))]
[module-requires (query:lookup-module-requires (ModuleSource-path src))]
[bytecode (parse-bytecode (ModuleSource-path src))])
(log-debug "~a requires ~a"
(ModuleSource-path src)
module-requires)
(let ([module-body-text
(format "
[(StatementsSource? src)
(error 'get-javascript-implementation src)]
[(MainModuleSource? src)
(get-javascript-implementation (MainModuleSource-source src))]
[(ModuleSource? src)
(let ([name (rewrite-path (ModuleSource-path src))]
[text (query:query `(file ,(path->string (ModuleSource-path src))))]
[module-requires (query:lookup-module-requires (ModuleSource-path src))]
[bytecode (parse-bytecode (ModuleSource-path src))])
(when (not (empty? module-requires))
(log-debug "~a requires ~a"
(ModuleSource-path src)
module-requires))
(let ([module-body-text
(format "
if(--MACHINE.callsBeforeTrampoline<0) { throw arguments.callee; }
var modrec = MACHINE.modules[~s];
var exports = {};
@ -118,40 +140,40 @@
~a
modrec.privateExports = exports;
return MACHINE.control.pop().label(MACHINE);"
(symbol->string name)
text
(get-provided-name-code bytecode))])
(make-UninterpretedSource
(format "
(symbol->string name)
text
(get-provided-name-code bytecode))])
(make-UninterpretedSource
(format "
MACHINE.modules[~s] =
new plt.runtime.ModuleRecord(~s,
function(MACHINE) {
~a
});
"
(symbol->string name)
(symbol->string name)
(assemble-modinvokes+body module-requires module-body-text))
(map make-ModuleSource module-requires))))]
[(SexpSource? src)
(error 'get-javascript-implementation)]
[(UninterpretedSource? src)
(error 'get-javascript-implementation)]))
(symbol->string name)
(symbol->string name)
(assemble-modinvokes+body module-requires module-body-text))
(map make-ModuleSource module-requires))))]
[(SexpSource? src)
(error 'get-javascript-implementation)]
[(UninterpretedSource? src)
(error 'get-javascript-implementation)]))
(define (assemble-modinvokes+body paths after)
(cond
[(empty? paths)
after]
[(empty? (rest paths))
(assemble-modinvoke (first paths) after)]
[else
(assemble-modinvoke (first paths)
(assemble-modinvokes+body (rest paths) after))]))
[(empty? paths)
after]
[(empty? (rest paths))
(assemble-modinvoke (first paths) after)]
[else
(assemble-modinvoke (first paths)
(assemble-modinvokes+body (rest paths) after))]))
(define (assemble-modinvoke path after)
@ -188,8 +210,15 @@ MACHINE.modules[~s] =
;; load in modules.
(define (package source-code
#:should-follow-children? should-follow?
#:output-port op)
#:output-port op
#:on-resource (on-resource
(lambda (r)
(log-debug "Resource ~s found"
(resource-path r))
(void))))
(define resources (set))
;; wrap-source: source -> source
;; Translate all JavaScript-implemented sources into uninterpreted sources;
@ -197,58 +226,64 @@ MACHINE.modules[~s] =
(define (wrap-source src)
(log-debug "Checking if the source has a JavaScript implementation")
(cond
[(source-is-javascript-module? src)
(log-debug "Replacing implementation with JavaScript one.")
(get-javascript-implementation src)]
[else
src]))
[(source-is-javascript-module? src)
(log-debug "Replacing implementation with JavaScript one.")
(get-javascript-implementation src)]
[else
src]))
(define (on-visit-src src ast stmts)
;; Record the use of resources on source module visitation...
(set! resources (set-union resources
(list->set (source-resources src))))
(cond
[(UninterpretedSource? src)
(fprintf op "~a" (UninterpretedSource-datum src))]
[else
(assemble/write-invoke stmts op)
(fprintf op "(MACHINE, function() { ")]))
[(UninterpretedSource? src)
(fprintf op "~a" (UninterpretedSource-datum src))]
[else
(assemble/write-invoke stmts op)
(fprintf op "(MACHINE, function() { ")]))
(define (after-visit-src src ast stmts)
(cond
[(UninterpretedSource? src)
(void)]
[else
(fprintf op " }, FAIL, PARAMS);")]))
[(UninterpretedSource? src)
(void)]
[else
(fprintf op " }, FAIL, PARAMS);")]))
(define (on-last-src)
(fprintf op "plt.runtime.setReadyTrue();")
(fprintf op "SUCCESS();"))
(define packaging-configuration
(make-Configuration
wrap-source
should-follow?
;; on
on-visit-src
;; after
after-visit-src
;; last
on-last-src))
(fprintf op "var invoke = (function(MACHINE, SUCCESS, FAIL, PARAMS) {")
(fprintf op " plt.runtime.ready(function() {")
(fprintf op "plt.runtime.setReadyFalse();")
(make (list (make-MainModuleSource source-code))
packaging-configuration)
(fprintf op " });");
(fprintf op "});\n"))
(fprintf op "var invoke = (function(MACHINE, SUCCESS, FAIL, PARAMS) {")
(fprintf op " plt.runtime.ready(function() {")
(fprintf op "plt.runtime.setReadyFalse();")
(make (list (make-MainModuleSource source-code))
packaging-configuration)
(fprintf op " });");
(fprintf op "});\n")
(for ([r resources])
(on-resource r)))
@ -270,7 +305,7 @@ MACHINE.modules[~s] =
(define (wrap-source src) src)
(let ([packaging-configuration
(make-Configuration
wrap-source
;; should-follow-children?
@ -287,9 +322,9 @@ MACHINE.modules[~s] =
;; last
(lambda ()
(fprintf op "SUCCESS();")))])
(display (runtime:get-runtime) op)
(newline op)
(fprintf op "(function(MACHINE, SUCCESS, FAIL, PARAMS) {")
(make (list only-bootstrapped-code) packaging-configuration)
@ -313,7 +348,7 @@ MACHINE.modules[~s] =
(compress
(get-output-string buffer)))))
;; get-runtime: -> string
(define (get-runtime)
(force *the-runtime*))
@ -335,7 +370,7 @@ MACHINE.modules[~s] =
<script>
EOF
)
)
;; get-code: source -> string
@ -403,7 +438,7 @@ var invokeMainModule = function() {
$(document).ready(invokeMainModule);
EOF
)
)
(define *footer*
#<<EOF
@ -411,4 +446,4 @@ EOF
<body></body>
</html>
EOF
)
)

10
js-assembler/runtime-src/baselib-paths.js
View File

@ -18,6 +18,16 @@
//////////////////////////////////////////////////////////////////////
var makePath = function (p) {
return new Path(p);
};
var isPath = baselib.makeClassPredicate(Path);
exports.Path = Path;
exports.makePath = makePath;
exports.isPath = isPath;
}(this.plt.baselib));

4
js-assembler/runtime-src/runtime.js
View File

@ -26,6 +26,7 @@
var isVector = baselib.vectors.isVector;
var isString = baselib.strings.isString;
var isSymbol = baselib.symbols.isSymbol;
var isPath = baselib.paths.isPath;
var equals = baselib.equality.equals;
@ -44,6 +45,7 @@
var makeSymbol = baselib.symbols.makeSymbol;
var makePath = baselib.paths.makePath;
var makeBytes = baselib.bytes.makeBytes;
var makeBox = baselib.boxes.makeBox;
@ -676,6 +678,7 @@
exports['makeBignum'] = makeBignum;
exports['makeComplex'] = makeComplex;
exports['makeSymbol'] = makeSymbol;
exports['makePath'] = makePath;
exports['makeBytes'] = makeBytes;
@ -688,6 +691,7 @@
exports['isBox'] = isBox;
exports['isString'] = isString;
exports['isSymbol'] = isSymbol;
exports['isPath'] = isPath;
exports['isNumber'] = isNumber;
exports['isNatural'] = isNatural;
exports['isReal'] = isReal;

9
resource/compile-time.rkt
View File

@ -28,12 +28,7 @@
(begin
;; Compile time code:
(begin-for-syntax
(let* ([this-module
(variable-reference->resolved-module-path
(#%variable-reference))]
[key (resolved-module-path-name this-module)])
;(printf "Recording the resource ~a\n" normal-path)
(record-resource munged-path normal-path)))
(record-resource normal-path munged-path))
;; Run time code
(define name (resource path munged-path))))))]))
(define name (resource normal-path munged-path))))))]))

62
resource/query.rkt
View File

@ -2,69 +2,19 @@
(require racket/contract
racket/runtime-path
syntax/modresolve)
syntax/modresolve
"structs.rkt")
(provide/contract [query (module-path? . -> . string?)]
[has-javascript-implementation? (module-path? . -> . boolean?)]
(provide/contract [query (module-path? . -> . (listof resource?))])
[redirected? (path? . -> . boolean?)]
[follow-redirection (path? . -> . path?)]
[collect-redirections-to (path? . -> . (listof path?))]
[lookup-module-requires (path? . -> . (listof path?))])
(define-runtime-path record.rkt "record.rkt")
(define ns (make-base-empty-namespace))
;; query: module-path -> string?
;; Given a module, see if it's implemented via Javascript.
;; query: module-path -> (listof record)
;; Given a module, collect all of its resource records
(define (query a-module-path)
(let ([resolved-path (resolve-module-path a-module-path #f)])
(parameterize ([current-namespace ns])
(dynamic-require a-module-path (void)) ;; get the compile-time code running.
((dynamic-require-for-syntax record.rkt 'lookup-javascript-implementation) resolved-path))))
;; has-javascript-implementation?: module-path -> boolean
(define (has-javascript-implementation? a-module-path)
(let ([resolved-path (resolve-module-path a-module-path #f)])
(parameterize ([current-namespace ns])
(dynamic-require a-module-path (void)) ;; get the compile-time code running.
((dynamic-require-for-syntax record.rkt 'has-javascript-implementation?) resolved-path))))
;; redirected? path -> boolean
(define (redirected? a-module-path)
(let ([resolved-path (resolve-module-path a-module-path #f)])
(parameterize ([current-namespace ns])
(dynamic-require a-module-path (void)) ;; get the compile-time code running.
(path? ((dynamic-require-for-syntax record.rkt 'follow-redirection)
resolved-path)))))
;; follow-redirection: module-path -> path
(define (follow-redirection a-module-path)
(let ([resolved-path (resolve-module-path a-module-path #f)])
(parameterize ([current-namespace ns])
(dynamic-require a-module-path (void)) ;; get the compile-time code running.
((dynamic-require-for-syntax record.rkt 'follow-redirection)
resolved-path))))
;; collect-redirections-to: module-path -> (listof path)
(define (collect-redirections-to a-module-path)
(let ([resolved-path (resolve-module-path a-module-path #f)])
(parameterize ([current-namespace ns])
(dynamic-require a-module-path (void)) ;; get the compile-time code running.
((dynamic-require-for-syntax record.rkt 'collect-redirections-to)
resolved-path))))
(define (lookup-module-requires a-module-path)
(let ([resolved-path (resolve-module-path a-module-path #f)])
(parameterize ([current-namespace ns])
(dynamic-require a-module-path (void)) ;; get the compile-time code running.
((dynamic-require-for-syntax record.rkt 'lookup-module-requires) resolved-path))))
((dynamic-require-for-syntax record.rkt 'get-records)))))

16
resource/record.rkt
View File

@ -1,15 +1,15 @@
#lang racket/base
(require racket/port)
(provide record-resource)
(require racket/port
"structs.rkt")
(provide record-resource
get-records)
(define-struct record (key resource-path bytes))
(define records '())
(define (get-records)
records)
;; record-javascript-implementation!: path a-resource-path -> void
(define (record-resource a-key a-resource-path)
(set! records (cons (make-record a-key
a-resource-path
(call-with-input-file a-resource-path port->bytes))
(define (record-resource a-resource-path a-key)
(set! records (cons (resource a-resource-path a-key)
records)))

4
resource/structs.rkt
View File

@ -2,5 +2,5 @@
(provide (all-defined-out))
(struct resource (path key))
;; Needs to be prefabricated
(struct resource (path key) #:prefab)