shirok

;;
;; Compile-time expansion of keyword arguments
;;
;; A keyword-arugment-taking procedure defined by suggested srfi-177 syntax:
;;
;;   (define/kw (proc arg ... (keyarg ...)) body ...)
;;
;; will be translated two procedures; first one is a core procedure:
;;
;;   (define ($real-proc arg ... keyarg ...) body ...)

shirok

*** src/Makefile.in.orig	Mon Dec 16 21:58:11 2019
--- src/Makefile.in	Mon Dec 16 21:58:22 2019
***************
*** 27,38 ****
  HEADERS   =
  
  TARGET    = $(ARCHFILES)
! OBJS      = $(MODULE)_head.$(OBJEXT) \
!             gauche-al.$(OBJEXT) \
              al-lib.$(OBJEXT) \

shirok

(define-syntax err
  (er-macro-transformer
   (^[f r c]
     (let1 p ((with-module gauche.internal extended-cons) 'error (cdr f))
       ((with-module gauche.internal pair-attribute-set!) p 'source-info (debug-source-info f))
       `(begin ,p #f)))))

shirok

#|
Benchmark: ran srfi-42-sum, apply-filter-iota, fold-lseq, recursive-loop, each for 1000 times.
        srfi-42-sum:  3.722 real,  3.720 cpu ( 3.720 user + 0.000 sys)@268.82/s n=1000
  apply-filter-iota: 14.721 real, 23.980 cpu (23.840 user + 0.140 sys)@ 41.70/s n=1000
          fold-lseq: 43.668 real, 50.560 cpu (50.460 user + 0.100 sys)@ 19.78/s n=1000
     recursive-loop:  4.371 real,  4.370 cpu ( 4.370 user + 0.000 sys)@228.83/s n=1000

                     Rate srfi-42-sum apply-filter-iota fold-lseq recursive-loop
        srfi-42-sum 269/s          --             6.446    13.591          1.175
  apply-filter-iota  42/s       0.155                --     2.108          0.182

shirok

(use gauche.time)

(define string (let1 o (open-output-string)
                 (do ((i 0 (+ i 1)))
                     ((= i 1000) (get-output-string o))
                   (write-char (integer->char i) o))))
(define char-list0 (string->list string))
(define char-list1 (string->list string))

(define (->symbol cl)

shirok

(use srfi-27)
(use srfi-42)
(use gauche.sequence)

(define *n* 10000)
(define *points* (make-vector *n* 0))

(define (reset init)
  (set! *points* (make-vector *n* init)))

shirok

;; 非末尾再帰版map:
(define (map f xs)
  (if (null? xs)
    '()
    (cons (f (car xs)) (map f (cdr xs)))))

;; CPSによる末尾再帰版map (計算量同じ)
(define (map f xs)
  (define (rec xs k)
    (if (null? xs)

shirok

(define (f x m) (modulo (+ (expt 25 x) (* -3 (expt 5 x)) -10) m))
(define (show m) (dotimes [x m] (let1 F (f x m) (print `(f ,x ,m) '= F (if (zero? F) " ****" "")))))

shirok

shiro@scherzo:~/src/Gauche$ cc -c t.c
shiro@scherzo:~/src/Gauche$ objdump -d t.o

t.o:     file format elf64-x86-64


Disassembly of section .text:

0000000000000000 <main>:
   0:	55                   	push   %rbp

shirok

shiro@intermezzo:~/src/Gauche/src$ cat t.c
#include <stdio.h>
#include <math.h>

int main()
{
    double x = 1.0 - pow(2.0, -52);
    double y = cbrt(x);
    printf("%20.17lf %20.17lf\n", x, y);
    return 0;