Skip to content

Instantly share code, notes, and snippets.

View shirok's full-sized avatar

Shiro Kawai shirok

View GitHub Profile
;;
;; 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 ...)
*** 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) \
(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)))))
#|
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
(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)
(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)))
;;
;; Implementation of John Nash's enciphering-deciphering machine described in
;; https://www.nsa.gov/Portals/70/documents/news-features/declassified-documents/nash-letters/nash_letters1.pdf
;;
(use gauche.sequence)
(use gauche.generator)
(use srfi-1)
(use srfi-43)
(use srfi-60)
;; 非末尾再帰版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)
(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) " ****" "")))))
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