~ chicken-core (chicken-5) 26088584395fe70ae2eeeb7422131659decb958e
commit 26088584395fe70ae2eeeb7422131659decb958e
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Sat Apr 9 21:21:13 2011 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Sat Apr 9 21:21:13 2011 +0200
proper special-case handling (##sys#make-structure); rewrite can optionally narrow result type; added fixnum/decimal special number->string conversion; occurrance-typing uses more specific type for argument var; debug-output indents for exceptional clarity and aesthetic pleasure. All for you, my dear users.
diff --git a/chicken.h b/chicken.h
index 7a3f6891..00033d14 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1646,6 +1646,7 @@ C_fctexport void C_ccall C_exact_to_inexact(C_word c, C_word closure, C_word k,
C_fctexport void C_ccall C_quotient(C_word c, C_word closure, C_word k, C_word n1, C_word n2) C_noret;
C_fctexport void C_ccall C_string_to_number(C_word c, C_word closure, C_word k, C_word str, ...) C_noret; /*XXX left for binary compatibility */
C_fctexport void C_ccall C_number_to_string(C_word c, C_word closure, C_word k, C_word num, ...) C_noret;
+C_fctexport void C_ccall C_fixnum_to_string(C_word c, C_word closure, C_word k, C_word num) C_noret;
C_fctexport void C_ccall C_get_argv(C_word c, C_word closure, C_word k) C_noret; /* OBSOLETE */
C_fctexport void C_ccall C_get_argument(C_word c, C_word closure, C_word k, C_word index) C_noret;
C_fctexport void C_ccall C_make_structure(C_word c, C_word closure, C_word k, C_word type, ...) C_noret;
diff --git a/library.scm b/library.scm
index a1e0e6d6..59ef662b 100644
--- a/library.scm
+++ b/library.scm
@@ -1070,6 +1070,7 @@ EOF
(define string->number ##sys#string->number)
(define ##sys#number->string (##core#primitive "C_number_to_string"))
+(define ##sys#fixnum->string (##core#primitive "C_fixnum_to_string"))
(define number->string ##sys#number->string)
(define (flonum-print-precision #!optional prec)
diff --git a/runtime.c b/runtime.c
index d439aa59..880eda19 100644
--- a/runtime.c
+++ b/runtime.c
@@ -7556,6 +7556,25 @@ void C_ccall C_number_to_string(C_word c, C_word closure, C_word k, C_word num,
}
+/* special case for fixnum arg and decimal radix */
+void C_ccall
+C_fixnum_to_string(C_word c, C_word self, C_word k, C_word num)
+{
+ C_word *a, s;
+ int n;
+
+#ifdef C_SIXTY_FOUR
+ C_sprintf(buffer, C_text("%ld"), C_unfix(num));
+#else
+ C_sprintf(buffer, C_text("%d"), C_unfix(num));
+#endif
+ n = C_strlen(buffer);
+ a = C_alloc(C_bytestowords(n) + 1);
+ s = C_string2(&a, buffer);
+ C_kontinue(k, s);
+}
+
+
/* OBSOLETE */
void C_ccall C_get_argv(C_word c, C_word closure, C_word k)
{
diff --git a/scrutinizer.scm b/scrutinizer.scm
index a044e19d..3b23fd78 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -28,21 +28,23 @@
(unit scrutinizer)
(hide match-specialization specialize-node! specialization-statistics
procedure-type? named? procedure-result-types procedure-argument-types
- noreturn-type? rest-type procedure-name))
+ noreturn-type? rest-type procedure-name d-depth))
(include "compiler-namespace")
(include "tweaks")
+(define d-depth 0)
+
(define (d fstr . args)
(when (##sys#fudge 13)
- (printf "[debug] ~?~%" fstr args)) )
+ (printf "[debug] ~a~?~%" (make-string d-depth #\space) fstr args)) )
(define dd d)
;(define-syntax d (syntax-rules () ((_ . _) (void))))
-(define-syntax dd (syntax-rules () ((_ . _) (void))))
+;(define-syntax dd (syntax-rules () ((_ . _) (void))))
;;; Walk node tree, keeping type and binding information
@@ -69,8 +71,7 @@
; ##compiler#predicate -> TYPESPEC
; ##compiler#specializations -> (SPECIALIZATION ...)
; ##compiler#enforce-argument-types -> BOOL
-; ##compiler#special-result-type -> PROCEDURE: NODE SYMBOL PROCEDURE-TYPE RESULT-TYPES ->
-; RESULT-TYPES'
+; ##compiler#special-result-type -> PROCEDURE
;
; specialization specifiers:
;
@@ -310,7 +311,7 @@
(merge-result-types (cdr ts1) (cdr ts2))))))
(define (match t1 t2)
(let ((m (match1 t1 t2)))
- (dd "match ~a <-> ~a -> ~a" t1 t2 m)
+ (dd " match ~a <-> ~a -> ~a" t1 t2 m)
m))
(define (match1 t1 t2)
(cond ((eq? t1 t2))
@@ -510,7 +511,6 @@
"~aexpected argument #~a of type `~a', but was given an argument of type `~a'"
(pname) i (car atypes) (car args)))))
(let ((r (procedure-result-types ptype values-rest (cdr args))))
- (d " result-types: ~a" r)
;;XXX we should check whether this is a standard- or extended binding
(let* ((pn (procedure-name ptype))
(op #f))
@@ -542,12 +542,16 @@
(set! op (list pt `(not ,pt))))))))
((and specialize (variable-mark pn '##compiler#specializations)) =>
(lambda (specs)
- (for-each
- (lambda (spec)
- (when (match-specialization (car spec) (cdr args))
- (set! op (cons pn (car spec)))
- (specialize-node! node (cadr spec))))
- specs))))
+ (let loop ((specs specs))
+ (cond ((null? specs))
+ ((match-specialization (first (car specs)) (cdr args))
+ (let ((spec (car specs)))
+ (set! op (cons pn (car spec)))
+ (let* ((r2 (and (pair? (cddr spec)) (second spec)))
+ (rewrite (if r2 (third spec) (second spec))))
+ (specialize-node! node rewrite)
+ (when r2 (set! r r2)))))
+ (else (loop (cdr specs))))))))
(when op
(cond ((assoc op specialization-statistics) =>
(lambda (a) (set-cdr! a (add1 (cdr a)))))
@@ -558,6 +562,7 @@
(when (and specialize (not op) (procedure-type? ptype))
(set-car! (node-parameters node) #t)
(set! safe-calls (add1 safe-calls))))
+ (d " result-types: ~a" r)
r))))
(define (self-call? node loc)
(case (node-class node)
@@ -577,16 +582,21 @@
(define (invalidate-blist)
(for-each
(lambda (b)
- (when (get db (caar b) 'assigned)
- (dd "invalidating: ~a" b)
- (set-cdr! b '*)))
+ (let ((var (caar b)))
+ (when (and (get db var 'assigned)
+ ;; if it has a known value, then it only assigned once
+ (or (get db var 'unknown)
+ (not (get db var 'value))))
+ (dd "invalidating: ~a" b)
+ (set-cdr! b '*))))
blist))
(define (walk n e loc dest tail flow ctags) ; returns result specifier
(let ((subs (node-subexpressions n))
(params (node-parameters n))
(class (node-class n)) )
- (d "walk: ~a ~a (loc: ~a, dest: ~a, tail: ~a, flow: ~a, blist: ~a, e: ~a)"
- class params loc dest tail flow blist e)
+ (dd "walk: ~a ~a (loc: ~a, dest: ~a, tail: ~a, flow: ~a, blist: ~a, e: ~a)"
+ class params loc dest tail flow blist e)
+ (set! d-depth (add1 d-depth))
(let ((results
(case class
((quote) (list (constant-result (first params))))
@@ -687,9 +697,7 @@
(and-let* ((val (or (get db var 'value)
(get db var 'local-value))))
(when (eq? val (first subs))
- (debugging
- 'x "implicitly declaring toplevel variable type"
- var rt)
+ (debugging 'x (sprintf "~a : ~a" var rt))
(mark-variable var '##compiler#declared-type)
(mark-variable var '##compiler#type rt))))
(when b
@@ -732,12 +740,16 @@
(when (eq? '##core#variable (node-class arg))
(let* ((var (first (node-parameters arg)))
(a (assq var e))
- (pred (and pt ctags (not (eq? arg (car subs))))))
+ (oparg? (eq? arg (first subs)))
+ (pred (and pt ctags (not oparg?))))
(cond (pred
(d " predicate `~a' indicates `~a' is ~a in flow ~a" pn var pt
(car ctags))
(set! blist
- (alist-cons (cons var (car ctags)) pt blist)))
+ (alist-cons
+ (cons var (car ctags))
+ (if (and a (type<=? (cdr a) pt)) (cdr a) pt)
+ blist)))
(a
(when enforces
(let ((ar (cond ((blist-type var flow) =>
@@ -757,7 +769,12 @@
(cons var (car ctags)) ar
(alist-cons
(cons var (cdr ctags)) ar
- blist)))))))))))
+ blist)))))))
+ ((and oparg?
+ (variable-mark var '##compiler#special-result-type))
+ => (lambda (srt)
+ (dd " hardcoded special case: ~a" var)
+ (set! r (srt n r))))))))
subs
(cons fn (procedure-argument-types fn (sub1 len))))
r)))
@@ -766,6 +783,7 @@
(else
(for-each (lambda (n) (walk n e loc #f #f flow #f)) subs)
'*))))
+ (set! d-depth (sub1 d-depth))
(dd " -> ~a" results)
results)))
(let ((rn (walk (first (node-subexpressions node)) '() '() #f #f (list (tag)) #f)))
@@ -878,6 +896,7 @@
name new old)))
(mark-variable name '##compiler#type new)
(when specs
+ ;;XXX validate types in specs
(mark-variable name '##compiler#specializations specs))))))
(read-file dbfile))))
@@ -1015,9 +1034,6 @@
(else #f)))
(validate type))
-
-#|XXX not used, yet:
-
(define-syntax define-special-case
(syntax-rules ()
((_ name handler)
@@ -1027,13 +1043,12 @@
;;; hardcoded result types for certain primitives
(define-special-case ##sys#make-structure
- (lambda (node name ptype rtypes)
+ (lambda (node rtypes)
(or (let ((subs (node-subexpressions node)))
- (and (pair? subs)
- (let ((arg1 (first subs)))
+ (and (>= (length subs) 2)
+ (let ((arg1 (second subs)))
(and (eq? 'quote (node-class arg1))
(let ((val (first (node-parameters arg1))))
(and (symbol? val)
- `(struct ,val)))))))
+ `((struct ,val))))))))
rtypes)))
-|#
diff --git a/types.db b/types.db
index c3f34c90..03a2728c 100644
--- a/types.db
+++ b/types.db
@@ -167,53 +167,71 @@
((float float) (##core#inline "C_i_flonum_min" #(1) #(2))))
(+ (procedure! + (#!rest number) number)
- (((or fixnum float number)) #(1))
- ((float fixnum) (##core#inline_allocate
- ("C_a_i_flonum_plus" 4)
- #(1)
- (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
- ((fixnum float) (##core#inline_allocate
- ("C_a_i_flonum_plus" 4)
- (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
- #(2)))
- ((float float) (##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) #(2))))
+ ((fixnum) (fixnum) #(1))
+ ((float) (float) #(1))
+ ((number) #(1))
+ ((float fixnum) (float)
+ (##core#inline_allocate
+ ("C_a_i_flonum_plus" 4)
+ #(1)
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
+ ((fixnum float)
+ (float)
+ (##core#inline_allocate
+ ("C_a_i_flonum_plus" 4)
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
+ #(2)))
+ ((float float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) #(2))))
(- (procedure! - (number #!rest number) number)
- ((fixnum) (##core#inline "C_u_fixnum_negate" #(1)))
- ((float fixnum) (##core#inline_allocate
- ("C_a_i_flonum_difference" 4)
- #(1)
- (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
- ((fixnum float) (##core#inline_allocate
- ("C_a_i_flonum_difference" 4)
- (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
- #(2)))
- ((float float) (##core#inline_allocate ("C_a_i_flonum_difference" 4)
- #(1) #(2)))
- ((float) (##core#inline_allocate ("C_a_i_flonum_negate" 4) #(1))))
+ ((fixnum) (fixnum)
+ (##core#inline "C_u_fixnum_negate" #(1)))
+ ((float fixnum) (float)
+ (##core#inline_allocate
+ ("C_a_i_flonum_difference" 4)
+ #(1)
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
+ ((fixnum float) (float)
+ (##core#inline_allocate
+ ("C_a_i_flonum_difference" 4)
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
+ #(2)))
+ ((float float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_difference" 4) #(1) #(2)))
+ ((float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_negate" 4) #(1))))
(* (procedure! * (#!rest number) number)
- (((or fixnum float number)) #(1))
- ((float fixnum) (##core#inline_allocate
- ("C_a_i_flonum_times" 4)
- #(1)
- (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
- ((fixnum float) (##core#inline_allocate
- ("C_a_i_flonum_times" 4)
- (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
- #(2)))
- ((float float) (##core#inline_allocate ("C_a_i_flonum_times" 4) #(1) #(2))))
+ ((fixnum) (fixnum) #(1))
+ ((float) (float) #(1))
+ ((number) (number) #(1))
+ ((float fixnum) (float)
+ (##core#inline_allocate
+ ("C_a_i_flonum_times" 4)
+ #(1)
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
+ ((fixnum float) (float)
+ (##core#inline_allocate
+ ("C_a_i_flonum_times" 4)
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
+ #(2)))
+ ((float float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_times" 4) #(1) #(2))))
(/ (procedure! / (number #!rest number) number)
- ((float fixnum) (##core#inline_allocate
- ("C_a_i_flonum_quotient" 4)
- #(1)
- (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
- ((fixnum float) (##core#inline_allocate
- ("C_a_i_flonum_quotient" 4)
- (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
- #(2)))
- ((float float) (##core#inline_allocate ("C_a_i_flonum_quotient" 4) #(1) #(2))))
+ ((float fixnum) (float)
+ (##core#inline_allocate
+ ("C_a_i_flonum_quotient" 4)
+ #(1)
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
+ ((fixnum float) (float)
+ (##core#inline_allocate
+ ("C_a_i_flonum_quotient" 4)
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
+ #(2)))
+ ((float float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_quotient" 4) #(1) #(2))))
(= (procedure! = (#!rest number) boolean)
((fixnum fixnum) (eq? #(1) #(2)))
@@ -277,10 +295,13 @@
(quotient (procedure! quotient (number number) number)
;;XXX flonum/mixed case
- ((fixnum fixnum) (##core#inline "C_fixnum_divide" #(1) #(2))))
+ ((fixnum fixnum) (fixnum)
+ (##core#inline "C_fixnum_divide" #(1) #(2))))
(remainder (procedure! remainder (number number) number)
- ((fixnum fixnum) (##core#inline "C_fixnum_modulo" #(1) #(2))))
+ ;;XXX flonum/mixed case
+ ((fixnum fixnum) (fixnum)
+ (##core#inline "C_fixnum_modulo" #(1) #(2))))
(modulo (procedure! modulo (number number) number))
@@ -288,30 +309,36 @@
(lcm (procedure! lcm (#!rest number) number) ((* *) (##sys#lcm #(1) #(2))))
(abs (procedure! abs (number) number)
- ((fixnum) (##core#inline "C_fixnum_abs" #(1)))
- ((float) (##core#inline_allocate ("C_a_i_flonum_abs" 4) #(1))))
+ ((fixnum) (fixnum)
+ (##core#inline "C_fixnum_abs" #(1)))
+ ((float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_abs" 4) #(1))))
(floor (procedure! floor (number) number)
- ((fixnum) #(1))
- ((float) (##core#inline_allocate ("C_a_i_flonum_floor" 4) #(1))))
+ ((fixnum) (fixnum) #(1))
+ ((float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_floor" 4) #(1))))
(ceiling (procedure! ceiling (number) number)
- ((fixnum) #(1))
- ((float) (##core#inline_allocate ("C_a_i_flonum_ceiling" 4) #(1))))
+ ((fixnum) (fixnum) #(1))
+ ((float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_ceiling" 4) #(1))))
(truncate (procedure! truncate (number) number)
- ((fixnum) #(1))
- ((float) (##core#inline_allocate ("C_a_i_flonum_truncate" 4) #(1))))
+ ((fixnum) (fixnum) #(1))
+ ((float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_truncate" 4) #(1))))
(round (procedure! round (number) number)
- ((fixnum) #(1))
- ((float) (##core#inline_allocate ("C_a_i_flonum_round" 4) #(1))))
+ ((fixnum) (fixnum) #(1))
+ ((float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_round" 4) #(1))))
-(exact->inexact (procedure! exact->inexact (number) number)
+(exact->inexact (procedure! exact->inexact (number) float)
((float) #(1))
((fixnum) (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))))
-(inexact->exact (procedure! inexact->exact (number) number) ((fixnum) #(1)))
+(inexact->exact (procedure! inexact->exact (number) fixnum) ((fixnum) #(1)))
(exp (procedure! exp (number) float)
((float) (##core#inline_allocate ("C_a_i_flonum_exp" 4) #(1))))
@@ -320,8 +347,8 @@
((float) (##core#inline_allocate ("C_a_i_flonum_log" 4) #(1))))
(expt (procedure! expt (number number) number)
- ((float float) (##core#inline_allocate ("C_a_i_flonum_expt" 4)
- #(1) #(2))))
+ ((float float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_expt" 4) #(1) #(2))))
(sqrt (procedure! sqrt (number) float)
((float) (##core#inline_allocate ("C_a_i_flonum_sqrt" 4) #(1))))
@@ -345,17 +372,21 @@
((float) (##core#inline_allocate ("C_a_i_flonum_atan" 4) #(1)))
((float float) (##core#inline_allocate ("C_a_i_flonum_atan2" 4) #(1))))
-(number->string (procedure! number->string (number #!optional number) string))
+(number->string (procedure! number->string (number #!optional number) string)
+ ((fixnum) (##sys#fixnum->string #(1))))
+
(string->number (procedure! string->number (string #!optional number) (or number boolean)))
(char? (procedure char? (*) boolean))
(predicate char? char)
+;; we could rewrite these, but this is done by the optimizer anyway (safe)
(char=? (procedure! char=? (char char) boolean))
(char>? (procedure! char>? (char char) boolean))
(char<? (procedure! char<? (char char) boolean))
(char>=? (procedure! char>=? (char char) boolean))
(char<=? (procedure! char<=? (char char) boolean))
+
(char-ci=? (procedure! char-ci=? (char char) boolean))
(char-ci<? (procedure! char-ci<? (char char) boolean))
(char-ci>? (procedure! char-ci>? (char char) boolean))
@@ -368,6 +399,7 @@
(char-lower-case? (procedure! char-lower-case? (char) boolean))
(char-upcase (procedure! char-upcase (char) char))
(char-downcase (procedure! char-downcase (char) char))
+
(char->integer (procedure! char->integer (char) fixnum))
(integer->char (procedure! integer->char (fixnum) char))
@@ -475,14 +507,16 @@
((or fixnum float number) #(1)))
(magnitude (procedure! magnitude (number) number)
- ((fixnum) (##core#inline "C_fixnum_abs" #(1)))
- ((float) (##core#inline_allocate ("C_a_i_flonum_abs" 4) #(1))))
+ ((fixnum) (fixnum)
+ (##core#inline "C_fixnum_abs" #(1)))
+ ((float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_abs" 4) #(1))))
(numerator (procedure! numerator (number) number)
- ((fixnum) #(1)))
+ ((fixnum) (fixnum) #(1)))
(denominator (procedure! denominator (number) number)
- ((fixnum) (let ((#:tmp #(1))) '1)))
+ ((fixnum) (fixnum) (let ((#:tmp #(1))) '1)))
(scheme-report-environment (procedure! scheme-report-environment (#!optional fixnum) *))
(null-environment (procedure! null-environment (#!optional fixnum) *))
@@ -496,7 +530,8 @@
(abort (procedure abort (*) noreturn))
(add1 (procedure! add1 (number) number)
- ((float) (##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) '1.0)))
+ ((float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) '1.0)))
(argc+argv (procedure argc+argv () fixnum list))
(argv (procedure argv () list))
@@ -506,15 +541,18 @@
((fixnum fixnum) (##core#inline "C_u_i_bit_setp" #(1) #(2))))
(bitwise-and (procedure! bitwise-and (#!rest number) number)
- ((fixnum fixnum) (##core#inline "C_fixnum_and" #(1) #(2))))
+ ((fixnum fixnum) (fixnum)
+ (##core#inline "C_fixnum_and" #(1) #(2))))
(bitwise-ior (procedure! bitwise-ior (#!rest number) number)
- ((fixnum fixnum) (##core#inline "C_fixnum_or" #(1) #(2))))
+ ((fixnum fixnum) (fixnum)
+ (##core#inline "C_fixnum_or" #(1) #(2))))
(bitwise-not (procedure! bitwise-not (number) number))
(bitwise-xor (procedure! bitwise-xor (#!rest number) number)
- ((fixnum fixnum) (##core#inline "C_fixnum_xor" #(1) #(2))))
+ ((fixnum fixnum) (fixnum)
+ (##core#inline "C_fixnum_xor" #(1) #(2))))
(blob->string (procedure! blob->string (blob) string))
@@ -600,20 +638,16 @@
(force-finalizers (procedure force-finalizers () undefined))
(fp- (procedure! fp- (float float) float)
- ((float float) (##core#inline_allocate ("C_a_i_flonum_difference" 4)
- #(1) #(2)) ))
+ ((float float) (##core#inline_allocate ("C_a_i_flonum_difference" 4) #(1) #(2)) ))
(fp* (procedure! fp* (float float) float)
- ((float float) (##core#inline_allocate ("C_a_i_flonum_times" 4)
- #(1) #(2)) ))
+ ((float float) (##core#inline_allocate ("C_a_i_flonum_times" 4) #(1) #(2)) ))
(fp/ (procedure! fp/ (float float) float)
- ((float float) (##core#inline_allocate ("C_a_i_flonum_quotient" 4)
- #(1) #(2)) ))
+ ((float float) (##core#inline_allocate ("C_a_i_flonum_quotient" 4) #(1) #(2)) ))
(fp+ (procedure! fp+ (float float) float)
- ((float float) (##core#inline_allocate ("C_a_i_flonum_plus" 4)
- #(1) #(2)) ))
+ ((float float) (##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) #(2)) ))
(fp< (procedure! fp< (float float) boolean)
((float float) (##core#inline "C_flonum_lessp" #(1) #(2)) ))
@@ -689,8 +723,7 @@
((float) (##core#inline_allocate ("C_a_i_flonum_tan" 4) #(1) )))
(fptruncate (procedure! fptruncate (float) float)
- ((float) (##core#inline_allocate ("C_a_i_flonum_truncate" 4)
- #(1) )))
+ ((float) (##core#inline_allocate ("C_a_i_flonum_truncate" 4) #(1) )))
(fx- (procedure fx- (fixnum fixnum) fixnum))
(fx* (procedure fx* (fixnum fixnum) fixnum))
@@ -803,8 +836,8 @@
(strip-syntax (procedure strip-syntax (*) *))
(sub1 (procedure! sub1 (number) number)
- ((float) (##core#inline_allocate ("C_a_i_flonum_difference" 4)
- #(1) '1.0)))
+ ((float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_difference" 4) #(1) '1.0)))
(subvector (procedure! subvector (vector fixnum #!optional fixnum) vector))
(symbol-escape (procedure symbol-escape (#!optional *) *))
@@ -921,8 +954,7 @@
(write-byte (procedure! write-byte (fixnum #!optional port) undefined)
((fixnum port) (##sys#write-char-0 (integer->char #(1)) #(2)))
- ((fixnum) (##sys#write-char-0 (integer->char #(1))
- ##sys#standard-output)))
+ ((fixnum) (##sys#write-char-0 (integer->char #(1)) ##sys#standard-output)))
(write-line (procedure! write-line (string #!optional port) undefined))
(write-string (procedure! write-string (string #!optional * port) undefined))
Trap