source: project/release/4/dsssl-utils/trunk/typed-define.scm @ 34791

Last change on this file since 34791 was 34791, checked in by Kon Lovett, 4 years ago

no chicken here

File size: 1.9 KB
Line 
1;;;; typed-define.scm -*- Hen -*-
2;;;; Kon Lovett, Oct '17
3
4(module typed-define
5
6(;export
7  define:
8)
9
10(import scheme)
11
12;; typed scheme
13
14(define-syntax define:
15  (syntax-rules (-> -->)
16    ;
17    ;Pure
18    ;
19    ((_ (?name (?v ?t) ...) --> ?rt ?body ...)
20      (define:-procedure (?name (?v ?t) ...) --> ?rt ?body ...) )
21    ;
22    ((_ (?name . (?rest ?at)) --> ?rt ?body ...)
23      (define:-procedure (?name . (?rest ?at)) --> ?rt ?body ...) )
24    ;
25    ((_ (?name (?v ?t) ... (?vn ?tn) . (?rest ?at)) --> ?rt ?body ...)
26      (define:-procedure (?name (?v ?t) ... (?vn ?tn) . (?rest ?at)) --> ?rt ?body ...) )
27    ;
28    ;Impure
29    ;
30    ((_ (?name (?v ?t) ...) -> ?rt ?body ...)
31      (define:-procedure (?name (?v ?t) ...) -> ?rt ?body ...) )
32    ;
33    ((_ (?name . (?rest ?at)) -> ?rt ?body ...)
34      (define:-procedure (?name . (?rest ?at)) -> ?rt ?body ...) )
35    ;
36    ((_ (?name (?v ?t) ... (?vn ?tn) . (?rest ?at)) -> ?rt ?body ...)
37      (define:-procedure (?name (?v ?t) ... (?vn ?tn) . (?rest ?at)) -> ?rt ?body ...) )
38    ;
39    ;Impure Convenience
40    ;
41    ((_ (?name (?v ?t) ...) ?body ...)
42      (define: (?name (?v ?t) ...) -> void
43        ?body ...) )
44    ;
45    ((_ (?name (?v ?t) ... (?vn ?tn) . (?rest ?at)) ?body ...)
46      (define: (?name (?v ?t) ... (?vn ?tn) . (?rest ?at)) -> void
47        ?body ...) ) ) )
48
49;typed scheme support
50(define-syntax define:-procedure
51  (syntax-rules ()
52    ;
53    ;XXX
54    ;
55    ((_ (?name (?v ?t) ...) ?arrow ?rt ?body ...)
56      (begin
57        (: ?name (?t ... ?arrow ?rt))
58        (define (?name ?v ...)
59          ?body ... ) ) )
60    ;
61    ((_ (?name . (?rest ?at)) ?arrow ?rt ?body ...)
62      (begin
63        (: ?name (#!rest ?arrow ?rt))
64        (define (?name . ?rest)
65          ?body ... ) ) )
66    ;
67    ((_ (?name (?v ?t) ... (?vn ?tn) . (?rest ?at)) ?arrow ?rt ?body ...)
68      (begin
69        (: ?name (?t ... ?tn #!rest ?arrow ?rt))
70        (define (?name ?v ... ?vn . ?rest)
71          ?body ... ) ) ) ) )
72
73) ;module typed-define
Note: See TracBrowser for help on using the repository browser.