Ignore:
Timestamp:
12/30/16 19:12:47 (3 years ago)
Author:
juergen
Message:

bindings 7.0 with algebraic types

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/bindings/trunk/tests/run.scm

    r33533 r33777  
    33;;;; ju (at) jugilo (dot) de
    44
    5 (require-library bindings arrays basic-sequences simple-tests)
     5(require-library bindings arrays basic-sequences simple-tests
     6                 simple-exceptions)
    67
    78(import simple-tests
    8         bindings
    9         (only basic-sequences seq-db)
     9        bindings basic-sequences simple-exceptions
     10        ;(only basic-sequences seq-db)
    1011        (only arrays array array? array-ref array-tail array->list)
    1112        )
     
    481482    ))
    482483
     484(define-test (types?)
     485  (check
     486    "LISTS AS ALGEBRAIC TYPE"
     487    (define-algebraic-type LIST List? (Nil) (Cons (x) (xs List?)))
     488    (define (List->list lst)
     489      (bind-case (<< lst List?)
     490        ((#:Nil) '())
     491        ((#:Cons x xs)
     492         (cons x (List->list xs)))))
     493    (define three (Cons 0 (Cons 1 (Cons 2 (Nil)))))
     494    (equal? (List->list three) '(0 1 2))
     495   
     496    "TYPED VECTORS AS ALGEBRAIC TYPE"
     497    (define-algebraic-type VEC Vec? (Vec (x integer?) xs integer?))
     498    (define (Vec->list vec)
     499      (bind (#:Vec x . xs) (<< vec Vec?)
     500        (cons x (vector->list (subvector xs 1)))))
     501    (define four (Vec 0 1 2 3))
     502    (equal? (Vec->list four) '(0 1 2 3))
     503
     504    "TYPED TREES AS ALGEBRAIC TYPE"
     505    (define-algebraic-type TREE Tree?
     506      (Leaf (b number?))
     507      (Node (left Tree?) (t number?) (right Tree?)))
     508    (define (leaf-sum tr)
     509      (bind-case (<< tr Tree?)
     510        ((#:Leaf b) b)
     511        ((#:Node left middle right)
     512         (+ (leaf-sum left) middle (leaf-sum right)))))
     513    (define tree (Node (Leaf 1) 2 (Leaf 3)))
     514    (= (leaf-sum tree) 6)
     515    ))
     516
     517
    483518(compound-test (BINDINGS)
    484519  (binds?)
     
    488523  (lets?)
    489524  (defines?)
     525  (types?)
    490526  )
    491527
Note: See TracChangeset for help on using the changeset viewer.