Commits

Moritz Heidkamp committed 747fb3a

Type annotations

  • Participants
  • Parent commits fdbfe16
  • Branches typed

Comments (0)

Files changed (3)

 (import chicken scheme)
 (use srfi-1 extras)
 
-(define-record lazy-seq
-  body value)
+(define-record-type lazy-seq
+  (%make-lazy-seq body value)
+  lazy-seq?
+  (body lazy-seq-body lazy-seq-body-set!)
+  (value lazy-seq-value lazy-seq-value-set!))
 
-(define %make-lazy-seq
-  make-lazy-seq)
+(define-type lazy-seq
+  (struct lazy-seq))
 
+(define-type lazy-null
+  lazy-seq)
+
+(define-type lazy-body
+  (or null (pair * lazy-seq)))
+
+(: lazy-seq? (* --> boolean : lazy-seq))
+
+(: make-lazy-seq ((-> (or lazy-body lazy-seq)) --> lazy-seq))
 (define (make-lazy-seq body)
   (%make-lazy-seq body #f))
 
                      (loop (lazy-tail seq))))
                (display " ...>" out))))))
 
+(: lazy-seq-realized? (lazy-seq --> boolean))
 (define (lazy-seq-realized? seq)
   (not (lazy-seq-body seq)))
 
+(: lazy-null lazy-null)
 (define lazy-null
   (lazy-seq '()))
 
+(: lazy-null? (lazy-seq --> boolean))
 (define (lazy-null? seq)
   (null? (realized-lazy-seq seq)))
 
+(define-specialization (lazy-null? (seq lazy-null))
+  #t)
+
+(define-specialization (lazy-null? (seq lazy-seq))
+  (null? (realized-lazy-seq seq)))
+
+(: realized-lazy-seq (lazy-seq -> lazy-body))
 (define (realized-lazy-seq seq)
   (or (lazy-seq-value seq)
       (let ((value ((lazy-seq-body seq))))
               (loop (or (lazy-seq-value value)
                         ((lazy-seq-body value)))))))))
 
+(: lazy-head (lazy-seq -> *))
 (define (lazy-head seq)
   (car (realized-lazy-seq seq)))
 
+(: lazy-tail (lazy-seq -> lazy-seq))
 (define (lazy-tail seq)
   (cdr (realized-lazy-seq seq)))
 
+(: lazy-seq->list (lazy-seq -> (or null list)))
 (define (lazy-seq->list seq)
   (if (lazy-null? seq)
       '()
             (lazy-seq->list
              (lazy-tail seq)))))
 
+(: lazy-list (#!rest * --> lazy-seq))
 (define (lazy-list . elements)
   (list->lazy-seq elements))
 
+(: list->lazy-seq ((or null list) --> lazy-seq))
 (define (list->lazy-seq list)
   (if (null? list)
       (%make-lazy-seq #f '())
        #f (cons (car list)
                 (list->lazy-seq (cdr list))))))
 
+(: lazy-length (lazy-seq -> fixnum))
 (define (lazy-length seq)
   (let loop ((count 0) (seq seq))
     (if (lazy-null? seq)
         count
         (loop (+ count 1) (lazy-tail seq)))))
 
+(: lazy-take (fixnum lazy-seq --> lazy-seq))
 (define (lazy-take n seq)
   (lazy-seq
     (if (or (zero? n) (lazy-null? seq))
         (cons (lazy-head seq)
               (lazy-take (- n 1) (lazy-tail seq))))))
 
+(: lazy-drop (fixnum lazy-seq --> lazy-seq))
 (define (lazy-drop n seq)
   (lazy-seq
     (if (or (zero? n) (lazy-null? seq))
         seq
         (lazy-drop (- n 1) (lazy-tail seq)))))
 
+(: lazy-take-while ((* -> boolean) lazy-seq --> lazy-seq))
 (define (lazy-take-while pred? seq)
   (let loop ((seq seq))
     (lazy-seq
                    (loop (lazy-tail seq))))
             (else '())))))
 
+(: lazy-drop-while ((* -> boolean) lazy-seq --> lazy-seq))
 (define (lazy-drop-while pred? seq)
   (let loop ((seq seq))
     (lazy-seq
              (loop (lazy-tail seq)))
             (else seq)))))
 
+(: lazy-numbers (#!rest * --> lazy-seq))
 (define (lazy-numbers #!key (step 1) (start 0) count)
   (let loop ((count count) (start start) (step step))
     (lazy-seq
                       (+ start step)
                       step))))))
 
+(: lazy-append (#!rest lazy-seq --> lazy-seq))
 (define (lazy-append . seqs)
   (let loop ((seqs seqs))
     (lazy-seq
              (apply proc (map lazy-head seqs))
              (loop (map lazy-tail seqs)))))))))
 
+(: lazy-map ((* #!rest * -> *) lazy-seq #!rest lazy-seq --> lazy-seq))
 (define lazy-map
   (make-lazy-mapping-proc cons))
 
+;; (define-specialization (lazy-map (seq lazy-seq) (proc (* -> *)))
+;;   (let loop ((seq seq))
+;;     (lazy-seq
+;;       (if (lazy-null? seq)
+;;           '()
+;;           (cons
+;;            (proc (lazy-head seq))
+;;            (loop (lazy-tail seq)))))))
+
+(: lazy-append-map ((* #!rest * -> lazy-seq) lazy-seq #!rest lazy-seq --> lazy-seq))
 (define lazy-append-map
   (make-lazy-mapping-proc lazy-append))
 
+(: lazy-filter ((* -> boolean) lazy-seq --> lazy-seq))
 (define (lazy-filter pred? seq)
   (let loop ((seq seq))
     (lazy-seq
                 (cons head tail)
                 tail))))))
 
+(: lazy-ref (fixnum lazy-seq -> *))
 (define (lazy-ref n seq)
   (if (zero? n)
       (lazy-head seq)
       (lazy-ref (- n 1) (lazy-tail seq))))
 
+(: lazy-each ((* #!rest * -> *) #!rest lazy-seq -> void))
 (define (lazy-each proc . seqs)
   (unless (any lazy-null? seqs)
     (apply proc (map lazy-head seqs))
     (apply lazy-each proc (map lazy-tail seqs))))
 
+(: input-port->lazy-seq (input-port (input-port -> *) --> lazy-seq))
 (define (input-port->lazy-seq port read)
   (let loop ()
     (lazy-seq
             '()
             (cons datum (loop)))))))
 
+(: lazy-repeat (* --> lazy-seq))
 (define (lazy-repeat x)
   (lazy-seq (cons x (lazy-repeat x))))
 
+(: lazy-repeatedly ((-> *) --> lazy-seq))
 (define (lazy-repeatedly f)
   (lazy-seq (cons (f) (lazy-repeatedly f))))
 
+(: lazy-iterate
+   (forall ((f (x -> x)) x)
+           (f x --> lazy-seq)))
+;; (: lazy-iterate ((* -> *) * -> lazy-seq))
 (define (lazy-iterate f x)
   (lazy-seq
     (cons x (lazy-iterate f (f x)))))
 
+(: lazy-reverse (lazy-seq --> lazy-seq))
 (define (lazy-reverse seq)
   (let loop ((seq seq) (rev-seq (lazy-seq '())))
     (lazy-seq
           (loop (lazy-tail seq)
                 (%make-lazy-seq #f (cons (lazy-head seq) rev-seq)))))))
 
+(: lazy-cycle (lazy-seq --> lazy-seq))
 (define (lazy-cycle seq)
   (lazy-seq
     (if (lazy-null? seq)
-(compile -d0 -O3 -J -s lazy-seq.scm)
-(compile -d0 -O2 -s lazy-seq.import.scm)
+(compile -strict-types -emit-type-file lazy-seq.types -d0 -O3 -J -s lazy-seq.scm)
+(compile -d0 -O3 -s lazy-seq.import.scm)
 
 (install-extension
  'lazy-seq
- '("lazy-seq.so" "lazy-seq.import.so")
+ '("lazy-seq.so" "lazy-seq.import.so" "lazy-seq.types")
  '((version "0.0.5")))
-(load-relative "../lazy-seq")
-(import lazy-seq)
-(use test)
+(use lazy-seq test)
 
 (test-group "custom lazy-seq"
   (define calls 0)