Changeset 37329 in project


Ignore:
Timestamp:
03/01/19 13:15:14 (3 weeks ago)
Author:
juergen
Message:

messages 0.4 with fixed dependencies and test-dependencies

Location:
release/5/messages/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • release/5/messages/trunk/functional-vectors.scm

    r37291 r37329  
    155155  ) ; functional-vectors
    156156
    157 ;(import functional-vectors bindings simple-tests)
    158 ;
    159 ;(ppp (fvector-data (fvector))
    160 ;     (fvector-data (fvector 0 1 2))
    161 ;     (fvector-data (fvector 0 (fvector 1 2)))
    162 ;     (fvector-data (fvector 0 (fvector 1 (fvector 2))))
    163 ;     (fvector-data (fvector foo: bar: (fvector 1 2 3)))
    164 ;     (fvector-ref (fvector 0 1 2) 1)
    165 ;     (bind (a (b c)) (fvector 0 (fvector 1 2)) (list a b c))
    166 ;     )
    167 
    168 
  • release/5/messages/trunk/messages.egg

    r37325 r37329  
    33 (category lang-exts)
    44 (license "BSD")
    5  (test-dependencies simple-tests)
    6  (dependencies checks bindings symbol-utils simple-cells)
     5 (test-dependencies simple-cells simple-tests)
     6 (dependencies checks bindings symbol-utils)
    77 (author "Juergen Lorenz")
    8  (version "0.3")
     8 (version "0.4")
    99 (components (extension messages) (extension functional-vectors))
    1010)
  • release/5/messages/trunk/messages.scm

    r37313 r37329  
    540540                        (keys (map caar messages))
    541541                        (fms (map (lambda (m)
    542                                     ;(print "MMM " m " AAA " (cdar m))
    543542                                    (split (cdar m)))
    544543                                  messages))
     
    550549                        (fargs (map car* fstate))
    551550                        (varg (if (null? vstate) `(,%list) (car vstate))));(car* vstate)))
    552                   ;(print "III " fargs)
    553                   ;(print "JJJ " varg)
    554                   ;(print "VVV " vstate)
    555                   ;(print "vvv " vms " lll " (length vms))
    556                   ;(print "fff " fms " lll " (length fms))
    557                   ;(print "kkk " keys " lll " (length keys))
    558                   ;(print "XXX " (map append fms vms))
    559551                    (let ((iargs (append fargs (car* vstate)))
    560552                          (some-handlers
     
    591583                                             (,%list-of?
    592584                                               ,@(cdr vstate))))))))))
    593                       ;(print "some-args " some-args)
    594585
    595586`(,%begin
     
    749740  ) ; module messages
    750741
    751 ;(import messages
    752 ;        simple-tests
    753 ;        simple-cells
    754 ;        checks
    755 ;        symbol-name-utils
    756 ;        bindings)
    757 ;
    758 ;(pe '
    759 ;  (define-object-type Bar
    760 ;    (state (as number?) #t)
    761 ;    ((#:xs xs number?) xs))
    762 ;  )
    763 ;
    764 ;(define-object-type Bar
    765 ;  (state (as number?) #t)
    766 ;  ((#:xs) as))
    767 ;
    768 ;(define bar (Bar-instance 1 2 3))
    769 ;
    770 ;(ppp (Bar-instance? bar)
    771 ;     (Bar-instance)
    772 ;     (Bar)
    773 ;     (bar)
    774 ;     bar
    775 ;     (bar ((Bar #:xs)))
    776 ;     (bar ((Bar #:invariant?)))
    777 ;     )
    778 ;
    779 ;(pe '
    780 ;  (define-object-type Baz
    781 ;    (state ((a number?) as number?) #t)
    782 ;    ((#:x) a)
    783 ;    ((#:xs) as))
    784 ;  )
    785 ;
    786 ;(define-object-type Baz
    787 ;  (state ((a number?) as number?) #t)
    788 ;  ((#:x) a)
    789 ;  ((#:xs) as))
    790 ;
    791 ;(define baz (Baz-instance 0 1 2 3))
    792 ;
    793 ;(ppp (Baz-instance? baz)
    794 ;     (baz)
    795 ;     (baz ((Baz #:xs)))
    796 ;     (baz ((Baz #:x)))
    797 ;     (baz ((Baz #:invariant?)))
    798 ;     )
    799 ;
    800 ;;;(pe '(case-variant Option opt
    801 ;;;;       (#:none () #f)
    802 ;;;;       (#:some (a) a)))
    803 ;;;;
    804 ;;;;(pe '(case-variant Option opt
    805 ;;;;       (#:some (a) a)
    806 ;;;;       (else #f)))
    807 ;;;;
    808 ;;;;;; options as algebraic types
    809 ;;;;(print "\noptions as algebraic types")
    810 ;;;;(print "--------------------------\n")
    811 ;;;;(define-algebraic-type Option
    812 ;;;;  (#:none)
    813 ;;;;  (#:some (arg))) ; arg not typed
    814 ;;;;
    815 ;;;;(define (bar opt)
    816 ;;;;  (case-variant Option opt
    817 ;;;;    (#:some (arg) arg)
    818 ;;;;    (else #f)))
    819 ;;;;
    820 ;;;;(define (baz opt)
    821 ;;;;  (case-variant Option opt
    822 ;;;;    (#:none () #f)
    823 ;;;;    (#:some (arg) arg)))
    824 ;;;;
    825 ;;;;(ppp ((Option #:?) ((Option #:none)))
    826 ;;;;     ((Option #:?) ((Option #:some) 5))
    827 ;;;;     (Option)
    828 ;;;;     (bar ((Option #:none)))
    829 ;;;;     (bar ((Option #:some) 5))
    830 ;;;;     bar
    831 ;;;;     (baz ((Option #:none)))
    832 ;;;;     (baz ((Option #:some) 5))
    833 ;;;;     baz
    834 ;;;;     )
    835 ;;;;
    836 ;;(pe '
    837 ;;  (define-algebraic-type Single
    838 ;;    (#:maker (x number?))
    839 ;;    )
    840 ;;  )
    841 ;;
    842 ;;  (define-algebraic-type Single
    843 ;;    (#:maker (x number?))
    844 ;;    )
    845 ;;
    846 ;;(pe '
    847 ;;  (define-algebraic-type Couple Single
    848 ;;    (#:maker (parent (Single #:?)) (y number?))
    849 ;;    )
    850 ;;  )
    851 ;;
    852 ;;  (define-algebraic-type Couple Single
    853 ;;    (#:maker (parent (Single #:?)) (y number?))
    854 ;;    )
    855 ;
    856 ;;(pe '
    857 ;;  (define-object-type Rect
    858 ;;    (state ((x% (cell-of? number?))
    859 ;;            (y% (cell-of? number?))
    860 ;;            (w% (cell-of? number?))
    861 ;;            (h% (cell-of? number?)))
    862 ;;      #t)
    863 ;;    ((#:x) (x%))
    864 ;;    ((#:y) (y%))
    865 ;;    ((#:w) (w%))
    866 ;;    ((#:h) (h%))
    867 ;;    ((#:x! (x number?)) (x% x))
    868 ;;    ((#:y! (y number?)) (y% y))
    869 ;;    ((#:w! (w number?)) (w% w))
    870 ;;    ((#:h! (h number?)) (h% h))
    871 ;;    ((#:move! (dx number?) (dy number?))
    872 ;;     ;(x% (+ dx (#:x%)))
    873 ;;     ;(y% (+ dy (#:y%))))
    874 ;;     (let ((x (x%)) (y (y%)))
    875 ;;       (x% (+ dx x))
    876 ;;       (y% (+ dy y))
    877 ;;       (list x y)))
    878 ;;    ((#:scale! (r number?))
    879 ;;     ;(w% (* r (#:w%)))
    880 ;;     ;(h% (* r (#:h%))))
    881 ;;     (let ((w (w%)) (h (h%)))
    882 ;;       (w% (* r w))
    883 ;;       (h% (* r h))
    884 ;;       (list w h)))
    885 ;;    )
    886 ;;  )
    887 ;
    888 ;  (define-object-type Rect
    889 ;    (state ((x% (cell-of? number?))
    890 ;            (y% (cell-of? number?))
    891 ;            (w% (cell-of? number?))
    892 ;            (h% (cell-of? number?)))
    893 ;      #t)
    894 ;    ((#:x) (x%))
    895 ;    ((#:y) (y%))
    896 ;    ((#:w) (w%))
    897 ;    ((#:h) (h%))
    898 ;    ((#:x! (x number?)) (x% x))
    899 ;    ((#:y! (y number?)) (y% y))
    900 ;    ((#:w! (w number?)) (w% w))
    901 ;    ((#:h! (h number?)) (h% h))
    902 ;    ((#:move! (dx number?) (dy number?))
    903 ;     ;(x% (+ dx (#:x%)))
    904 ;     ;(y% (+ dy (#:y%))))
    905 ;     (let ((x (x%)) (y (y%)))
    906 ;       (x% (+ dx x))
    907 ;       (y% (+ dy y))
    908 ;       (list x y)))
    909 ;    ((#:scale! (r number?))
    910 ;     ;(w% (* r (#:w%)))
    911 ;     ;(h% (* r (#:h%))))
    912 ;     (let ((w (w%)) (h (h%)))
    913 ;       (w% (* r w))
    914 ;       (h% (* r h))
    915 ;       (list w h)))
    916 ;    )
    917 ;(define rect (Rect-instance (cell 0) (cell 0) (cell 1) (cell 1)))
    918 ;
    919 ;(ppp rect
    920 ;     (rect)
    921 ;     (Rect-instance? rect)
    922 ;     Rect
    923 ;     (Rect)
    924 ;     (Rect #:x)
    925 ;     ((Rect #:x))
    926 ;     (rect ((Rect #:x)))
    927 ;     (rect ((Rect #:x!) 10))
    928 ;     (rect ((Rect #:x)))
    929 ;     (rect ((Rect #:invariant?)))
    930 ;     (rect ((Rect #:move!) 100 100))
    931 ;     (rect ((Rect #:x)))
    932 ;     (rect ((Rect #:y)))
    933 ;     (rect ((Rect #:scale!) 100))
    934 ;     (rect ((Rect #:w)))
    935 ;     (rect ((Rect #:h)))
    936 ;     )
    937 ;
    938 ;;;(pe '
    939 ;;;;  (define-object-type Square Rect
    940 ;;;;    (state ((parent Rect-instance?))
    941 ;;;;      (= (parent ((Rect #:w))) (parent ((Rect #:h)))))
    942 ;;;;    ((#:parent) parent)
    943 ;;;;    ((#:w! (w number?))
    944 ;;;;     ;(let ((old (parent ((Rect #:w)))))
    945 ;;;;       (parent ((Rect #:w!) w))
    946 ;;;;       (parent ((Rect #:h!) w))
    947 ;;;;     ;  old))
    948 ;;;;     )
    949 ;;;;    ((#:h! (h number?))
    950 ;;;;     ;(let ((old (parent ((Rect #:h)))))
    951 ;;;;       (parent ((Rect #:w!) h))
    952 ;;;;       (parent ((Rect #:h!) h))
    953 ;;;;     ;  old))
    954 ;;;;     )
    955 ;;;;    ((#:scale! (r number?))
    956 ;;;;     ;(let ((old-w (parent ((Rect #:w))))
    957 ;;;;     ;      (old-h (parent ((Rect #:h)))))
    958 ;;;;       (parent ((Rect #:scale!) r)))
    959 ;;;;    ))
    960 ;;;
    961 ;;;;(ppp square
    962 ;;;;     rect
    963 ;;;;     (square)
    964 ;;;;     (rect)
    965 ;;;;     (Rect-instance? rect)
    966 ;;;;     (Square-instance? square)
    967 ;;;;     (Rect-instance? square)
    968 ;;;;     (Square-instance? rect)
    969 ;;;;     (square ((Square #:invariant?)))
    970 ;;;;     (square ((Square #:w!) 5))
    971 ;;;;     (square ((Square #:w)))
    972 ;;;;     (square ((Square #:h)))
    973 ;;;;     (square ((Square #:scale!) 10))
    974 ;;;;     (square ((Square #:w)))
    975 ;;;;     (square ((Square #:h)))
    976 ;;;;     (square ((Square #:x)))
    977 ;;;;     (square ((Square #:y)))
    978 ;;;;     (square ((Square #:move!) 2 2))
    979 ;;;;     (square ((Square #:x)))
    980 ;;;;     (square ((Square #:y)))
    981 ;;;;     (Rect)
    982 ;;;;     (Square)
    983 ;;;;     (Rect-instance? (square ((Square #:parent))))
    984 ;;;;     ((Rect #:?) ((Square #:x)))     ; #t: x not overridden
    985 ;;;;     ((Rect #:?) ((Square #:x!) 5))  ; #t: x! not overridden
    986 ;;;;     ((Rect #:?) ((Square #:w)))     ; #t: w not overridden
    987 ;;;;     ((Rect #:?) ((Square #:w!) 5))  ; #f: w! overridden
    988 ;;;;     (rect ((Square #:x)))           ; #t: x not overridden
    989 ;;;;     (rect ((Rect #:x)))
    990 ;;;;     (square ((Square #:invariant?)))
    991 ;;;;     )
    992 ;;;
  • release/5/messages/trunk/tests/run.scm

    r37291 r37329  
    1 (import functional-vectors messages bindings (chicken keyword) checks simple-cells simple-tests)
     1(import functional-vectors messages simple-cells simple-tests)
    22
    33(print "\functional-vectors")
Note: See TracChangeset for help on using the changeset viewer.