diff --git a/image/main.rkt b/image/main.rkt index dc9df3a..d059ea8 100644 --- a/image/main.rkt +++ b/image/main.rkt @@ -1,8 +1,7 @@ -#lang s-exp "../lang/js/js.rkt" +#lang s-exp "../lang/base.rkt" -(declare-implementation - #:racket "racket-impl.rkt" - #:javascript ("colordb.js" - "kernel.js" - "js-impl.js") - #:provided-values (is-color?)) \ No newline at end of file +(require "private/main.rkt" + "private/color.rkt") + +(provide (all-from-out "private/main.rkt") + (all-from-out "private/color.rkt")) diff --git a/image/private/color.rkt b/image/private/color.rkt new file mode 100644 index 0000000..840c5ed --- /dev/null +++ b/image/private/color.rkt @@ -0,0 +1,10 @@ +#lang s-exp "../../lang/base.rkt" + +(provide [struct-out color]) + +(define-struct color (red green blue alpha) + #:extra-constructor-name make-color) + + +(color 3 4 5 0) +(make-color 3 5 7 0) \ No newline at end of file diff --git a/image/colordb.js b/image/private/colordb.js similarity index 100% rename from image/colordb.js rename to image/private/colordb.js diff --git a/image/js-impl.js b/image/private/js-impl.js similarity index 100% rename from image/js-impl.js rename to image/private/js-impl.js diff --git a/image/kernel.js b/image/private/kernel.js similarity index 100% rename from image/kernel.js rename to image/private/kernel.js diff --git a/image/private/main.rkt b/image/private/main.rkt new file mode 100644 index 0000000..5d632c3 --- /dev/null +++ b/image/private/main.rkt @@ -0,0 +1,8 @@ +#lang s-exp "../../lang/js/js.rkt" + +(declare-implementation + #:racket "racket-impl.rkt" + #:javascript ("colordb.js" + "kernel.js" + "js-impl.js") + #:provided-values (is-color?)) diff --git a/image/racket-impl.rkt b/image/private/racket-impl.rkt similarity index 51% rename from image/racket-impl.rkt rename to image/private/racket-impl.rkt index db5e07c..1277be7 100644 --- a/image/racket-impl.rkt +++ b/image/private/racket-impl.rkt @@ -1,4 +1,4 @@ -#lang s-exp "../lang/base.rkt" +#lang s-exp "../../lang/base.rkt" (provide is-color?) diff --git a/js-assembler/package.rkt b/js-assembler/package.rkt index dd4d853..4c84747 100644 --- a/js-assembler/package.rkt +++ b/js-assembler/package.rkt @@ -2,6 +2,7 @@ (require "assemble.rkt" "quote-cdata.rkt" + "../logger.rkt" "../make/make.rkt" "../make/make-structs.rkt" "../parameters.rkt" @@ -67,9 +68,11 @@ [(StatementsSource? src) #f] [(MainModuleSource? src) - (source-is-javascript-module? (MainModuleSource-source src))] + (source-is-javascript-module? + (MainModuleSource-source src))] [(ModuleSource? src) - (query:has-javascript-implementation? `(file ,(path->string (ModuleSource-path src))))] + (query:has-javascript-implementation? + `(file ,(path->string (ModuleSource-path src))))] [(SexpSource? src) #f] [(UninterpretedSource? src) @@ -151,8 +154,10 @@ MACHINE.modules[~s] = ;; Translate all JavaScript-implemented sources into uninterpreted sources; ;; we'll leave its interpretation to on-visit-src. (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])) @@ -208,7 +213,9 @@ MACHINE.modules[~s] = ;; package-standalone-xhtml: X output-port -> void (define (package-standalone-xhtml source-code op) (display *header* op) + (log-debug "writing the runtime") (display (quote-cdata (get-runtime)) op) + (log-debug "writing the source code") (display (quote-cdata (get-code source-code)) op) (display *footer* op)) diff --git a/logger.rkt b/logger.rkt index bc005d3..03b4ca6 100644 --- a/logger.rkt +++ b/logger.rkt @@ -1,4 +1,5 @@ #lang racket/base +(require racket/match) ;; A small module to provide logging for Whalesong. @@ -36,10 +37,13 @@ (void (thread (lambda () (let ([receiver (make-log-receiver whalesong-logger 'debug)]) - (let loop ([msg (sync receiver)]) - (when should-print-logs? - (displayln msg)) - (loop)))))) + (let loop () + (let ([msg (sync receiver)]) + (when should-print-logs? + (match msg + [(vector level msg data) + (printf "~a: ~a\n" level msg)])) + (loop))))))) diff --git a/make/make.rkt b/make/make.rkt index fbde27f..88f024c 100644 --- a/make/make.rkt +++ b/make/make.rkt @@ -13,6 +13,9 @@ racket/match) +(require/typed "../logger.rkt" + [log-debug (String -> Void)]) + (require/typed "../parser/parse-bytecode.rkt" [parse-bytecode (Any -> Expression)]) @@ -31,9 +34,22 @@ (make-parameter (lambda: ([s : Source]) s))) +(: source-name (Source -> String)) +(define (source-name a-source) + (cond + [(StatementsSource? a-source) + ""] + [(UninterpretedSource? a-source) + ""] + [(MainModuleSource? a-source) + ""] + [(SexpSource? a-source) + ""] + [(ModuleSource? a-source) + ""])) - + (: get-ast-and-statements (Source -> (values (U False Expression) (Listof Statement)))) (define (get-ast-and-statements a-source) @@ -143,12 +159,15 @@ [(hash-has-key? visited (first sources)) (loop (rest sources))] [else + (log-debug (format "compiling a module ~a" + (source-name (first sources)))) (hash-set! visited (first sources) #t) (let*-values ([(this-source) ((current-module-source-compiling-hook) (first sources))] [(ast stmts) (get-ast-and-statements this-source)]) + (log-debug "visiting") (on-module-statements this-source ast stmts) (loop (append (map wrap-source (collect-new-dependencies this-source ast)) (rest sources))) diff --git a/world.rkt b/world.rkt index a0b0b51..bb65218 100644 --- a/world.rkt +++ b/world.rkt @@ -1,3 +1,3 @@ #lang s-exp "lang/base.rkt" (require "world/main.rkt") -(provide (all-from-out "world/main.rkt")) \ No newline at end of file +(provide (all-from-out "world/main.rkt"))