Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-14 08:17:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Cut-over to Cyc-memoize

Browse source
This commit is contained in:
Justin Ethier 2019-02-14 12:47:36 -05:00
parent 4632efc71d
commit 12b6131992
2 changed files with 22 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
memo.scm
View file

@ -3,27 +3,27 @@
(srfi 69) (srfi 69)
(scheme write)) (scheme write))
(define (memoize function) ; (define (memoize function)
(let ((table (make-hash-table))) ;(make-equal?-map))) ; (let ((table (make-hash-table))) ;(make-equal?-map)))
(lambda args ; (lambda args
(apply values ; (apply values
;(map-get table ; ;(map-get table
(hash-table-ref table ; (hash-table-ref table
args ; args
;; If the entry isn't there, call the function. ; ;; If the entry isn't there, call the function.
(lambda () ; (lambda ()
(call-with-values ; (call-with-values
(lambda () (apply function args)) ; (lambda () (apply function args))
(lambda results ; (lambda results
;(map-put! table args results) ; ;(map-put! table args results)
(hash-table-set! table args results) ; (hash-table-set! table args results)
results)))))))) ; results))))))))
;
(define (fnc x y) (+ x y)) ;(define (fnc x y) (+ x y))
(define mfnc (memoize fnc)) ;(define mfnc (memoize fnc))
;
(write (mfnc 1 1)) (newline) ;(write (mfnc 1 1)) (newline)
(write (mfnc 1 1)) (newline) ;(write (mfnc 1 1)) (newline)
; Original versions: ; Original versions:
(define (ack m n) (define (ack m n)

2
scheme/cyclone/cps-opt-memoize-pure-fncs.scm
View file

@ -193,7 +193,7 @@
(set-global! ,var ,rsym) (set-global! ,var ,rsym)
,acc))) ,acc)))
) )
`(memoize `(Cyc-memoize
,(ast:make-lambda (list rsym) body) ,(ast:make-lambda (list rsym) body)
,new-var))) ,new-var)))
exp exp