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

renaming il to try matching dissertation

Browse Source
This commit is contained in:
Danny Yoo 2012-02-17 12:23:11 -05:00
parent 4cf6865862
commit c8faf78ffb
11 changed files with 230 additions and 230 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Makefile
View File

@ -45,8 +45,8 @@ cs019-doc:
setup:
raco setup --no-docs -P dyoo whalesong.plt 1 15
raco setup --no-docs -P dyoo whalesong.plt 1 16
planet-link:
raco planet link dyoo whalesong.plt 1 15 .
raco planet link dyoo whalesong.plt 1 16 .

62
compiler/bootstrapped-primitives.rkt
View File

@ -43,16 +43,16 @@
;; Precondition: the environment holds the f function that we want to jump into.
;; First, move f to the proc register
(make-AssignImmediateStatement 'proc (make-EnvLexicalReference 0 #f))
(make-AssignImmediate 'proc (make-EnvLexicalReference 0 #f))
;; Next, capture the envrionment and the current continuation closure,.
(make-PushEnvironment 2 #f)
(make-AssignPrimOpStatement (make-EnvLexicalReference 0 #f)
(make-AssignPrimOp (make-EnvLexicalReference 0 #f)
(make-CaptureControl 0 default-continuation-prompt-tag))
(make-AssignPrimOpStatement (make-EnvLexicalReference 1 #f)
(make-AssignPrimOp (make-EnvLexicalReference 1 #f)
;; When capturing, skip over f and the two slots we just added.
(make-CaptureEnvironment 3 default-continuation-prompt-tag))
(make-AssignPrimOpStatement (make-EnvLexicalReference 2 #f)
(make-AssignPrimOp (make-EnvLexicalReference 2 #f)
(make-MakeCompiledProcedure call/cc-closure-entry
1 ;; the continuation consumes a single value
(list 0 1)
@ -61,7 +61,7 @@
(make-Const 0))
;; Finally, do a tail call into f.
(make-AssignImmediateStatement 'argcount (make-Const 1))
(make-AssignImmediate 'argcount (make-Const 1))
(compile-general-procedure-call '()
(make-Const 1) ;; the stack at this point holds a single argument
'val
@ -70,13 +70,13 @@
;; The code for the continuation code follows. It's supposed to
;; abandon the current continuation, initialize the control and environment, and then jump.
call/cc-closure-entry
(make-AssignImmediateStatement 'val (make-EnvLexicalReference 0 #f))
(make-PerformStatement (make-InstallClosureValues!))
(make-PerformStatement (make-RestoreControl! default-continuation-prompt-tag))
(make-PerformStatement (make-RestoreEnvironment!))
(make-AssignImmediateStatement 'proc (make-ControlStackLabel))
(make-AssignImmediate 'val (make-EnvLexicalReference 0 #f))
(make-Perform (make-InstallClosureValues!))
(make-Perform (make-RestoreControl! default-continuation-prompt-tag))
(make-Perform (make-RestoreEnvironment!))
(make-AssignImmediate 'proc (make-ControlStackLabel))
(make-PopControlFrame)
(make-GotoStatement (make-Reg 'proc)))))
(make-Goto (make-Reg 'proc)))))
@ -264,11 +264,11 @@
(let ([after-call/cc-code (make-label 'afterCallCCImplementation)])
(append
`(,(make-AssignPrimOpStatement (make-PrimitivesReference 'call/cc)
`(,(make-AssignPrimOp (make-PrimitivesReference 'call/cc)
(make-MakeCompiledProcedure call/cc-label 1 '() 'call/cc))
,(make-AssignPrimOpStatement (make-PrimitivesReference 'call-with-current-continuation)
,(make-AssignPrimOp (make-PrimitivesReference 'call-with-current-continuation)
(make-MakeCompiledProcedure call/cc-label 1 '() 'call/cc))
,(make-GotoStatement (make-Label after-call/cc-code)))
,(make-Goto (make-Label after-call/cc-code)))
(make-call/cc-code)
`(,after-call/cc-code)))
@ -281,35 +281,35 @@
[values-entry (make-label 'valuesEntry)]
[on-zero-values (make-label 'onZeroValues)]
[on-single-value (make-label 'onSingleValue)])
`(,(make-GotoStatement (make-Label after-values-body-defn))
`(,(make-Goto (make-Label after-values-body-defn))
,values-entry
,(make-TestAndJumpStatement (make-TestOne (make-Reg 'argcount)) on-single-value)
,(make-TestAndJumpStatement (make-TestZero (make-Reg 'argcount)) on-zero-values)
,(make-TestAndJump (make-TestOne (make-Reg 'argcount)) on-single-value)
,(make-TestAndJump (make-TestZero (make-Reg 'argcount)) on-zero-values)
;; Common case: we're running multiple values. Put the first in the val register
;; and go to the multiple value return.
,(make-AssignImmediateStatement 'val (make-EnvLexicalReference 0 #f))
,(make-AssignImmediate 'val (make-EnvLexicalReference 0 #f))
,(make-PopEnvironment (make-Const 1) (make-Const 0))
,(make-AssignImmediateStatement 'proc (make-ControlStackLabel/MultipleValueReturn))
,(make-AssignImmediate 'proc (make-ControlStackLabel/MultipleValueReturn))
,(make-PopControlFrame)
,(make-GotoStatement (make-Reg 'proc))
,(make-Goto (make-Reg 'proc))
;; Special case: on a single value, just use the regular return address
,on-single-value
,(make-AssignImmediateStatement 'val (make-EnvLexicalReference 0 #f))
,(make-AssignImmediate 'val (make-EnvLexicalReference 0 #f))
,(make-PopEnvironment (make-Const 1) (make-Const 0))
,(make-AssignImmediateStatement 'proc (make-ControlStackLabel))
,(make-AssignImmediate 'proc (make-ControlStackLabel))
,(make-PopControlFrame)
,(make-GotoStatement (make-Reg 'proc))
,(make-Goto (make-Reg 'proc))
;; On zero values, leave things be and just return.
,on-zero-values
,(make-AssignImmediateStatement 'proc (make-ControlStackLabel/MultipleValueReturn))
,(make-AssignImmediate 'proc (make-ControlStackLabel/MultipleValueReturn))
,(make-PopControlFrame)
,(make-GotoStatement (make-Reg 'proc))
,(make-Goto (make-Reg 'proc))
,after-values-body-defn
,(make-AssignPrimOpStatement (make-PrimitivesReference 'values)
,(make-AssignPrimOp (make-PrimitivesReference 'values)
(make-MakeCompiledProcedure values-entry
(make-ArityAtLeast 0)
'()
@ -321,17 +321,17 @@
;; As is apply:
(let ([after-apply-code (make-label 'afterApplyCode)]
[apply-entry (make-label 'applyEntry)])
`(,(make-GotoStatement (make-Label after-apply-code))
`(,(make-Goto (make-Label after-apply-code))
,apply-entry
;; Push the procedure into proc.
,(make-AssignImmediateStatement 'proc (make-EnvLexicalReference 0 #f))
,(make-AssignImmediate 'proc (make-EnvLexicalReference 0 #f))
,(make-PopEnvironment (make-Const 1) (make-Const 0))
;; Correct the number of arguments to be passed.
,(make-AssignImmediateStatement 'argcount (make-SubtractArg (make-Reg 'argcount)
,(make-AssignImmediate 'argcount (make-SubtractArg (make-Reg 'argcount)
(make-Const 1)))
;; Splice in the list argument.
,(make-PerformStatement (make-SpliceListIntoStack! (make-SubtractArg (make-Reg 'argcount)
,(make-Perform (make-SpliceListIntoStack! (make-SubtractArg (make-Reg 'argcount)
(make-Const 1))))
;; Finally, jump into the procedure body
@ -342,5 +342,5 @@
,after-apply-code
,(make-AssignPrimOpStatement (make-PrimitivesReference 'apply)
,(make-AssignPrimOp (make-PrimitivesReference 'apply)
(make-MakeCompiledProcedure apply-entry (make-ArityAtLeast 2) '() 'apply))))))

198
compiler/compiler.rkt
View File

@ -42,7 +42,7 @@
(append-instruction-sequences
;; Layout the lambda bodies...
(make-GotoStatement (make-Label after-lam-bodies))
(make-Goto (make-Label after-lam-bodies))
(compile-lambda-bodies (collect-all-lambdas-with-bodies exp))
after-lam-bodies
@ -56,7 +56,7 @@
before-pop-prompt
(if (eq? target 'val)
empty-instruction-sequence
(make-AssignImmediateStatement target (make-Reg 'val))))))))
(make-AssignImmediate target (make-Reg 'val))))))))
(define-struct: lam+cenv ([lam : (U Lam CaseLam)]
@ -198,21 +198,21 @@
(append-instruction-sequences
(make-PopEnvironment (make-Const (length cenv))
(make-Const 0))
(make-AssignImmediateStatement 'proc (make-ControlStackLabel))
(make-AssignImmediate 'proc (make-ControlStackLabel))
(make-PopControlFrame)
(make-GotoStatement (make-Reg 'proc)))]
(make-Goto (make-Reg 'proc)))]
[else
;; Under non-tail calls, leave the stack as is and just do the jump.
(append-instruction-sequences
(make-AssignImmediateStatement 'proc (make-ControlStackLabel))
(make-AssignImmediate 'proc (make-ControlStackLabel))
(make-PopControlFrame)
(make-GotoStatement (make-Reg 'proc)))])]
(make-Goto (make-Reg 'proc)))])]
[(NextLinkage? linkage)
empty-instruction-sequence]
[(LabelLinkage? linkage)
(make-GotoStatement (make-Label (LabelLinkage-label linkage)))]))
(make-Goto (make-Label (LabelLinkage-label linkage)))]))
@ -295,12 +295,12 @@
(end-with-linkage
linkage cenv
(append-instruction-sequences
(make-PerformStatement (make-ExtendEnvironment/Prefix! names))
(make-Perform (make-ExtendEnvironment/Prefix! names))
(compile (Top-code top)
(cons (Top-prefix top) cenv)
'val
next-linkage/drop-multiple)
(make-AssignImmediateStatement target (make-Reg 'val))
(make-AssignImmediate target (make-Reg 'val))
(make-PopEnvironment (make-Const 1)
(make-Const 0))))))
@ -326,21 +326,21 @@
(end-with-linkage
linkage cenv
(append-instruction-sequences
(make-PerformStatement (make-InstallModuleEntry! name path module-entry))
(make-GotoStatement (make-Label after-module-body))
(make-Perform (make-InstallModuleEntry! name path module-entry))
(make-Goto (make-Label after-module-body))
module-entry
(make-PerformStatement (make-MarkModuleInvoked! path))
(make-Perform (make-MarkModuleInvoked! path))
;; Module body definition:
;; 1. First invoke all the modules that this requires.
(apply append-instruction-sequences
(map compile-module-invoke (Module-requires mod)))
;; 2. Next, evaluate the module body.
(make-PerformStatement (make-ExtendEnvironment/Prefix! names))
(make-Perform (make-ExtendEnvironment/Prefix! names))
(make-AssignImmediateStatement (make-ModulePrefixTarget path)
(make-AssignImmediate (make-ModulePrefixTarget path)
(make-EnvWholePrefixReference 0))
;; TODO: we need to sequester the prefix of the module with the record.
(compile (Module-code mod)
@ -350,12 +350,12 @@
;; 3. Finally, cleanup and return.
(make-PopEnvironment (make-Const 1) (make-Const 0))
(make-AssignImmediateStatement 'proc (make-ControlStackLabel))
(make-AssignImmediate 'proc (make-ControlStackLabel))
(make-PopControlFrame)
(make-PerformStatement (make-FinalizeModuleInvokation! path))
(make-GotoStatement (make-Reg 'proc))
(make-Perform (make-FinalizeModuleInvokation! path))
(make-Goto (make-Reg 'proc))
after-module-body)))]))
@ -364,7 +364,7 @@
(end-with-linkage linkage cenv
(append-instruction-sequences
(compile-module-invoke (Require-path exp))
(make-AssignImmediateStatement target (make-Const (void))))))
(make-AssignImmediate target (make-Const (void))))))
(: compile-module-invoke (ModuleLocator -> InstructionSequence))
@ -381,7 +381,7 @@
[on-return (make-LinkedLabel (make-label 'onReturn)
on-return-multiple)])
(append-instruction-sequences
(make-TestAndJumpStatement (make-TestTrue
(make-TestAndJump (make-TestTrue
(make-IsModuleLinked a-module-name))
linked)
;; TODO: raise an exception here that says that the module hasn't been
@ -389,13 +389,13 @@
(make-DebugPrint (make-Const
(format "DEBUG: the module ~a hasn't been linked in!!!"
(ModuleLocator-name a-module-name))))
(make-GotoStatement (make-Label (LinkedLabel-label on-return)))
(make-Goto (make-Label (LinkedLabel-label on-return)))
linked
(make-TestAndJumpStatement (make-TestTrue
(make-TestAndJump (make-TestTrue
(make-IsModuleInvoked a-module-name))
(LinkedLabel-label on-return))
(make-PushControlFrame/Call on-return)
(make-GotoStatement (ModuleEntry a-module-name))
(make-Goto (ModuleEntry a-module-name))
on-return-multiple
(make-PopEnvironment (new-SubtractArg (make-Reg 'argcount)
(make-Const 1))
@ -437,14 +437,14 @@
empty-instruction-sequence]
[(eq? context 'keep-multiple)
(make-AssignImmediateStatement 'argcount (make-Const 1))]
(make-AssignImmediate 'argcount (make-Const 1))]
[(natural? context)
(if (= context 1)
empty-instruction-sequence
(append-instruction-sequences
(make-AssignImmediateStatement 'argcount (make-Const 1))
(make-PerformStatement (make-RaiseContextExpectedValuesError!
(make-AssignImmediate 'argcount (make-Const 1))
(make-Perform (make-RaiseContextExpectedValuesError!
context))))]))]))
@ -457,7 +457,7 @@
(end-with-linkage linkage
cenv
(append-instruction-sequences
(make-AssignImmediateStatement target (make-Const
(make-AssignImmediate target (make-Const
(ensure-const-value (Constant-v exp))))
singular-context-check))))
@ -469,7 +469,7 @@
(end-with-linkage linkage
cenv
(append-instruction-sequences
(make-AssignImmediateStatement target exp)
(make-AssignImmediate target exp)
singular-context-check))))
@ -480,7 +480,7 @@
(end-with-linkage linkage
cenv
(append-instruction-sequences
(make-AssignImmediateStatement target
(make-AssignImmediate target
(make-EnvLexicalReference (LocalRef-depth exp)
(LocalRef-unbox? exp)))
singular-context-check))))
@ -495,12 +495,12 @@
(append-instruction-sequences
(if (ToplevelRef-check-defined? exp)
(make-PerformStatement (make-CheckToplevelBound!
(make-Perform (make-CheckToplevelBound!
(ToplevelRef-depth exp)
(ToplevelRef-pos exp)))
empty-instruction-sequence)
(make-AssignImmediateStatement
(make-AssignImmediate
target
(make-EnvPrefixReference (ToplevelRef-depth exp)
(ToplevelRef-pos exp)))
@ -521,7 +521,7 @@
cenv
(append-instruction-sequences
get-value-code
(make-AssignImmediateStatement target (make-Const (void)))
(make-AssignImmediate target (make-Const (void)))
singular-context-check)))))
@ -544,7 +544,7 @@
[a-code (compile (Branch-alternative exp) cenv target linkage)])
(append-instruction-sequences
p-code
(make-TestAndJumpStatement (make-TestFalse (make-Reg 'val))
(make-TestAndJump (make-TestFalse (make-Reg 'val))
f-branch:)
c-code
f-branch: a-code
@ -588,7 +588,7 @@
(emit-values-context-check-on-procedure-return (linkage-context linkage)
on-return/multiple
on-return)
(make-AssignImmediateStatement target (make-Reg 'val)))))]
(make-AssignImmediate target (make-Reg 'val)))))]
[else
(let* ([on-return/multiple (make-label 'beforePromptPopMultiple)]
[on-return (make-LinkedLabel (make-label 'beforePromptPop)
@ -621,16 +621,16 @@
;; Evaluate the first expression in a multiple-value context, and get the values on the stack.
(compile (first seq) cenv 'val next-linkage/keep-multiple-on-stack)
(make-TestAndJumpStatement (make-TestZero (make-Reg 'argcount)) after-first-seq)
(make-TestAndJump (make-TestZero (make-Reg 'argcount)) after-first-seq)
(make-PushImmediateOntoEnvironment (make-Reg 'val) #f)
after-first-seq
;; At this time, the argcount values are on the stack.
;; Next, we save those values temporarily in a throwaway control frame.
(make-PushControlFrame/Generic)
(make-AssignImmediateStatement (make-ControlFrameTemporary 'pendingBegin0Count)
(make-AssignImmediate (make-ControlFrameTemporary 'pendingBegin0Count)
(make-Reg 'argcount))
(make-PerformStatement (make-UnspliceRestFromStack! (make-Const 0) (make-Reg 'argcount)))
(make-AssignImmediateStatement (make-ControlFrameTemporary 'pendingBegin0Values)
(make-Perform (make-UnspliceRestFromStack! (make-Const 0) (make-Reg 'argcount)))
(make-AssignImmediate (make-ControlFrameTemporary 'pendingBegin0Values)
(make-EnvLexicalReference 0 #f))
(make-PopEnvironment (make-Const 1) (make-Const 0))))]
@ -639,11 +639,11 @@
(append-instruction-sequences
;; Reinstate the values of the first expression, and drop the throwaway control frame.
(make-PushImmediateOntoEnvironment (make-ControlFrameTemporary 'pendingBegin0Values) #f)
(make-PerformStatement (make-SpliceListIntoStack! (make-Const 0)))
(make-AssignImmediateStatement 'argcount (make-ControlFrameTemporary 'pendingBegin0Count))
(make-Perform (make-SpliceListIntoStack! (make-Const 0)))
(make-AssignImmediate 'argcount (make-ControlFrameTemporary 'pendingBegin0Count))
(make-PopControlFrame)
(make-TestAndJumpStatement (make-TestZero (make-Reg 'argcount)) after-values-reinstated)
(make-AssignImmediateStatement 'val (make-EnvLexicalReference 0 #f))
(make-TestAndJump (make-TestZero (make-Reg 'argcount)) after-values-reinstated)
(make-AssignImmediate 'val (make-EnvLexicalReference 0 #f))
(make-PopEnvironment (make-Const 1) (make-Const 0))
after-values-reinstated))])
@ -654,7 +654,7 @@
reinstate-values-on-stack
(make-AssignImmediateStatement target (make-Reg 'val))
(make-AssignImmediate target (make-Reg 'val))
;; TODO: context needs check for arguments.
(cond
@ -665,20 +665,20 @@
(make-PopEnvironment (make-Const (length cenv))
(new-SubtractArg (make-Reg 'argcount)
(make-Const 1)))
(make-AssignImmediateStatement 'proc (make-ControlStackLabel/MultipleValueReturn))
(make-AssignImmediate 'proc (make-ControlStackLabel/MultipleValueReturn))
(make-PopControlFrame)
(make-GotoStatement (make-Reg 'proc)))]
(make-Goto (make-Reg 'proc)))]
[else
(append-instruction-sequences
(make-AssignImmediateStatement 'proc (make-ControlStackLabel/MultipleValueReturn))
(make-AssignImmediate 'proc (make-ControlStackLabel/MultipleValueReturn))
(make-PopControlFrame)
(make-GotoStatement (make-Reg 'proc)))])]
(make-Goto (make-Reg 'proc)))])]
[(NextLinkage? linkage)
empty-instruction-sequence]
[(LabelLinkage? linkage)
(make-GotoStatement (make-Label (LabelLinkage-label linkage)))])))]))
(make-Goto (make-Label (LabelLinkage-label linkage)))])))]))
@ -693,7 +693,7 @@
linkage
cenv
(append-instruction-sequences
(make-AssignPrimOpStatement
(make-AssignPrimOp
target
(make-MakeCompiledProcedure (Lam-entry-label exp)
(Lam-arity exp)
@ -708,7 +708,7 @@
linkage
cenv
(append-instruction-sequences
(make-AssignPrimOpStatement
(make-AssignPrimOp
target
(make-MakeCompiledProcedure (EmptyClosureReference-entry-label exp)
(EmptyClosureReference-arity exp)
@ -740,7 +740,7 @@
(apply append-instruction-sequences
(map (lambda: ([lam : (U Lam EmptyClosureReference)]
[target : Target])
(make-AssignPrimOpStatement
(make-AssignPrimOp
target
(cond
[(Lam? lam)
@ -759,7 +759,7 @@
(make-EnvLexicalReference i #f)))))
;; Make the case lambda as a regular compiled procedure. Its closed values are the lambdas.
(make-AssignPrimOpStatement
(make-AssignPrimOp
(adjust-target-depth target n)
(make-MakeCompiledProcedure (CaseLam-entry-label exp)
(merge-arities (map Lam-arity (CaseLam-clauses exp)))
@ -829,7 +829,7 @@
linkage
cenv
(append-instruction-sequences
(make-AssignPrimOpStatement
(make-AssignPrimOp
target
(make-MakeCompiledProcedureShell (Lam-entry-label exp)
(if (Lam-rest? exp)
@ -845,7 +845,7 @@
(define (compile-lambda-body exp cenv)
(let: ([maybe-unsplice-rest-argument : InstructionSequence
(if (Lam-rest? exp)
(make-PerformStatement
(make-Perform
(make-UnspliceRestFromStack!
(make-Const (Lam-num-parameters exp))
(new-SubtractArg (make-Reg 'argcount)
@ -855,7 +855,7 @@
(if (not (empty? (Lam-closure-map exp)))
(append-instruction-sequences
(make-Comment (format "installing closure for ~s" (Lam-name exp)))
(make-PerformStatement (make-InstallClosureValues!)))
(make-Perform (make-InstallClosureValues!)))
empty-instruction-sequence)]
[lam-body-code : InstructionSequence
(compile (Lam-body exp)
@ -881,18 +881,18 @@
[i : Natural])
(let ([not-match (make-label 'notMatch)])
(append-instruction-sequences
(make-TestAndJumpStatement (make-TestClosureArityMismatch
(make-TestAndJump (make-TestClosureArityMismatch
(make-CompiledProcedureClosureReference
(make-Reg 'proc)
i)
(make-Reg 'argcount))
not-match)
;; Set the procedure register to the lam
(make-AssignImmediateStatement
(make-AssignImmediate
'proc
(make-CompiledProcedureClosureReference (make-Reg 'proc) i))
(make-GotoStatement (make-Label
(make-Goto (make-Label
(cond [(Lam? lam)
(Lam-entry-label lam)]
[(EmptyClosureReference? lam)
@ -971,8 +971,8 @@
(error 'impossible)]
[(Const? op-knowledge)
(append-instruction-sequences
(make-AssignImmediateStatement 'proc op-knowledge)
(make-PerformStatement
(make-AssignImmediate 'proc op-knowledge)
(make-Perform
(make-RaiseOperatorApplicationError! (make-Reg 'proc))))]
[else
(default)]))))
@ -1040,7 +1040,7 @@
(make-PushEnvironment (length (App-operands exp)) #f)
proc-code
(juggle-operands operand-codes)
(make-AssignImmediateStatement 'argcount
(make-AssignImmediate 'argcount
(make-Const (length (App-operands exp))))
(compile-general-procedure-call cenv
(make-Const (length (App-operands exp)))
@ -1073,7 +1073,7 @@
(make-PushEnvironment (length (App-operands exp)) #f)
(apply append-instruction-sequences operand-codes)
proc-code
(make-AssignImmediateStatement 'argcount (make-Const (length (App-operands exp))))
(make-AssignImmediate 'argcount (make-Const (length (App-operands exp))))
(compile-primitive-procedure-call cenv
(make-Const (length (App-operands exp)))
target
@ -1119,10 +1119,10 @@
(build-list (length (App-operands exp))
(lambda: ([i : Natural])
(make-EnvLexicalReference i #f)))))
(make-AssignImmediateStatement 'proc (make-PrimitiveKernelValue kernel-op))
(make-AssignImmediateStatement 'argcount
(make-AssignImmediate 'proc (make-PrimitiveKernelValue kernel-op))
(make-AssignImmediate 'argcount
(make-Const (length (App-operands exp))))
(make-PerformStatement (make-RaiseArityMismatchError!
(make-Perform (make-RaiseArityMismatchError!
(make-Reg 'proc)
expected-arity
(make-Const n))))))
@ -1166,7 +1166,7 @@
(end-with-linkage
linkage cenv
(append-instruction-sequences
(make-AssignPrimOpStatement target
(make-AssignPrimOp target
(make-CallKernelPrimitiveProcedure
kernel-op
operand-poss
@ -1245,7 +1245,7 @@
(append-instruction-sequences
stack-pushing-code
rest-operand-code
(make-AssignPrimOpStatement (adjust-target-depth target (length rest-operands))
(make-AssignPrimOp (adjust-target-depth target (length rest-operands))
(make-CallKernelPrimitiveProcedure
kernel-op
(append constant-operand-poss rest-operand-poss)
@ -1371,7 +1371,7 @@
(length (App-operands exp)))
empty-instruction-sequence]
[else
(make-PerformStatement
(make-Perform
(make-RaiseArityMismatchError!
(make-Reg 'proc)
(StaticallyKnownLam-arity static-knowledge)
@ -1430,9 +1430,9 @@
;; last operand at 'val into env[n].
(append-instruction-sequences
(car ops)
(make-AssignImmediateStatement 'proc
(make-AssignImmediate 'proc
(make-EnvLexicalReference n #f))
(make-AssignImmediateStatement (make-EnvLexicalReference n #f)
(make-AssignImmediate (make-EnvLexicalReference n #f)
(make-Reg 'val))))]
[else
;; Otherwise, add instructions to juggle the operator and operands in the stack.
@ -1471,7 +1471,7 @@
linkage
cenv
(append-instruction-sequences
(make-PerformStatement (make-CheckClosureAndArity!))
(make-Perform (make-CheckClosureAndArity!))
(compile-compiled-procedure-application cenv
number-of-arguments
'dynamic
@ -1492,12 +1492,12 @@
linkage
cenv
(append-instruction-sequences
(make-PerformStatement (make-CheckPrimitiveArity!))
(make-AssignPrimOpStatement 'val (make-ApplyPrimitiveProcedure))
(make-Perform (make-CheckPrimitiveArity!))
(make-AssignPrimOp 'val (make-ApplyPrimitiveProcedure))
(make-PopEnvironment number-of-arguments (make-Const 0))
(if (eq? target 'val)
empty-instruction-sequence
(make-AssignImmediateStatement target (make-Reg 'val)))
(make-AssignImmediate target (make-Reg 'val)))
(emit-singular-context linkage))))
@ -1516,7 +1516,7 @@
after-call
(linkage-context linkage)))])
(append-instruction-sequences
(make-AssignImmediateStatement 'argcount
(make-AssignImmediate 'argcount
(make-Const n))
(compile-compiled-procedure-application cenv
(make-Const n)
@ -1560,7 +1560,7 @@
[(eq? target 'val)
empty-instruction-sequence]
[else
(make-AssignImmediateStatement target (make-Reg 'val))])]
(make-AssignImmediate target (make-Reg 'val))])]
[on-return/multiple (make-label 'procReturnMultiple)]
@ -1572,7 +1572,7 @@
[nontail-jump-into-procedure
(append-instruction-sequences
(make-PushControlFrame/Call on-return)
(make-GotoStatement entry-point-target))])
(make-Goto entry-point-target))])
(cond [(ReturnLinkage? linkage)
(cond
@ -1588,13 +1588,13 @@
(append-instruction-sequences
reuse-the-stack
;; Assign the proc value of the existing call frame.
(make-PerformStatement (make-SetFrameCallee! (make-Reg 'proc)))
(make-GotoStatement entry-point-target)))]
(make-Perform (make-SetFrameCallee! (make-Reg 'proc)))
(make-Goto entry-point-target)))]
[else
;; This case happens when we should be returning to a caller, but where
;; we are not in tail position.
(make-GotoStatement entry-point-target)])]
(make-Goto entry-point-target)])]
[else
(error 'compile "return linkage, target not val: ~s" target)])]
@ -1608,7 +1608,7 @@
[maybe-jump-to-label
(if (LabelLinkage? linkage)
(make-GotoStatement (make-Label (LabelLinkage-label linkage)))
(make-Goto (make-Label (LabelLinkage-label linkage)))
empty-instruction-sequence)])
(append-instruction-sequences
@ -1639,9 +1639,9 @@
(let ([after-return (make-label 'afterReturn)])
(append-instruction-sequences
on-return/multiple
(make-GotoStatement (make-Label after-return))
(make-Goto (make-Label after-return))
on-return
(make-AssignImmediateStatement 'argcount (make-Const 1))
(make-AssignImmediate 'argcount (make-Const 1))
after-return))]
[(natural? context)
@ -1649,7 +1649,7 @@
[(= context 1)
(append-instruction-sequences
on-return/multiple
(make-PerformStatement
(make-Perform
(make-RaiseContextExpectedValuesError! 1))
on-return)]
[else
@ -1657,11 +1657,11 @@
(append-instruction-sequences
on-return/multiple
;; if the wrong number of arguments come in, die
(make-TestAndJumpStatement (make-TestZero (new-SubtractArg (make-Reg 'argcount)
(make-TestAndJump (make-TestZero (new-SubtractArg (make-Reg 'argcount)
(make-Const context)))
after-value-check)
on-return
(make-PerformStatement
(make-Perform
(make-RaiseContextExpectedValuesError! context))
after-value-check))])]))
@ -1920,7 +1920,7 @@
[i : Natural])
(append-instruction-sequences
(make-Comment (format "Installing shell for ~s\n" (Lam-name lam)))
(make-PerformStatement (make-FixClosureShellMap! i
(make-Perform (make-FixClosureShellMap! i
(Lam-closure-map lam)))))
(LetRec-procs exp)
(build-list n (lambda: ([i : Natural]) i))))
@ -1971,7 +1971,7 @@
[from : OpArg])
(append-instruction-sequences
(make-Comment "install-value: installing value")
(make-AssignImmediateStatement to from)))
(make-AssignImmediate to from)))
(build-list count (lambda: ([i : Natural])
(make-EnvLexicalReference (+ i
(InstallValue-depth exp)
@ -1987,7 +1987,7 @@
(: compile-box-environment-value (BoxEnv CompileTimeEnvironment Target Linkage -> InstructionSequence))
(define (compile-box-environment-value exp cenv target linkage)
(append-instruction-sequences
(make-AssignPrimOpStatement (make-EnvLexicalReference (BoxEnv-depth exp) #f)
(make-AssignPrimOp (make-EnvLexicalReference (BoxEnv-depth exp) #f)
(make-MakeBoxedEnvironmentValue (BoxEnv-depth exp)))
(compile (BoxEnv-body exp) cenv target linkage)))
@ -2001,11 +2001,11 @@
(define (in-return-context)
(append-instruction-sequences
(compile (WithContMark-key exp) cenv 'val next-linkage/expects-single)
(make-AssignImmediateStatement
(make-AssignImmediate
(make-ControlFrameTemporary 'pendingContinuationMarkKey)
(make-Reg 'val))
(compile (WithContMark-value exp) cenv 'val next-linkage/expects-single)
(make-PerformStatement (make-InstallContinuationMarkEntry!))
(make-Perform (make-InstallContinuationMarkEntry!))
(compile (WithContMark-body exp) cenv target linkage)))
(: in-other-context ((U NextLinkage LabelLinkage) -> InstructionSequence))
@ -2021,14 +2021,14 @@
[(eq? target 'val)
empty-instruction-sequence]
[else
(make-AssignImmediateStatement target (make-Reg 'val))])])
(make-AssignImmediate target (make-Reg 'val))])])
(append-instruction-sequences
(make-PushControlFrame/Call on-return:)
(compile (WithContMark-key exp) cenv 'val next-linkage/expects-single)
(make-AssignImmediateStatement (make-ControlFrameTemporary 'pendingContinuationMarkKey)
(make-AssignImmediate (make-ControlFrameTemporary 'pendingContinuationMarkKey)
(make-Reg 'val))
(compile (WithContMark-value exp) cenv 'val next-linkage/expects-single)
(make-PerformStatement (make-InstallContinuationMarkEntry!))
(make-Perform (make-InstallContinuationMarkEntry!))
(compile (WithContMark-body exp) cenv 'val return-linkage/nontail)
check-values-context-on-procedure-return
maybe-migrate-val-to-target)))
@ -2040,7 +2040,7 @@
[(LabelLinkage? linkage)
(append-instruction-sequences
(in-other-context linkage)
(make-GotoStatement (make-Label (LabelLinkage-label linkage))))]))
(make-Goto (make-Label (LabelLinkage-label linkage))))]))
(: compile-apply-values (ApplyValues CompileTimeEnvironment Target Linkage -> InstructionSequence))
@ -2066,14 +2066,14 @@
'val
next-linkage/keep-multiple-on-stack)
(make-TestAndJumpStatement (make-TestZero (make-Reg 'argcount)) after-args-evaluated)
(make-TestAndJump (make-TestZero (make-Reg 'argcount)) after-args-evaluated)
;; In the common case where we do get values back, we push val onto the stack too,
;; so that we have n values on the stack before we jump to the procedure call.
(make-PushImmediateOntoEnvironment (make-Reg 'val) #f)
after-args-evaluated
;; Retrieve the procedure off the temporary control frame.
(make-AssignImmediateStatement
(make-AssignImmediate
'proc
(make-ControlFrameTemporary 'pendingApplyValuesProc))
@ -2105,7 +2105,7 @@
(apply append-instruction-sequences
(map (lambda: ([id : ToplevelRef]
[from : OpArg])
(make-AssignImmediateStatement
(make-AssignImmediate
;; Slightly subtle: the toplevelrefs were with respect to the
;; stack at the beginning of def-values, but at the moment,
;; there may be additional values that are currently there.
@ -2140,7 +2140,7 @@
(end-with-linkage linkage
cenv
(append-instruction-sequences
(make-AssignImmediateStatement target exp)
(make-AssignImmediate target exp)
singular-context-check)))]
[else
;; Maybe warn about the unimplemented kernel primitive.
@ -2150,7 +2150,7 @@
id)
((current-warn-unimplemented-kernel-primitive) id))
(make-PerformStatement (make-RaiseUnimplementedPrimitiveError! id))])))
(make-Perform (make-RaiseUnimplementedPrimitiveError! id))])))

18
compiler/il-structs.rkt
View File

@ -163,9 +163,9 @@
DebugPrint
Comment
AssignImmediateStatement
AssignPrimOpStatement
PerformStatement
AssignImmediate
AssignPrimOp
Perform
PopEnvironment
PushEnvironment
@ -176,7 +176,7 @@
PushControlFrame/Prompt
PopControlFrame))
(define-type BranchingStatement (U GotoStatement TestAndJumpStatement))
(define-type BranchingStatement (U Goto TestAndJump))
;; instruction sequences
@ -201,10 +201,10 @@
#:transparent)
(define-struct: AssignImmediateStatement ([target : Target]
(define-struct: AssignImmediate ([target : Target]
[value : OpArg])
#:transparent)
(define-struct: AssignPrimOpStatement ([target : Target]
(define-struct: AssignPrimOp ([target : Target]
[op : PrimitiveOperator])
#:transparent)
@ -252,18 +252,18 @@
(define-struct: GotoStatement ([target : (U Label
(define-struct: Goto ([target : (U Label
Reg
ModuleEntry
CompiledProcedureEntry)])
#:transparent)
(define-struct: PerformStatement ([op : PrimitiveCommand])
(define-struct: Perform ([op : PrimitiveCommand])
#:transparent)
(define-struct: TestAndJumpStatement ([op : PrimitiveTest]
(define-struct: TestAndJump ([op : PrimitiveTest]
[label : Symbol])
#:transparent)

52
compiler/optimize-il.rkt
View File

@ -50,8 +50,8 @@
;; If there's a label, immediately followed by a direct Goto jump,
;; just equate the label and the jump.
[(and (symbol? last-stmt) (GotoStatement? next-stmt))
(define goto-target (GotoStatement-target next-stmt))
[(and (symbol? last-stmt) (Goto? next-stmt))
(define goto-target (Goto-target next-stmt))
(cond
[(Label? goto-target)
(log-debug (format "merging label ~a and ~a" last-stmt (Label-name goto-target)))
@ -192,18 +192,18 @@
;(cons a-stmt (loop (rest stmts)))
]
[(AssignImmediateStatement? a-stmt)
(cons (make-AssignImmediateStatement (rewrite-target (AssignImmediateStatement-target a-stmt))
(rewrite-oparg (AssignImmediateStatement-value a-stmt)))
[(AssignImmediate? a-stmt)
(cons (make-AssignImmediate (rewrite-target (AssignImmediate-target a-stmt))
(rewrite-oparg (AssignImmediate-value a-stmt)))
(loop (rest stmts)))]
[(AssignPrimOpStatement? a-stmt)
(cons (make-AssignPrimOpStatement (rewrite-target (AssignPrimOpStatement-target a-stmt))
(rewrite-primop (AssignPrimOpStatement-op a-stmt)))
[(AssignPrimOp? a-stmt)
(cons (make-AssignPrimOp (rewrite-target (AssignPrimOp-target a-stmt))
(rewrite-primop (AssignPrimOp-op a-stmt)))
(loop (rest stmts)))]
[(PerformStatement? a-stmt)
(cons (make-PerformStatement (rewrite-primcmd (PerformStatement-op a-stmt)))
[(Perform? a-stmt)
(cons (make-Perform (rewrite-primcmd (Perform-op a-stmt)))
(loop (rest stmts)))]
[(PopEnvironment? a-stmt)
@ -242,19 +242,19 @@
[(PopControlFrame? a-stmt)
(cons a-stmt (loop (rest stmts)))]
[(GotoStatement? a-stmt)
(define target (GotoStatement-target a-stmt))
[(Goto? a-stmt)
(define target (Goto-target a-stmt))
(cond
[(Label? target)
(cons (make-GotoStatement (make-Label (ref (Label-name target))))
(cons (make-Goto (make-Label (ref (Label-name target))))
(loop (rest stmts)))]
[else
(cons a-stmt (loop (rest stmts)))])]
[(TestAndJumpStatement? a-stmt)
(cons (make-TestAndJumpStatement (rewrite-primtest (TestAndJumpStatement-op a-stmt))
(ref (TestAndJumpStatement-label a-stmt)))
[(TestAndJump? a-stmt)
(cons (make-TestAndJump (rewrite-primtest (TestAndJump-op a-stmt))
(ref (TestAndJump-label a-stmt)))
(loop (rest stmts)))])]))]))
@ -283,13 +283,13 @@
;; instruction.
[(and (PushEnvironment? first-stmt)
(equal? first-stmt (make-PushEnvironment 1 #f))
(AssignImmediateStatement? second-stmt))
(let ([target (AssignImmediateStatement-target second-stmt)])
(AssignImmediate? second-stmt))
(let ([target (AssignImmediate-target second-stmt)])
(cond
[(equal? target (make-EnvLexicalReference 0 #f))
(loop (cons (make-PushImmediateOntoEnvironment
(adjust-oparg-depth
(AssignImmediateStatement-value second-stmt) -1)
(AssignImmediate-value second-stmt) -1)
#f)
(rest (rest statements))))]
[else
@ -342,20 +342,20 @@
;#f
#t]
[(AssignImmediateStatement? stmt)
(equal? (AssignImmediateStatement-target stmt)
(AssignImmediateStatement-value stmt))]
[(AssignImmediate? stmt)
(equal? (AssignImmediate-target stmt)
(AssignImmediate-value stmt))]
[(AssignPrimOpStatement? stmt)
[(AssignPrimOp? stmt)
#f]
[(PerformStatement? stmt)
[(Perform? stmt)
#f]
[(GotoStatement? stmt)
[(Goto? stmt)
#f]
[(TestAndJumpStatement? stmt)
[(TestAndJump? stmt)
#f]
[(PopEnvironment? stmt)

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

@ -421,7 +421,7 @@
(: block-looks-like-context-expected-values? (BasicBlock -> (U Natural False)))
(define (block-looks-like-context-expected-values? a-block)
(match (BasicBlock-stmts a-block)
[(list (struct PerformStatement ((struct RaiseContextExpectedValuesError! (expected))))
[(list (struct Perform ((struct RaiseContextExpectedValuesError! (expected))))
stmts ...)
expected]
[else

80
js-assembler/assemble.rkt
View File

@ -162,15 +162,15 @@ EOF
(next)]
[(DebugPrint? stmt)
(next)]
[(AssignImmediateStatement? stmt)
[(AssignImmediate? stmt)
(next)]
[(AssignPrimOpStatement? stmt)
[(AssignPrimOp? stmt)
(next)]
[(PerformStatement? stmt)
[(Perform? stmt)
(next)]
[(TestAndJumpStatement? stmt)
[(TestAndJump? stmt)
(next)]
[(GotoStatement? stmt)
[(Goto? stmt)
(next)]
[(PushEnvironment? stmt)
(next)]
@ -247,7 +247,7 @@ EOF
(: default (UnlabeledStatement -> 'ok))
(define (default stmt)
(when (and (empty? (rest stmts))
(not (GotoStatement? stmt)))
(not (Goto? stmt)))
(log-debug (format "Last statement of the block ~a is not a goto" name)))
(display (assemble-statement stmt blockht) op)
@ -266,17 +266,17 @@ EOF
[(DebugPrint? stmt)
(default stmt)]
[(AssignImmediateStatement? stmt)
[(AssignImmediate? stmt)
(default stmt)]
[(AssignPrimOpStatement? stmt)
[(AssignPrimOp? stmt)
(default stmt)]
[(PerformStatement? stmt)
[(Perform? stmt)
(default stmt)]
[(TestAndJumpStatement? stmt)
(define test (TestAndJumpStatement-op stmt))
[(TestAndJump? stmt)
(define test (TestAndJump-op stmt))
(: test-code String)
(define test-code (cond
@ -306,14 +306,14 @@ EOF
(display test-code op)
(display "{" op)
(cond
[(set-contains? entry-points (TestAndJumpStatement-label stmt))
(display (assemble-jump (make-Label (TestAndJumpStatement-label stmt))
[(set-contains? entry-points (TestAndJump-label stmt))
(display (assemble-jump (make-Label (TestAndJump-label stmt))
blockht) op)]
[else
(assemble-block-statements (BasicBlock-name
(hash-ref blockht (TestAndJumpStatement-label stmt)))
(hash-ref blockht (TestAndJump-label stmt)))
(BasicBlock-stmts
(hash-ref blockht (TestAndJumpStatement-label stmt)))
(hash-ref blockht (TestAndJump-label stmt)))
blockht
entry-points
op)])
@ -322,9 +322,9 @@ EOF
(display "}" op)
'ok]
[(GotoStatement? stmt)
[(Goto? stmt)
(let loop ([stmt stmt])
(define target (GotoStatement-target stmt))
(define target (Goto-target stmt))
(cond
[(Label? target)
(define target-block (hash-ref blockht (Label-name target)))
@ -335,7 +335,7 @@ EOF
;; inline and follow the goto.
[(and (not (empty? target-statements))
(= 1 (length target-statements))
(GotoStatement? (first target-statements)))
(Goto? (first target-statements)))
(loop (first target-statements))]
[(set-contains? entry-points (Label-name target))
(display (assemble-statement stmt blockht) op)
@ -403,21 +403,21 @@ EOF
[(DebugPrint? stmt)
(default)]
[(AssignImmediateStatement? stmt)
[(AssignImmediate? stmt)
(default)]
[(AssignPrimOpStatement? stmt)
[(AssignPrimOp? stmt)
(default)]
[(PerformStatement? stmt)
[(Perform? stmt)
(default)]
[(TestAndJumpStatement? stmt)
(cons (TestAndJumpStatement-label stmt)
[(TestAndJump? stmt)
(cons (TestAndJump-label stmt)
(loop (rest stmts)))]
[(GotoStatement? stmt)
(define target (GotoStatement-target stmt))
[(Goto? stmt)
(define target (Goto-target stmt))
(cond
[(Label? target)
(cons (Label-name target)
@ -470,23 +470,23 @@ EOF
(format "M.params.currentOutputPort.writeDomNode(M, $('<span/>').text(~a));"
(assemble-oparg (DebugPrint-value stmt)
blockht))]
[(AssignImmediateStatement? stmt)
(let: ([t : (String -> String) (assemble-target (AssignImmediateStatement-target stmt))]
[v : OpArg (AssignImmediateStatement-value stmt)])
[(AssignImmediate? stmt)
(let: ([t : (String -> String) (assemble-target (AssignImmediate-target stmt))]
[v : OpArg (AssignImmediate-value stmt)])
(t (assemble-oparg v blockht)))]
[(AssignPrimOpStatement? stmt)
((assemble-target (AssignPrimOpStatement-target stmt))
(assemble-op-expression (AssignPrimOpStatement-op stmt)
[(AssignPrimOp? stmt)
((assemble-target (AssignPrimOp-target stmt))
(assemble-op-expression (AssignPrimOp-op stmt)
blockht))]
[(PerformStatement? stmt)
(assemble-op-statement (PerformStatement-op stmt) blockht)]
[(Perform? stmt)
(assemble-op-statement (Perform-op stmt) blockht)]
[(TestAndJumpStatement? stmt)
(let*: ([test : PrimitiveTest (TestAndJumpStatement-op stmt)]
[(TestAndJump? stmt)
(let*: ([test : PrimitiveTest (TestAndJump-op stmt)]
[jump : String (assemble-jump
(make-Label (TestAndJumpStatement-label stmt))
(make-Label (TestAndJump-label stmt))
blockht)])
;; to help localize type checks, we add a type annotation here.
(ann (cond
@ -519,8 +519,8 @@ EOF
jump)])
String))]
[(GotoStatement? stmt)
(assemble-jump (GotoStatement-target stmt)
[(Goto? stmt)
(assemble-jump (Goto-target stmt)
blockht)]
[(PushControlFrame/Generic? stmt)
@ -632,8 +632,8 @@ EOF
(cons (LinkedLabel-label first-stmt)
(cons (LinkedLabel-linked-to first-stmt)
(get-function-entry-and-exit-names (rest stmts))))]
[(AssignPrimOpStatement? first-stmt)
(define op (AssignPrimOpStatement-op first-stmt))
[(AssignPrimOp? first-stmt)
(define op (AssignPrimOp-op first-stmt))
(cond
[(MakeCompiledProcedure? op)
(cons (MakeCompiledProcedure-label op)

36
js-assembler/collect-jump-targets.rkt
View File

@ -25,17 +25,17 @@
(LinkedLabel-linked-to stmt))]
[(DebugPrint? stmt)
empty]
[(AssignImmediateStatement? stmt)
(let: ([v : OpArg (AssignImmediateStatement-value stmt)])
[(AssignImmediate? stmt)
(let: ([v : OpArg (AssignImmediate-value stmt)])
(collect-input v))]
[(AssignPrimOpStatement? stmt)
(collect-primitive-operator (AssignPrimOpStatement-op stmt))]
[(PerformStatement? stmt)
(collect-primitive-command (PerformStatement-op stmt))]
[(TestAndJumpStatement? stmt)
(list (TestAndJumpStatement-label stmt))]
[(GotoStatement? stmt)
(collect-input (GotoStatement-target stmt))]
[(AssignPrimOp? stmt)
(collect-primitive-operator (AssignPrimOp-op stmt))]
[(Perform? stmt)
(collect-primitive-command (Perform-op stmt))]
[(TestAndJump? stmt)
(list (TestAndJump-label stmt))]
[(Goto? stmt)
(collect-input (Goto-target stmt))]
[(PushEnvironment? stmt)
empty]
[(PopEnvironment? stmt)
@ -172,16 +172,16 @@
(LinkedLabel-linked-to stmt))]
[(DebugPrint? stmt)
empty]
[(AssignImmediateStatement? stmt)
(let: ([v : OpArg (AssignImmediateStatement-value stmt)])
[(AssignImmediate? stmt)
(let: ([v : OpArg (AssignImmediate-value stmt)])
(collect-input v))]
[(AssignPrimOpStatement? stmt)
(collect-primitive-operator (AssignPrimOpStatement-op stmt))]
[(PerformStatement? stmt)
(collect-primitive-command (PerformStatement-op stmt))]
[(TestAndJumpStatement? stmt)
[(AssignPrimOp? stmt)
(collect-primitive-operator (AssignPrimOp-op stmt))]
[(Perform? stmt)
(collect-primitive-command (Perform-op stmt))]
[(TestAndJump? stmt)
empty]
[(GotoStatement? stmt)
[(Goto? stmt)
empty]
[(PushEnvironment? stmt)
empty]

4
js-assembler/fracture.rkt
View File

@ -73,7 +73,7 @@
name
(if last-stmt-goto?
(reverse acc)
(reverse (cons (make-GotoStatement (make-Label label-name))
(reverse (cons (make-Goto (make-Label label-name))
acc))))
basic-blocks)
(cdr stmts)
@ -94,7 +94,7 @@
(cons first-stmt acc)
basic-blocks
(cdr stmts)
(GotoStatement? (car stmts)))]))]))))
(Goto? (car stmts)))]))]))))
(define end-time (current-inexact-milliseconds))
(fprintf (current-timing-port) " assemble fracture: ~a milliseconds\n" (- end-time start-time))

2
make/make.rkt
View File

@ -59,7 +59,7 @@
[(ModuleLocator? maybe-module-locator)
(append (my-force stmts)
;; Set the main module name
(list (make-PerformStatement
(list (make-Perform
(make-AliasModuleAsMain!
maybe-module-locator))))]
[else

2
version.rkt
View File

@ -7,4 +7,4 @@
(provide version)
(: version String)
(define version "1.147")
(define version "1.150")