Changeset 11948 in project
 Timestamp:
 09/15/08 08:46:03 (13 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

chicken/branches/hygienic/cplatform.scm
r11919 r11948 364 364 (cons* (makenode '##core#proc '("C_quotient" #t) '()) cont callargs) ) ) ) ) ) 365 365 366 (rewrite 367 'eqv? 8 368 (lambda (db classargs cont callargs) 369 ;; (eqv? <var> <var>) > (quote #t) 370 ;; (eqv? ...) > (##core#inline "C_eqp" ...) [one argument is a constant and not a flonum] 371 (and (= (length callargs) 2) 372 (let ([arg1 (first callargs)] 373 [arg2 (second callargs)] ) 374 (or (and (eq? '##core#variable (nodeclass arg1)) 375 (eq? '##core#variable (nodeclass arg2)) 376 (equal? (nodeparameters arg1) (nodeparameters arg2)) 377 (makenode '##core#call '(#t) (list cont (qnode #t))) ) 378 (and (or (and (eq? 'quote (nodeclass arg1)) 379 (not (flonum? (first (nodeparameters arg1)))) ) 380 (and (eq? 'quote (nodeclass arg2)) 381 (not (flonum? (first (nodeparameters arg2)))) ) ) 382 (makenode 383 '##core#call '(#t) 384 (list cont (makenode '##core#inline '("C_eqp") callargs)) ) ) ) ) ) ) ) 366 (let () 367 (define (eqv?id db classargs cont callargs) 368 ;; (eqv? <var> <var>) > (quote #t) 369 ;; (eqv? ...) > (##core#inline "C_eqp" ...) [one argument is a constant and not a flonum] 370 (and (= (length callargs) 2) 371 (let ([arg1 (first callargs)] 372 [arg2 (second callargs)] ) 373 (or (and (eq? '##core#variable (nodeclass arg1)) 374 (eq? '##core#variable (nodeclass arg2)) 375 (equal? (nodeparameters arg1) (nodeparameters arg2)) 376 (makenode '##core#call '(#t) (list cont (qnode #t))) ) 377 (and (or (and (eq? 'quote (nodeclass arg1)) 378 (not (flonum? (first (nodeparameters arg1)))) ) 379 (and (eq? 'quote (nodeclass arg2)) 380 (not (flonum? (first (nodeparameters arg2)))) ) ) 381 (makenode 382 '##core#call '(#t) 383 (list cont (makenode '##core#inline '("C_eqp") callargs)) ) ) ) ) ) ) 384 (rewrite 'eqv? 8 eqv?id) 385 (rewrite '##sys#eqv? 8 eqv?id)) 385 386 386 387 (rewrite
Note: See TracChangeset
for help on using the changeset viewer.