From bc883c54f31764b18eaebff15023c6dc51d468d5 Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Fri, 1 Mar 2013 15:50:17 -0700 Subject: [PATCH] repl sorta working better now, but I'm seeing an issue at assembly time. --- whalesong/compiler/compiler.rkt | 10 ++++---- whalesong/repl-prototype/htdocs/repl.js | 31 +++++++++++++++---------- whalesong/repl-prototype/server.rkt | 21 +++++++++++++++-- 3 files changed, 44 insertions(+), 18 deletions(-) diff --git a/whalesong/compiler/compiler.rkt b/whalesong/compiler/compiler.rkt index 7ce50d0..6f2b586 100644 --- a/whalesong/compiler/compiler.rkt +++ b/whalesong/compiler/compiler.rkt @@ -25,7 +25,8 @@ [get-provided-names (Expression -> (Listof ModuleProvide))]) -(provide (rename-out [-compile compile]) +(provide (rename-out [-compile compile] + [compile raw-compile]) compile-general-procedure-call) @@ -188,7 +189,7 @@ (: compile-top (Top CompileTimeEnvironment Target Linkage -> InstructionSequence)) ;; Generates code to write out the top prefix, evaluate the rest of the body, -;; and then pop the top prefix off. +;; and then pop the top prefix off afterwards. (define (compile-top top cenv target linkage) (let*: ([names : (Listof (U False Symbol GlobalBucket ModuleVariable)) (Prefix-names (Top-prefix top))]) (end-with-linkage @@ -198,10 +199,11 @@ (compile (Top-code top) (cons (Top-prefix top) cenv) 'val - next-linkage/drop-multiple) + next-linkage/keep-multiple-on-stack) (make-AssignImmediate target (make-Reg 'val)) (make-PopEnvironment (make-Const 1) - (make-Const 0)))))) + (new-SubtractArg (make-Reg 'argcount) + (make-Const 1))))))) diff --git a/whalesong/repl-prototype/htdocs/repl.js b/whalesong/repl-prototype/htdocs/repl.js index 1e0c287..864b1ff 100644 --- a/whalesong/repl-prototype/htdocs/repl.js +++ b/whalesong/repl-prototype/htdocs/repl.js @@ -66,18 +66,36 @@ $(document).ready(function() { }; + var print = function(elt) { + var outputPort = + M.params.currentOutputPort; + if (elt !== plt.runtime.VOID) { + outputPort.writeDomNode( + M, + plt.runtime.toDomNode(elt, M.params['print-mode'])); + outputPort.writeDomNode(M, plt.runtime.toDomNode("\n", 'display')); + } + }; + + // In evaluation, we'll send compilation requests to the server, // and get back bytecode that we should evaluate. var evaluate = function(src, after) { console.log("about to eval", src); var onCompile = function(compiledResult) { // 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. var compiledCodes = compiledResult.compiledCodes; forEachK(compiledCodes, function(code, k) { var codeFunction = eval(code); var onGoodEvaluation = function() { - console.log('good evaluation'); + var resultList = M.v; + while(resultList !== plt.baselib.lists.EMPTY) { + print(resultList.first); + resultList = resultList.rest; + }; k(); }; var onBadEvaluation = function(M, err) { @@ -91,16 +109,6 @@ $(document).ready(function() { codeFunction(M, onGoodEvaluation, onBadEvaluation); }, after); - //eval(compiledResult.compiled); - // FIXME - // plt.runtime.currentMachine.modules['whalesong/repl-prototype/anonymous-module.rkt'].invoke( - // plt.runtime.currentMachine, - // function() { - // after(); - // }, - // function() { - // after(); - // }); }; var onError = function(err) { console.log("error", err); @@ -113,5 +121,4 @@ $(document).ready(function() { success: onCompile, error: onError}); }; - }); diff --git a/whalesong/repl-prototype/server.rkt b/whalesong/repl-prototype/server.rkt index 58c615d..ab44445 100644 --- a/whalesong/repl-prototype/server.rkt +++ b/whalesong/repl-prototype/server.rkt @@ -14,7 +14,11 @@ "../repl-compile.rkt" "../parser/parse-bytecode.rkt" "../compiler/compiler.rkt" + "../compiler/expression-structs.rkt" + "../compiler/il-structs.rkt" + "../compiler/lexical-structs.rkt" "../compiler/compiler-structs.rkt" + "../compiler/optimize-il.rkt" "../js-assembler/assemble.rkt" "write-runtime.rkt" (for-syntax racket/base)) @@ -68,11 +72,24 @@ (define op (open-output-bytes)) (write raw-bytecode op) (define whalesong-bytecode (parse-bytecode (open-input-bytes (get-output-bytes op)))) - (define compiled-bytecode (compile whalesong-bytecode 'val next-linkage/keep-multiple-on-stack)) + (displayln whalesong-bytecode) + (define compiled-bytecode + (let ([after-first-seq (make-label 'afterFirstSeqEvaluated)]) + (optimize-il + (statements + (append-instruction-sequences + (raw-compile whalesong-bytecode '() 'val next-linkage/keep-multiple-on-stack) + (make-TestAndJump (make-TestZero (make-Reg 'argcount)) after-first-seq) + (make-PushImmediateOntoEnvironment (make-Reg 'val) #f) + after-first-seq + (make-Perform (make-UnspliceRestFromStack! (make-Const 0) (make-Reg 'argcount))) + (make-AssignImmediate 'val (make-EnvLexicalReference 0 #f)) + (make-PopEnvironment (make-Const 1) (make-Const 0))))))) + (displayln compiled-bytecode) (define assembled-op (open-output-string)) (define assembled (assemble/write-invoke compiled-bytecode #f assembled-op)) (cons (get-output-string assembled-op) (loop))]))) - (printf "assembled codes ~s\n" assembled-codes) + (printf "assembled codes ~a\n" assembled-codes) (write-json (hash 'compiledCodes assembled-codes) op)] [else