chicken-hackers
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Chicken-hackers] [PATCH] Remove ##sys# prefix from lambda-info names of


From: Evan Hanson
Subject: [Chicken-hackers] [PATCH] Remove ##sys# prefix from lambda-info names of library procedures
Date: Wed, 23 Jul 2014 19:56:01 +1200

This is a cosmetic change that removes the "##sys#" prefix from the
lambda-info names of procedures defined in library.scm. Where a
procedure was defined first with the prefix and later as an alias
without it, their definitions have been swapped, making sure the
non-prefixed name is used in its lambda-info structure.
---
 library.scm |  102 +++++++++++++++++++++++++++++------------------------------
 1 file changed, 51 insertions(+), 51 deletions(-)

diff --git a/library.scm b/library.scm
index 0797ea7..74980fb 100644
--- a/library.scm
+++ b/library.scm
@@ -154,7 +154,7 @@ EOF
 (define (##sys#quit-hook result) ((##sys#exit-handler) 0))
 (define (quit #!optional result) (##sys#quit-hook result))
 
-(define (##sys#error . args)
+(define (error . args)
   (if (pair? args)
       (apply ##sys#signal-hook #:error args)
       (##sys#signal-hook #:error #f)))
@@ -162,11 +162,11 @@ EOF
 (define ##sys#warnings-enabled #t)
 (define ##sys#notices-enabled (##sys#fudge 13))
 
-(define (##sys#warn msg . args)
+(define (warning msg . args)
   (when ##sys#warnings-enabled
     (apply ##sys#signal-hook #:warning msg args) ) )
 
-(define (##sys#notice msg . args)
+(define (notice msg . args)
   (when (and ##sys#notices-enabled
             ##sys#warnings-enabled)
     (apply ##sys#signal-hook #:notice msg args) ) )
@@ -176,8 +176,9 @@ EOF
       (set! ##sys#warnings-enabled (car bool))
       ##sys#warnings-enabled) )
 
-(define error ##sys#error)
-(define warning ##sys#warn)
+(define ##sys#error error)
+(define ##sys#warn warning)
+(define ##sys#notice notice)
 
 (define-foreign-variable main_argc int "C_main_argc")
 (define-foreign-variable main_argv c-pointer "C_main_argv")
@@ -192,8 +193,7 @@ EOF
 (define ##sys#make-structure (##core#primitive "C_make_structure"))
 (define ##sys#ensure-heap-reserve (##core#primitive "C_ensure_heap_reserve"))
 (define (##sys#fudge index) (##core#inline "C_fudge" index))
-(define ##sys#call-host (##core#primitive "C_return_to_host"))
-(define return-to-host ##sys#call-host)
+(define return-to-host (##core#primitive "C_return_to_host"))
 (define ##sys#symbol-table-info (##core#primitive "C_get_symbol_table_info"))
 (define ##sys#memory-info (##core#primitive "C_get_memory_info"))
 (define (current-milliseconds) (##core#inline_allocate 
("C_a_i_current_milliseconds" 4) #f))
@@ -210,8 +210,8 @@ EOF
 (define (##sys#message str) (##core#inline "C_message" str))
 (define (##sys#byte x i) (##core#inline "C_subbyte" x i))
 (define (##sys#setbyte x i n) (##core#inline "C_setbyte" x i n))
-(define (##sys#void . _) (##core#undefined))
-(define void ##sys#void)
+(define (void . _) (##core#undefined))
+(define ##sys#void void)
 (define ##sys#undefined-value (##core#undefined))
 (define (##sys#halt msg) (##core#inline "C_halt" msg))
 (define (##sys#flo2fix n) (##core#inline "C_quickflonumtruncate" n))
@@ -330,7 +330,7 @@ EOF
       (##core#inline "C_i_check_closure_2" x (car loc))
       (##core#inline "C_i_check_closure" x) ) )
 
-(define (##sys#force obj)
+(define (force obj)
   (if (##sys#structure? obj 'promise)
       (let lp ((promise obj)
               (forward #f))
@@ -354,7 +354,7 @@ EOF
                 (lp val forward)))))
       obj))
 
-(define force ##sys#force)
+(define ##sys#force force)
 
 (define (system cmd)
   (##sys#check-string cmd 'system)
@@ -502,7 +502,7 @@ EOF
         (##sys#check-char c 'make-string)
         c ) ) ) )
 
-(define ##sys#string->list 
+(define string->list
   (lambda (s)
     (##sys#check-string s 'string->list)
     (let ((len (##core#inline "C_block_size" s)))
@@ -512,9 +512,9 @@ EOF
            (cons (##core#inline "C_subchar" s i)
                  (loop (fx+ i 1)) ) ) ) ) ) )
 
-(define string->list ##sys#string->list)
+(define ##sys#string->list string->list)
 
-(define (##sys#list->string lst0)
+(define (list->string lst0)
   (if (not (list? lst0))
       (##sys#error-not-a-proper-list lst0 'list->string)
       (let* ([len (length lst0)]
@@ -526,11 +526,11 @@ EOF
            (##sys#check-char c 'list->string)
            (##core#inline "C_setsubchar" s i c) ) ) ) ))
 
-(define list->string ##sys#list->string)
+(define ##sys#list->string list->string)
 
 ;;; By Sven Hartrumpf:
 
-(define (##sys#reverse-list->string l)
+(define (reverse-list->string l)
   (if (list? l)
       (let* ((n (length l))
             (s (##sys#make-string n)))
@@ -543,7 +543,7 @@ EOF
        s )
       (##sys#error-not-a-proper-list l 'reverse-list->string) ) )
 
-(define reverse-list->string ##sys#reverse-list->string)
+(define ##sys#reverse-list->string reverse-list->string)
 
 (define (string-fill! s c)
   (##sys#check-string s 'string-fill!)
@@ -904,19 +904,19 @@ EOF
 (define sub1 (lambda (n) (- n 1)))
 
 (define quotient (##core#primitive "C_quotient"))
-(define (##sys#number? x) (##core#inline "C_i_numberp" x))
-(define number? ##sys#number?)
+(define (number? x) (##core#inline "C_i_numberp" x))
+(define ##sys#number? number?)
 (define complex? number?)
 (define real? number?)
 (define (rational? n) (##core#inline "C_i_rationalp" n))
 (define ##sys#flonum-fraction (##core#primitive "C_flonum_fraction"))
 (define ##sys#fprat (##core#primitive "C_flonum_rat"))
-(define (##sys#integer? x) (##core#inline "C_i_integerp" x))
-(define integer? ##sys#integer?)
-(define (##sys#exact? x) (##core#inline "C_i_exactp" x))
-(define (##sys#inexact? x) (##core#inline "C_i_inexactp" x))
-(define exact? ##sys#exact?)
-(define inexact? ##sys#inexact?)
+(define (integer? x) (##core#inline "C_i_integerp" x))
+(define ##sys#integer? integer?)
+(define (exact? x) (##core#inline "C_i_exactp" x))
+(define (inexact? x) (##core#inline "C_i_inexactp" x))
+(define ##sys#exact? exact?)
+(define ##sys#inexact? inexact?)
 (define expt (##core#primitive "C_expt"))
 (define (##sys#fits-in-int? n) (##core#inline "C_fits_in_int_p" n))
 (define (##sys#fits-in-unsigned-int? n) (##core#inline 
"C_fits_in_unsigned_int_p" n))
@@ -966,11 +966,11 @@ EOF
        (else (if (##sys#exact? n) 0 0.0) ) ) )
 
 ;; hooks for numbers
-(define (##sys#exact->inexact n) (##core#inline_allocate 
("C_a_i_exact_to_inexact" 4) n))
-(define (##sys#inexact->exact n) (##core#inline "C_i_inexact_to_exact" n))
+(define (exact->inexact n) (##core#inline_allocate ("C_a_i_exact_to_inexact" 
4) n))
+(define (inexact->exact n) (##core#inline "C_i_inexact_to_exact" n))
 
-(define exact->inexact ##sys#exact->inexact)
-(define inexact->exact ##sys#inexact->exact)
+(define ##sys#exact->inexact exact->inexact)
+(define ##sys#inexact->exact inexact->exact)
 
 (define (floor x)
   (##sys#check-number x 'floor)
@@ -1097,7 +1097,7 @@ EOF
                  (##sys#lcm head n2)
                  (##sys#slot next 1)) #f) ) ) ) ) ) )
 
-(define (##sys#string->number str #!optional (radix 10) exactness)
+(define (string->number str #!optional (radix 10) exactness)
   (let ((num (##core#inline_allocate ("C_a_i_string_to_number" 4) str radix)))
     (case exactness
       ((i) (##core#inline_allocate ("C_a_i_exact_to_inexact" 4) num))
@@ -1107,10 +1107,10 @@ EOF
                 (##core#inline "C_i_inexact_to_exact" num)))
       (else num))))
 
-(define string->number ##sys#string->number)
-(define ##sys#number->string (##core#primitive "C_number_to_string"))
+(define ##sys#string->number string->number)
+(define 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 ##sys#number->string number->string)
 
 (define (flonum-print-precision #!optional prec)
   (let ([prev (##core#inline "C_get_print_precision")])
@@ -1282,7 +1282,7 @@ EOF
          (##sys#symbol->string kw)
          (##sys#signal-hook #:type-error 'keyword->string "bad argument type - 
not a keyword" kw) ) ) ) )
 
-(define ##sys#get-keyword
+(define get-keyword
   (let ((tag (list 'tag)))
     (lambda (key args #!optional thunk)
       (##sys#check-list args 'get-keyword)
@@ -1291,7 +1291,7 @@ EOF
            (and thunk (thunk))
            r)))))
 
-(define get-keyword ##sys#get-keyword)
+(define ##sys#get-keyword get-keyword)
 
 
 ;;; Blob:
@@ -1342,7 +1342,7 @@ EOF
 (define (vector-ref v i) (##core#inline "C_i_vector_ref" v i))
 (define (vector-set! v i x) (##core#inline "C_i_vector_set" v i x))
 
-(define (##sys#make-vector size . fill)
+(define (make-vector size . fill)
   (##sys#check-exact size 'make-vector)
   (when (fx< size 0) (##sys#error 'make-vector "size is negative" size))
   (##sys#allocate-vector
@@ -1352,7 +1352,7 @@ EOF
        (car fill) )
    #f) )
 
-(define make-vector ##sys#make-vector)
+(define ##sys#make-vector make-vector)
 
 (define (list->vector lst0)
   (if (not (list? lst0))
@@ -1577,8 +1577,8 @@ EOF
 (define ##sys#call-with-cthulhu (##core#primitive "C_call_with_cthulhu"))
 (define (##sys#direct-return dk x) (##core#inline "C_direct_return" dk x))
 (define values (##core#primitive "C_values"))
-(define ##sys#call-with-values (##core#primitive "C_call_with_values"))
-(define call-with-values ##sys#call-with-values)
+(define call-with-values (##core#primitive "C_call_with_values"))
+(define ##sys#call-with-values call-with-values)
 
 (define (##sys#for-each p lst0)
   (let loop ((lst lst0))
@@ -2170,7 +2170,7 @@ EOF
 (define-inline (setter? x) 
   (and (pair? x) (eq? setter-tag (##sys#slot x 0))) )
 
-(define ##sys#setter
+(define setter
   (##sys#decorate-lambda 
    (lambda (proc)
      (or (and-let* (((procedure? proc))
@@ -2195,7 +2195,7 @@ EOF
             (error "can't set setter of non-procedure" get) ) ) ) )
      proc) ) )
 
-(define setter ##sys#setter)
+(define ##sys#setter setter)
 
 (define (getter-with-setter get set #!optional info)
   (##sys#check-closure get 'getter-with-setter)
@@ -3793,20 +3793,20 @@ EOF
 
 (define (features) ##sys#features)
 
-(define (##sys#feature? . ids)
+(define (feature? . ids)
   (let loop ([ids ids])
     (or (null? ids)
        (and (memq (##sys#->feature-id (##sys#slot ids 0)) ##sys#features)
             (loop (##sys#slot ids 1)) ) ) ) )
 
-(define feature? ##sys#feature?)
+(define ##sys#feature? feature?)
 
 
 ;;; Access backtrace:
 
 (define-constant +trace-buffer-entry-slot-count+ 4)
 
-(define ##sys#get-call-chain
+(define get-call-chain
   (let ((extract
         (foreign-lambda* nonnull-c-string ((scheme-object x)) 
"C_return((C_char *)x);")))
     (lambda (#!optional (start 0) (thread ##sys#current-thread))
@@ -3865,7 +3865,7 @@ EOF
     (##sys#really-print-call-chain port ct header)
     ct))
 
-(define get-call-chain ##sys#get-call-chain)
+(define ##sys#get-call-chain get-call-chain)
 
 
 ;;; Interrupt handling:
@@ -4021,7 +4021,7 @@ EOF
               '(exn . call-chain) (##sys#get-call-chain)
               '(exn . location) loc) ) ) ) ] ) )
 
-(define (##sys#abort x)
+(define (abort x)
   (##sys#current-exception-handler x)
   (##sys#abort
    (##sys#make-structure
@@ -4031,11 +4031,11 @@ EOF
          '(exn . arguments) '()
          '(exn . location) #f) ) ) )
 
-(define (##sys#signal x)
+(define (signal x)
   (##sys#current-exception-handler x) )
 
-(define abort ##sys#abort)
-(define signal ##sys#signal)
+(define ##sys#abort abort)
+(define ##sys#signal signal)
 
 (define ##sys#last-exception #f)       ; used in csi for ,exn command
 
@@ -4939,11 +4939,11 @@ EOF
 
 ;;; Property lists
 
-(define (##sys#put! sym prop val)
+(define (put! sym prop val)
   (##sys#check-symbol sym 'put!)
   (##core#inline_allocate ("C_a_i_putprop" 8) sym prop val) )
 
-(define put! ##sys#put!)
+(define ##sys#put! put!)
 
 (define (##sys#get sym prop #!optional default)
   (##sys#check-symbol sym 'get)
-- 
1.7.10.4




reply via email to

[Prev in Thread] Current Thread [Next in Thread]