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

WIP

Browse source
This commit is contained in:
Justin Ethier 2016-02-08 23:45:00 -05:00
parent 709aaca4bb
commit 5d5611c407
1 changed files with 66 additions and 56 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

122
scheme/lazy.sld
View file

@ -5,66 +5,76 @@
force force
delay-force delay-force
make-promise make-promise
promise?) ;promise?
)
(begin (begin
(define (make-promise x) ; (define (make-promise x)
(delay x)) ; (delay x))
;) ; ;)
;(begin ; ;(begin
(define (promise? x) ; (define (promise? x)
(and (pair? x) ; (and (pair? x)
(null? (cdr x)) ; (null? (cdr x))
(pair? (car x)) ; (pair? (car x))
(or (eq? #t (caar x)) ; (or (eq? #t (caar x))
(and (eq? #f (caar x)) ; (and (eq? #f (caar x))
(procedure? (cdar x)))))) ; (procedure? (cdar x))))))
;
; (define-syntax delay-force
; (er-macro-transformer
; (lambda (expr rename compare)
; `(,(rename 'promise) #f (,(rename 'lambda) () ,(cadr expr))))))
;
; (define-syntax delay
; (er-macro-transformer
; (lambda (expr rename compare)
; `(,(rename 'delay-force) (,(rename 'promise) #t ,(cadr expr))))))
;
; (define (promise done? proc)
; (list (cons done? proc)))
; (define (promise-done? x) (car (car x)))
; (define (promise-value x) (cdr (car x)))
; (define (promise-update! new old)
; (set-car! (car old) (promise-done? new))
; (set-cdr! (car old) (promise-value new))
; (set-car! new (car old)))
; (define (force promise)
; (if (promise-done? promise)
; (promise-value promise)
; (let ((promise* ((promise-value promise))))
; (if (not (promise-done? promise))
; (promise-update! promise* promise))
; (force promise))))))
(define-syntax delay-force ;; Delayed evaluation functions from husk
(er-macro-transformer (define force
(lambda (expr rename compare) (lambda (object)
`(,(rename 'promise) #f (,(rename 'lambda) () ,(cadr expr)))))) (object)))
(define-syntax delay (define-syntax delay
(er-macro-transformer (er-macro-transformer
(lambda (expr rename compare) (lambda (expr rename compare)
`(,(rename 'delay-force) (,(rename 'promise) #t ,(cadr expr)))))) `(make-promise (lambda () ,(cadr expr))))))
(define-syntax delay-force
(er-macro-transformer
(lambda (expr rename compare)
`(make-promise (lambda () ,(cadr expr))))))
;(define-syntax delay
; (syntax-rules ()
; ((delay expression)
; (make-promise (lambda () expression)))))
(define (promise done? proc) (define make-promise
(list (cons done? proc))) (lambda (proc)
(define (promise-done? x) (car (car x))) (let ((result-ready? #f)
(define (promise-value x) (cdr (car x))) (result #f))
(define (promise-update! new old) (lambda ()
(set-car! (car old) (promise-done? new)) (if result-ready?
(set-cdr! (car old) (promise-value new)) result
(set-car! new (car old))) (let ((x (proc)))
(define (force promise) (if result-ready?
(if (promise-done? promise) result
(promise-value promise) (begin (set! result x)
(let ((promise* ((promise-value promise)))) (set! result-ready? #t)
(if (not (promise-done? promise)) result))))))))
(promise-update! promise* promise)) ))
(force promise))))))
;; Delayed evaluation functions from husk
;(define force
; (lambda (object)
; (object)))
;
;(define-syntax delay
; (syntax-rules ()
; ((delay expression)
; (make-promise (lambda () expression)))))
;
;(define make-promise
; (lambda (proc)
; (let ((result-ready? #f)
; (result #f))
; (lambda ()
; (if result-ready?
; result
; (let ((x (proc)))
; (if result-ready?
; result
; (begin (set! result x)
; (set! result-ready? #t)
; result))))))))