diff --git a/compiler.rkt b/compiler.rkt index ab774e5..409d285 100644 --- a/compiler.rkt +++ b/compiler.rkt @@ -865,7 +865,7 @@ (ModuleVariable-module-name op-knowledge)) '#%kernel) (let ([op (ModuleVariable-name op-knowledge)]) - (cond [(KernelPrimitiveName? op) + (cond [(KernelPrimitiveName/Inline? op) (compile-kernel-primitive-application op exp cenv target linkage)] @@ -929,7 +929,7 @@ (: compile-kernel-primitive-application - (KernelPrimitiveName App CompileTimeEnvironment Target Linkage -> InstructionSequence)) + (KernelPrimitiveName/Inline App CompileTimeEnvironment Target Linkage -> InstructionSequence)) ;; This is a special case of application, where the operator is statically ;; known to be in the set of hardcoded primitives. ;; diff --git a/kernel-primitives.rkt b/kernel-primitives.rkt index 04e907d..f2f719c 100644 --- a/kernel-primitives.rkt +++ b/kernel-primitives.rkt @@ -71,6 +71,8 @@ 'eq?)) +(define-predicate KernelPrimitiveName/Inline? KernelPrimitiveName/Inline) + (: kernel-primitive-expected-operand-types (KernelPrimitiveName/Inline Natural -> (Listof OperandDomain))) diff --git a/test-compiler.rkt b/test-compiler.rkt index 3a01d3c..6789bcb 100644 --- a/test-compiler.rkt +++ b/test-compiler.rkt @@ -337,6 +337,55 @@ + +(test '(letrec ([even? (lambda (x) + (if (= x 0) + #t + (odd? (sub1 x))))] + [odd? (lambda (x) + (if (= x 0) + #f + (even? (sub1 x))))]) + (list (even? 1024) + (even? 1023) + (even? 2172) + (even? 2171))) + (list #t #f #t #f)) + + + + +(test '(letrec-values ([(even? odd?) + (values + (lambda (x) + (if (= x 0) + #t + (odd? (sub1 x)))) + (lambda (x) + (if (= x 0) + #f + (even? (sub1 x)))))]) + (list (even? 1024) + (even? 1023) + (even? 2172) + (even? 2171))) + (list #t #f #t #f)) + + + + + +(test '(letrec ([fact (lambda (x) + (if (= x 0) + 1 + (* x (fact (sub1 x)))))]) + (list (fact 3) (fact 4) (fact 5))) + '(6 24 120)) + + + + + ;; deriv (test '(let () (define (deriv-aux a) (list '/ (deriv a) a))