diff --git a/assemble.rkt b/assemble.rkt index f10f6d6..d72d5e9 100644 --- a/assemble.rkt +++ b/assemble.rkt @@ -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")) diff --git a/compile.rkt b/compile.rkt index 3bd2ad2..19d99ef 100644 --- a/compile.rkt +++ b/compile.rkt @@ -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))] diff --git a/il-structs.rkt b/il-structs.rkt index f60db10..e0fd4ad 100644 --- a/il-structs.rkt +++ b/il-structs.rkt @@ -159,12 +159,14 @@ ;; The following are primitives that the compiler knows about: (define-type KernelPrimitiveName (U '+ + '- + '* + '/ 'add1 'sub1 '< '<= '= - 'cons 'car 'cdr diff --git a/test-browser-evaluate.rkt b/test-browser-evaluate.rkt index 0ea6e1a..871419e 100644 --- a/test-browser-evaluate.rkt +++ b/test-browser-evaluate.rkt @@ -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