Welcome to the CHICKEN Scheme pasting service
C5 merge-se WIP pasted by megane on Thu Aug 23 19:25:08 2018
diff --git a/modules.scm b/modules.scm index b0cdce5..c310553 100644 --- a/modules.scm +++ b/modules.scm @@ -44,6 +44,12 @@ chicken.platform chicken.syntax) +(define (make-hash-table #!optional _test _hash (size 301)) + (make-vector size '())) +(define (hash-table-exists? t k) (and (hash-table-ref t k) #t)) + +;; (import (only (srfi 69) symbol-hash hash-table-exists? hash-table-set! make-hash-table)) + (include "common-declarations.scm") (include "mini-srfi-1.scm") @@ -294,15 +300,31 @@ (warn "indirect export of unknown binding" (car iexports)) (loop2 (cdr iexports))))))))))) -(define (merge-se . ses) ; later occurrences take precedence - (let bwd ((ses (remove null? ses))) - (cond ((null? ses) '()) - ((null? (cdr ses)) (car ses)) ; Do not re-cons the final list - (else (let fwd ((se (car ses)) - (rest (bwd (cdr ses)))) - (cond ((null? se) rest) - ((assq (caar se) rest) (fwd (cdr se) rest)) - (else (cons (car se) (fwd (cdr se) rest))))))))) +(define (merge-se . ses*) ; later occurrences take precedence to earlier ones + (let ([seen (make-hash-table)] + [rses (reverse ses*)]) + (let loop ([ses (cdr rses)] + [last-se #f] + [se2 (car rses)]) + (cond + [(null? ses) se2] + [(or (eq? last-se (car ses)) + (null? (car ses))) + (loop (cdr ses) last-se se2)] + [(not last-se) + (unless (null? ses) + (for-each (lambda (e) (hash-table-set! seen (car e) #t)) se2)) + (loop ses se2 se2)] + [else + (let lp ([se (car ses)] + [se2 se2]) + (cond + [(null? se) (loop (cdr ses) (car ses) se2)] + [(hash-table-exists? seen (caar se)) + (lp (cdr se) se2)] + [else + (hash-table-set! seen (caar se) #t) + (lp (cdr se) (cons (car se) se2))]))])))) (define (##sys#compiled-module-registration mod) (let ((dlist (module-defined-list mod))
Profiling added by Kooda on Wed Mar 20 10:39:56 2019
On hypergiant/examples/simple.scm Compiled with chicken -:p simple.scm master branch (without patch): procedure calls seconds average percent ---------------------------------------------------------------------------------------- modules.scm:304: fwd 67 230.080 3.434 80.371 modules.scm:305: fwd 76 32.409 0.426 11.321 modules.scm:718: import-env 18 22.550 1.252 7.877 library.scm:1300: ##sys#allocate-vector 8 0.240 0.030 0.083 core.scm:522: find-id 7 0.160 0.022 0.055 library.scm:2673: ##sys#intern-symbol 8 0.120 0.014 0.041 eval.scm:1033: ##sys#dload 6 0.120 0.020 0.041 eval.scm:91: find-id 7 0.070 0.010 0.024 library.scm:3653: g4333 4 0.040 0.010 0.013 library.scm:4031: ##sys#read-char-0 3 0.030 0.010 0.010 library.scm:3634: g4319 3 0.030 0.010 0.010 modules.scm:773: ##sys#current-environment 3 0.030 0.010 0.010 library.scm:4055: loop 3 0.030 0.010 0.010 expand.scm:277: lookup 3 0.030 0.010 0.010 library.scm:4017: ##sys#peek-char-0 2 0.020 0.010 0.006 internal.scm:178: hash-symbol 2 0.020 0.010 0.006 modules.scm:585: chicken.keyword#keyword? 2 0.020 0.010 0.006 library.scm:1285: copy 2 0.020 0.010 0.006 modules.scm:715: g2251 2 0.020 0.010 0.006 eval.scm:1035: ##sys#dload 1 0.020 0.020 0.006 scrutinizer.scm:1849: g3797 1 0.020 0.020 0.006 library.scm:3997: loop 1 0.010 0.010 0.003 library.scm:4421: keyword-style 1 0.010 0.010 0.003 modules.scm:386: merge-se 1 0.010 0.010 0.003 eval.scm:132: chicken.keyword#keyword? 1 0.010 0.010 0.003 eval.scm:1146: ##sys#provided? 1 0.010 0.010 0.003 library.scm:2816: ##sys#check-fixnum 1 0.010 0.010 0.003 library.scm:2832: ##sys#make-vector 1 0.010 0.010 0.003 library.scm:3666: ##sys#read 1 0.010 0.010 0.003 mini-srfi-1.scm:82: pred 1 0.010 0.010 0.003 library.scm:4240: ##sys#read-char-0 1 0.010 0.010 0.003 library.scm:2710: ##sys#symbol->string 1 0.010 0.010 0.003 expand.scm:279: lookup 1 0.010 0.010 0.003 library.scm:3872: ##sys#call-with-current-continuation 1 0.010 0.010 0.003 library.scm:1350: ##sys#make-string 1 0.010 0.010 0.003 library.scm:4204: r-vector 1 0.010 0.010 0.003 library.scm:1283: loop 1 0.010 0.010 0.003 library.scm:4127: ##sys#peek-char-0 1 0.010 0.010 0.003 modules.scm:725: macro-env 1 0.010 0.010 0.003 expand.scm:479: lookup 1 0.010 0.010 0.003 master branch with patch: procedure calls seconds average percent ---------------------------------------------------------------------------------------- modules.scm:740: import-env 16 20.010 1.250 76.520 internal.scm:192: loop 51 2.089 0.040 7.992 internal.scm:178: hash-symbol 40 0.920 0.022 3.518 internal.scm:185: hash-symbol 27 0.410 0.015 1.567 library.scm:3653: g4333 27 0.390 0.014 1.491 library.scm:1300: ##sys#allocate-vector 13 0.330 0.025 1.261 eval.scm:1033: ##sys#dload 10 0.190 0.018 0.726 library.scm:3634: g4319 15 0.170 0.011 0.650 core.scm:522: find-id 5 0.170 0.034 0.650 library.scm:4115: ##sys#intern-symbol 13 0.140 0.010 0.535 modules.scm:327: lp 6 0.130 0.021 0.497 library.scm:2673: ##sys#intern-symbol 4 0.080 0.020 0.305 modules.scm:316: g1208 7 0.070 0.010 0.267 library.scm:3930: readrec 5 0.070 0.014 0.267 library.scm:4123: scheme#append 3 0.070 0.023 0.267 library.scm:4017: ##sys#peek-char-0 5 0.060 0.012 0.229 modules.scm:323: hash-table-exists? 5 0.050 0.010 0.191 library.scm:4026: ##sys#reverse-list->string 5 0.050 0.010 0.191 modules.scm:49: chicken.internal#hash-table-ref 4 0.050 0.012 0.191 support.scm:1674: scheme#append 2 0.050 0.025 0.191 modules.scm:324: lp 4 0.040 0.010 0.152 modules.scm:326: chicken.internal#hash-table-set! 3 0.030 0.010 0.114 modules.scm:316: chicken.internal#hash-table-set! 3 0.030 0.010 0.114 library.scm:3756: ##sys#read-char-0 3 0.030 0.010 0.114 expand.scm:277: lookup 3 0.030 0.010 0.114 eval.scm:91: find-id 2 0.030 0.014 0.114 library.scm:4009: r-xtoken 2 0.020 0.010 0.076 library.scm:1350: ##sys#make-string 2 0.020 0.010 0.076 support.scm:1672: ##sys#put! 2 0.020 0.010 0.076 library.scm:4012: ##sys#port-line 2 0.020 0.010 0.076 support.scm:1656: ##sys#get 2 0.020 0.010 0.076 library.scm:4055: loop 2 0.020 0.010 0.076 expand.scm:279: lookup 2 0.020 0.010 0.076 library.scm:3715: case-sensitive 2 0.020 0.010 0.076 library.scm:4031: ##sys#read-char-0 2 0.020 0.010 0.076 library.scm:3997: loop 1 0.010 0.010 0.038 modules.scm:607: ##sys#string-append 1 0.010 0.010 0.038 modules.scm:707: ##sys#symbol->string 1 0.010 0.010 0.038 scrutinizer.scm:1503: g3188 1 0.010 0.010 0.038 library.scm:3872: ##sys#call-with-current-continuation 1 0.010 0.010 0.038 library.scm:4261: r-list 1 0.010 0.010 0.038 mini-srfi-1.scm:82: pred 1 0.010 0.010 0.038 modules.scm:709: g2177 1 0.010 0.010 0.038 library.scm:4739: check 1 0.010 0.010 0.038 library.scm:2434: lp 1 0.010 0.010 0.038 library.scm:1283: loop 1 0.010 0.010 0.038 modules.scm:595: ##sys#find-module 1 0.010 0.010 0.038 support.scm:1674: ##sys#get 1 0.010 0.010 0.038 library.scm:4127: ##sys#peek-char-0 1 0.010 0.010 0.038 irregex-core.scm:3587: next 1 0.010 0.010 0.038 library.scm:4382: ##sys#write-char/port 1 0.010 0.010 0.038 library.scm:4276: r-symbol 1 0.010 0.010 0.038 modules.scm:795: ##sys#current-environment 1 0.010 0.010 0.038 support.scm:302: scheme#read 1 0.010 0.010 0.038 library.scm:3757: loop 1 0.010 0.010 0.038 library.scm:1285: copy 1 0.010 0.010 0.038 library.scm:3719: current-read-table 1 0.010 0.010 0.038 library.scm:3750: ##sys#peek-char-0 1 0.010 0.010 0.038 eval.scm:95: ##sys#get 1 0.010 0.010 0.038 eval.scm:1035: ##sys#dload 1 0.010 0.010 0.038 expand.scm:100: lookup 1 0.010 0.010 0.038 library.scm:4278: readrec 1 0.010 0.010 0.038 library.scm:2452: scan-digits 1 0.010 0.010 0.038