fixing some of the open coding; about to add a few more.
This commit is contained in:
parent
d0eb3b610e
commit
2cb966f01f
|
@ -422,6 +422,7 @@ EOF
|
|||
(open-code-kernel-primitive-procedure op)]))
|
||||
|
||||
|
||||
|
||||
;; FIXME: this needs to check that the domains are good!
|
||||
(: open-code-kernel-primitive-procedure (CallKernelPrimitiveProcedure -> String))
|
||||
(define (open-code-kernel-primitive-procedure op)
|
||||
|
@ -430,9 +431,11 @@ EOF
|
|||
(case operator
|
||||
[(+)
|
||||
(cond [(empty? rand-vals)
|
||||
"0"]
|
||||
"(0)"]
|
||||
[else
|
||||
(string-append "(" (string-join rand-vals " + ") ")")])]
|
||||
(string-append "("
|
||||
(string-join rand-vals " + ")
|
||||
")")])]
|
||||
[(add1)
|
||||
(unless (= 1 (length rand-vals))
|
||||
(error 'add1 "Expected one argument"))
|
||||
|
|
|
@ -500,14 +500,14 @@
|
|||
;; Produces a list of OpArgs if all the operands are particularly simple, and false otherwise.
|
||||
(define (all-operands-are-constant-or-stack-references rands)
|
||||
(cond [(andmap (lambda: ([rand : ExpressionCore])
|
||||
(or (Const? rand)
|
||||
(or (Constant? rand)
|
||||
(LocalRef? rand)
|
||||
(ToplevelRef? rand)))
|
||||
rands)
|
||||
(map (lambda: ([e : ExpressionCore])
|
||||
(cond
|
||||
[(Const? e)
|
||||
e]
|
||||
[(Constant? e)
|
||||
(make-Const (Constant-v e))]
|
||||
[(LocalRef? e)
|
||||
(make-EnvLexicalReference (LocalRef-depth e)
|
||||
(LocalRef-unbox? e))]
|
||||
|
|
|
@ -159,12 +159,14 @@
|
|||
|
||||
;; The following are primitives that the compiler knows about:
|
||||
(define-type KernelPrimitiveName (U '+
|
||||
'-
|
||||
'*
|
||||
'/
|
||||
'add1
|
||||
'sub1
|
||||
'<
|
||||
'<=
|
||||
'=
|
||||
|
||||
'cons
|
||||
'car
|
||||
'cdr
|
||||
|
|
|
@ -48,6 +48,12 @@ EOF
|
|||
#'stx)))
|
||||
(printf " ok (~a milliseconds)\n" (evaluated-t result))))))]))
|
||||
|
||||
(test '(display 42)
|
||||
"42")
|
||||
|
||||
(test '(display (+ 3 4))
|
||||
"7")
|
||||
|
||||
(test '(begin (define (f x)
|
||||
(if (= x 0)
|
||||
0
|
||||
|
|
Loading…
Reference in New Issue
Block a user