diff --git a/whalesong/compiler/compiler.rkt b/whalesong/compiler/compiler.rkt index c6fac3b..0349a9c 100644 --- a/whalesong/compiler/compiler.rkt +++ b/whalesong/compiler/compiler.rkt @@ -844,6 +844,7 @@ (append-instruction-sequences (Lam-entry-label exp) + (make-MarkEntryPoint (Lam-entry-label exp)) (Comment (format "lambda body for ~a" (Lam-name exp))) maybe-unsplice-rest-argument maybe-install-closure-values diff --git a/whalesong/compiler/il-structs.rkt b/whalesong/compiler/il-structs.rkt index 638163b..b0c4b78 100644 --- a/whalesong/compiler/il-structs.rkt +++ b/whalesong/compiler/il-structs.rkt @@ -167,6 +167,7 @@ (define-type StraightLineStatement (U DebugPrint Comment + MarkEntryPoint AssignImmediate AssignPrimOp @@ -293,6 +294,11 @@ #:transparent) +;; Marks the head of every lambda. +(define-struct: MarkEntryPoint ([label : Symbol]) + #:transparent) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Primitive Operators diff --git a/whalesong/compiler/optimize-il.rkt b/whalesong/compiler/optimize-il.rkt index 56bb227..bb1fd77 100644 --- a/whalesong/compiler/optimize-il.rkt +++ b/whalesong/compiler/optimize-il.rkt @@ -196,6 +196,9 @@ ;(loop (rest stmts)) (cons a-stmt (loop (rest stmts))) ] + + [(MarkEntryPoint? a-stmt) + (cons a-stmt (loop (rest stmts)))] [(AssignImmediate? a-stmt) (cons (make-AssignImmediate (rewrite-target (AssignImmediate-target a-stmt)) @@ -347,6 +350,9 @@ #f #;#t] + [(MarkEntryPoint? stmt) + #f] + [(AssignImmediate? stmt) (equal? (AssignImmediate-target stmt) (AssignImmediate-value stmt))] diff --git a/whalesong/js-assembler/assemble.rkt b/whalesong/js-assembler/assemble.rkt index ade1147..fc28d88 100644 --- a/whalesong/js-assembler/assemble.rkt +++ b/whalesong/js-assembler/assemble.rkt @@ -170,6 +170,8 @@ EOF (next)] [(DebugPrint? stmt) (next)] + [(MarkEntryPoint? stmt) + (next)] [(AssignImmediate? stmt) (next)] [(AssignPrimOp? stmt) @@ -293,6 +295,9 @@ EOF [else (define stmt (first stmts)) (cond + [(MarkEntryPoint? stmt) + (default stmt)] + [(DebugPrint? stmt) (default stmt)] @@ -430,6 +435,9 @@ EOF [else (define stmt (first stmts)) (cond + [(MarkEntryPoint? stmt) + (default)] + [(DebugPrint? stmt) (default)] @@ -496,6 +504,10 @@ EOF (define (assemble-statement stmt blockht) (define assembled (cond + [(MarkEntryPoint? stmt) + ;; Marking the entry point to the lambda should have no other effect. + ""] + [(DebugPrint? stmt) (format "M.params.currentOutputPort.writeDomNode(M, $('').text(~a));" (assemble-oparg (DebugPrint-value stmt) @@ -667,6 +679,9 @@ EOF [else (define first-stmt (first stmts)) (cond + [(MarkEntryPoint? first-stmt) + (cons (MarkEntryPoint-label first-stmt) + (get-function-entry-and-exit-names (rest stmts)))] [(LinkedLabel? first-stmt) (cons (LinkedLabel-label first-stmt) (cons (LinkedLabel-linked-to first-stmt) diff --git a/whalesong/js-assembler/collect-jump-targets.rkt b/whalesong/js-assembler/collect-jump-targets.rkt index 4b5be2b..8faeaed 100644 --- a/whalesong/js-assembler/collect-jump-targets.rkt +++ b/whalesong/js-assembler/collect-jump-targets.rkt @@ -25,6 +25,8 @@ (LinkedLabel-linked-to stmt))] [(DebugPrint? stmt) empty] + [(MarkEntryPoint? stmt) + (list (MarkEntryPoint-label stmt))] [(AssignImmediate? stmt) (let: ([v : OpArg (AssignImmediate-value stmt)]) (collect-input v))] @@ -172,6 +174,8 @@ [(LinkedLabel? stmt) (list (LinkedLabel-label stmt) (LinkedLabel-linked-to stmt))] + [(MarkEntryPoint? stmt) + (list (MarkEntryPoint-label stmt))] [(DebugPrint? stmt) empty] [(AssignImmediate? stmt) diff --git a/whalesong/repl-prototype/server.rkt b/whalesong/repl-prototype/server.rkt index 5b42816..53634d8 100644 --- a/whalesong/repl-prototype/server.rkt +++ b/whalesong/repl-prototype/server.rkt @@ -78,7 +78,7 @@ (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 ~a\n" assembled-codes) + (printf "assembled codes ~a\n" assembled-codes) (write-json (hash 'compiledCodes assembled-codes) op)] [else