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

in the middle of changing those compile-time errors to runtime ones.

Browse Source
This commit is contained in:
Danny Yoo 2011-04-17 14:45:15 -04:00
parent 832df0a2be
commit 3c08b75f44
2 changed files with 66 additions and 44 deletions

92
compiler.rkt
View File

@ -531,8 +531,10 @@
[(Prefix? op-knowledge) [(Prefix? op-knowledge)
(error 'impossible)] (error 'impossible)]
[(Const? op-knowledge) [(Const? op-knowledge)
;; FIXME: this needs to be a runtime error to preserve Racket's semantics. (make-instruction-sequence `(,(make-AssignImmediateStatement 'proc op-knowledge)
(error 'application "Can't apply constant ~s as a function" (Const-const op-knowledge))])))) ,(make-PerformStatement
(make-RaiseOperatorApplicationError! (make-Reg 'proc)))))]))))
(: compile-general-application (App CompileTimeEnvironment Target Linkage -> InstructionSequence)) (: compile-general-application (App CompileTimeEnvironment Target Linkage -> InstructionSequence))
@ -829,48 +831,50 @@
(StaticallyKnownLam App CompileTimeEnvironment Target Linkage (StaticallyKnownLam App CompileTimeEnvironment Target Linkage
-> InstructionSequence)) -> InstructionSequence))
(define (compile-statically-known-lam-application static-knowledge exp cenv target linkage) (define (compile-statically-known-lam-application static-knowledge exp cenv target linkage)
(unless (arity-matches? (StaticallyKnownLam-arity static-knowledge) (let ([arity-check
(length (App-operands exp))) (cond [(arity-matches? (StaticallyKnownLam-arity static-knowledge)
;; FIXME: this needs to be turned into a runtime error, not a compile-time error, to preserve (length (App-operands exp)))
;; Racket semantics. empty-instruction-sequence]
(error 'arity-mismatch "~s expected ~s arguments, but received ~s" [else
(StaticallyKnownLam-name static-knowledge) (make-instruction-sequence
(StaticallyKnownLam-arity static-knowledge) `(,(make-PerformStatement
(length (App-operands exp)))) (make-RaiseArityMismatchError!
(StaticallyKnownLam-arity static-knowledge)
(let* ([extended-cenv (make-Const (length (App-operands exp)))))))])])
(extend-compile-time-environment/scratch-space (let* ([extended-cenv
cenv (extend-compile-time-environment/scratch-space
(length (App-operands exp)))] cenv
[proc-code (compile (App-operator exp) (length (App-operands exp)))]
extended-cenv [proc-code (compile (App-operator exp)
(if (empty? (App-operands exp)) extended-cenv
'proc (if (empty? (App-operands exp))
(make-EnvLexicalReference 'proc
(ensure-natural (sub1 (length (App-operands exp)))) (make-EnvLexicalReference
#f)) (ensure-natural (sub1 (length (App-operands exp))))
next-linkage-expects-single)] #f))
[operand-codes (map (lambda: ([operand : Expression] next-linkage-expects-single)]
[target : Target]) [operand-codes (map (lambda: ([operand : Expression]
(compile operand extended-cenv target next-linkage-expects-single)) [target : Target])
(App-operands exp) (compile operand extended-cenv target next-linkage-expects-single))
(build-list (length (App-operands exp)) (App-operands exp)
(lambda: ([i : Natural]) (build-list (length (App-operands exp))
(if (< i (sub1 (length (App-operands exp)))) (lambda: ([i : Natural])
(make-EnvLexicalReference i #f) (if (< i (sub1 (length (App-operands exp))))
'val))))]) (make-EnvLexicalReference i #f)
(append-instruction-sequences 'val))))])
(if (not (empty? (App-operands exp))) (append-instruction-sequences
(make-instruction-sequence `(,(make-PushEnvironment (length (App-operands exp)) #f))) (if (not (empty? (App-operands exp)))
empty-instruction-sequence) (make-instruction-sequence `(,(make-PushEnvironment (length (App-operands exp)) #f)))
proc-code empty-instruction-sequence)
(juggle-operands operand-codes) proc-code
(compile-procedure-call/statically-known-lam static-knowledge (juggle-operands operand-codes)
cenv arity-check
extended-cenv (compile-procedure-call/statically-known-lam static-knowledge
(length (App-operands exp)) cenv
target extended-cenv
linkage)))) (length (App-operands exp))
target
linkage)))))
(: juggle-operands ((Listof InstructionSequence) -> InstructionSequence)) (: juggle-operands ((Listof InstructionSequence) -> InstructionSequence))

18
il-structs.rkt
View File

@ -325,6 +325,22 @@
(define-struct: RaiseContextExpectedValuesError! ([expected : Natural]) (define-struct: RaiseContextExpectedValuesError! ([expected : Natural])
#:transparent) #:transparent)
;; Raises an exception that says that we're doing a
;; procedure application, but got sent an incorrect number.
(define-struct: RaiseArityMismatchError! ([expected : Arity]
[received : OpArg])
#:transparent)
;; Raises an exception that says that we're doing a
;; procedure application, but got sent an incorrect number.
(define-struct: RaiseOperatorApplicationError! ([operator : OpArg])
#:transparent)
;; Changes over the control located at the given argument from the structure in env[1] ;; Changes over the control located at the given argument from the structure in env[1]
(define-struct: RestoreControl! ([tag : (U DefaultContinuationPromptTag OpArg)]) #:transparent) (define-struct: RestoreControl! ([tag : (U DefaultContinuationPromptTag OpArg)]) #:transparent)
@ -351,6 +367,8 @@
UnspliceRestFromStack! UnspliceRestFromStack!
RaiseContextExpectedValuesError! RaiseContextExpectedValuesError!
RaiseArityMismatchError!
RaiseOperatorApplicationError!
RestoreEnvironment! RestoreEnvironment!
RestoreControl!)) RestoreControl!))