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

a little code cleanup

Browse Source
This commit is contained in:
Danny Yoo 2011-11-02 13:40:59 -04:00
parent 716794d338
commit 76c16e0304
1 changed files with 21 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
compiler/compiler.rkt
View File

@ -951,23 +951,14 @@
(cond (cond
[(eq? op-knowledge '?) [(eq? op-knowledge '?)
(default)] (default)]
[(PrimitiveKernelValue? op-knowledge) [(operator-is-statically-known-identifier? op-knowledge)
(let ([id (PrimitiveKernelValue-id op-knowledge)]) =>
(lambda (id)
(cond (cond
[(KernelPrimitiveName/Inline? id) [(KernelPrimitiveName/Inline? id)
(compile-open-codeable-application id exp cenv target linkage)] (compile-open-codeable-application id exp cenv target linkage)]
[else [else
(default)]))] (default)]))]
[(ModuleVariable? op-knowledge)
(cond
[(kernel-module-locator? (ModuleVariable-module-name op-knowledge))
(let ([op (ModuleVariable-name op-knowledge)])
(cond [(KernelPrimitiveName/Inline? op)
(compile-open-codeable-application op exp cenv target linkage)]
[else
(default)]))]
[else
(default)])]
[(StaticallyKnownLam? op-knowledge) [(StaticallyKnownLam? op-knowledge)
(compile-statically-known-lam-application op-knowledge exp cenv target linkage)] (compile-statically-known-lam-application op-knowledge exp cenv target linkage)]
[(Prefix? op-knowledge) [(Prefix? op-knowledge)
@ -976,7 +967,24 @@
(append-instruction-sequences (append-instruction-sequences
(make-AssignImmediateStatement 'proc op-knowledge) (make-AssignImmediateStatement 'proc op-knowledge)
(make-PerformStatement (make-PerformStatement
(make-RaiseOperatorApplicationError! (make-Reg 'proc))))])))) (make-RaiseOperatorApplicationError! (make-Reg 'proc))))]
[else
(default)]))))
(: operator-is-statically-known-identifier? (CompileTimeEnvironmentEntry -> (U False Symbol)))
(define (operator-is-statically-known-identifier? op-knowledge)
(cond [(PrimitiveKernelValue? op-knowledge)
(let ([id (PrimitiveKernelValue-id op-knowledge)])
id)]
[(ModuleVariable? op-knowledge)
(cond
[(kernel-module-locator? (ModuleVariable-module-name op-knowledge))
(ModuleVariable-name op-knowledge)]
[else
#f])]
[else
#f]))