Changeset 14312 in project for chicken


Ignore:
Timestamp:
04/20/09 11:03:45 (11 years ago)
Author:
felix winkelmann
Message:

types for scheme module, some fixes

Location:
chicken/branches/scrutiny
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • chicken/branches/scrutiny/TODO

    r14280 r14312  
    112112*** document type-specifiers
    113113*** allow giving toplevel procedure names to `scrutinize' option?
     114*** line-numbers?
    114115
    115116
  • chicken/branches/scrutiny/scrutinizer.scm

    r14295 r14312  
    107107          ((eof-object? lit) 'eof)
    108108          ((vector? lit) 'vector)
    109           ((##sys#generic-structure? lit) `(struct ,(##sys#slot lit 0)))
     109          ((and (not (##sys#immediate? lit)) ##sys#generic-structure? lit)
     110           `(struct ,(##sys#slot lit 0)))
    110111          ((null? lit) 'null)
    111112          ((char? lit) 'char)
     
    197198                                   (list t))))
    198199                           (cdr t)))
    199                      (ts2 (let loop ((ts ts))
    200                             (cond ((null? ts) '())
    201                                   ((any (cut match (car ts) <>) (cdr ts))
    202                                    (loop (cdr ts)))
    203                                   (else (cons (car ts) (loop (cdr ts))))))))
    204                  (d "  or-simplify: ~a" ts2)
    205                  (simplify `(or ,@(if (any (cut eq? <> '*) ts2) '(*) ts2))))))
     200                      (ts2 (let loop ((ts ts))
     201                             (cond ((null? ts) '())
     202                                   ((any (cut match (car ts) <>) (cdr ts))
     203                                    (loop (cdr ts)))
     204                                   (else (cons (car ts) (loop (cdr ts))))))))
     205                 (cond ((equal? ts2 (cdr t)) t)
     206                       (else
     207                        (d "  or-simplify: ~a" ts2)
     208                        (simplify `(or ,@(if (any (cut eq? <> '*) ts2) '(*) ts2))))))))
    206209          ((procedure)
    207210           (let ((name (and (not (list? (cadr t))) (cadr t))))
     
    217220      m))
    218221  (define (match1 t1 t2)
    219     (or (eq? t1 t2)
    220         (eq? t1 '*)
    221         (eq? t2 '*)
    222         (and (eq? 'procedure t1) (and (pair? t2) (eq? 'procedure (car t2)))
    223              (eq? 'procedure t2) (and (pair? t1) (eq? 'procedure (car t1))) )
    224         (and (memq t1 '(pair list))
    225              (memq t2 '(pair list)))
    226         (and (memq t1 '(null list))
    227              (memq t2 '(null list)))
    228         (and (pair? t1) (pair? t2)
    229              (or (and (eq? (car t1) 'or)
    230                       (any (cut match <> t2)))
    231                  (and (eq? (car t2) 'or)
    232                       (any (cut match <> t2)))
    233                  (or (eq? (car t1) (car t2))
    234                      (and (eq? 'procedure (car t1))
    235                           (let ((args1 (if (pair? (second t1)) (second t1) (third t1)))
    236                                 (args2 (if (pair? (second t2)) (second t2) (third t2)))
    237                                 (results1 (if (pair? (second t2)) (cdddr t2) (cddr t2)))
    238                                 (results2 (if (pair? (second t2)) (cdddr t2) (cddr t2))) )
    239                             (and (match-args args1 args2)
    240                                  (= (length results1) (length results2))
    241                                  (every match results1 results2))))
    242                      (and (eq? 'struct (car t1))
    243                           (equal? t1 t2)))))))
     222    (cond ((eq? t1 t2))
     223          ((eq? t1 '*))
     224          ((eq? t2 '*))
     225          ((eq? 'procedure t1) (and (pair? t2) (eq? 'procedure (car t2))))
     226          ((eq? 'procedure t2) (and (pair? t1) (eq? 'procedure (car t1))))
     227          ((memq t1 '(pair list)) (memq t2 '(pair list)))
     228          ((memq t1 '(null list)) (memq t2 '(null list)))
     229          (else
     230           (and (pair? t1) (pair? t2)
     231             (cond ((and (eq? (car t1) 'or) (any (cut match <> t2)))
     232                   ((and (eq? (car t2) 'or) (any (cut match <> t2))))
     233                   (else
     234                    (or (eq? (car t1) (car t2))
     235                        (and (eq? 'procedure (car t1))
     236                             (let ((args1 (if (pair? (second t1)) (second t1) (third t1)))
     237                                   (args2 (if (pair? (second t2)) (second t2) (third t2)))
     238                                   (results1 (if (pair? (second t2)) (cdddr t2) (cddr t2)))
     239                                   (results2 (if (pair? (second t2)) (cdddr t2) (cddr t2))) )
     240                               (and (match-args args1 args2)
     241                                    (= (length results1) (length results2))
     242                                    (every match results1 results2))))
     243                        (and (eq? 'struct (car t1))
     244                             (equal? t1 t2))))))))))
    244245  (define (match-args args1 args2)
    245246    (d "match-args: ~s <-> ~s" args1 args2)
  • chicken/branches/scrutiny/types.db

    r14296 r14312  
    2929(not (procedure not (*) boolean))
    3030(boolean? (procedure boolean (*) boolean))
     31(eq? (procedure eq? (* *) boolean))
     32(eqv? (procedure eqv? (* *) boolean))
     33(equal? (procedure equal? (* *) boolean))
     34(pair? (procedure pair? (*) boolean))
     35(cons (procedure cons (* *) pair))
     36(car (procedure car (pair) *))
     37(cdr (procedure cdr (pair) *))
     38(caar (procedure caar (pair) *))
     39(cadr (procedure cadr (pair) *))
     40(cdar (procedure cdar (pair) *))
     41(cddr (procedure cddr (pair) *))
     42(caaar (procedure caaar (pair) *))
     43(caadr (procedure caadr (pair) *))
     44(cadar (procedure cadar (pair) *))
     45(caddr (procedure caddr (pair) *))
     46(cdaar (procedure cdaar (pair) *))
     47(cdadr (procedure cdadr (pair) *))
     48(cddar (procedure cddar (pair) *))
     49(cdddr (procedure cdddr (pair) *))
     50(caaaar (procedure caaaar (pair) *))
     51(caaadr (procedure caaadr (pair) *))
     52(caadar (procedure caadar (pair) *))
     53(caaddr (procedure caaddr (pair) *))
     54(cadaar (procedure cadaar (pair) *))
     55(cadadr (procedure cadadr (pair) *))
     56(caddar (procedure caddar (pair) *))
     57(cadddr (procedure cadddr (pair) *))
     58(cdaaar (procedure cdaaar (pair) *))
     59(cdaadr (procedure cdaadr (pair) *))
     60(cdadar (procedure cdadar (pair) *))
     61(cdaddr (procedure cdaddr (pair) *))
     62(cddaar (procedure cddaar (pair) *))
     63(cddadr (procedure cddadr (pair) *))
     64(cdddar (procedure cdddar (pair) *))
     65(cddddr (procedure cddddr (pair) *))
     66(set-car! (procedure set-car! (pair *) undefined))
     67(set-cdr! (procedure set-cdr! (pair *) undefined))
     68(null? (procedure null? (*) boolean))
     69(list? (procedure list? (*) boolean))
     70(list (procedure list (#!rest) list))
     71(length (procedure length (list) number))
     72(list-tail (procedure list-tail (list number) *))
     73(list-ref (procedure list-ref (list number) *))
     74(append (procedure append (list #!rest) list))
     75(reverse (procedure reverse (list) list))
     76(memq (procedure memq (* list) *))      ; result type: (or list boolean) ?
     77(memv (procedure memv (* list) *))
     78(member (procedure member (* list) *))
     79(assq (procedure assq (* list) *))
     80(assv (procedure assv (* list) *))
     81(assoc (procedure assoc (* list) *))
     82(symbol? (procedure symbol? (*) boolean))
     83(symbol->string (procedure symbol->string (symbol) string))
     84(string->symbol (procedure string->symbol (string) symbol))
     85(number? (procedure number? (*) boolean))
     86(integer? (procedure integer? (*) boolean))
     87(exact? (procedure exact? (*) boolean))
     88(real? (procedure real? (*) boolean))
     89(complex? (procedure complex? (*) boolean))
     90(inexact? (procedure inexact? (*) boolean))
     91(rational? (procedure rational? (*) boolean))
     92(zero? (procedure zero? (number) boolean))
     93(odd? (procedure odd? (number) boolean))
     94(even? (procedure even? (number) boolean))
     95(positive? (procedure positive? (number) boolean))
     96(negative? (procedure negative? (number) boolean))
     97(max (procedure max (#!rest number) number))
     98(min (procedure min (#!rest number) number))
     99(+ (procedure + (#!rest number) number))
     100(- (procedure - (number #!rest number) number))
     101(* (procedure * (#!rest number) number))
     102(/ (procedure / (number #!rest number) number))
     103(= (procedure = (#!rest number) boolean))
     104(> (procedure > (#!rest number) boolean))
     105(< (procedure < (#!rest number) boolean))
     106(>= (procedure >= (#!rest number) boolean))
     107(<= (procedure <= (#!rest number) boolean))
     108(quotient (procedure quotient (number number) number))
     109(remainder (procedure remainder (number number) number))
     110(modulo (procedure modulo (number number) number))
     111(gcd (procedure gcd (#!rest number) number))
     112(lcm (procedure lcm (#!rest number) number))
     113(abs (procedure abs (number) number))
     114(floor (procedure floor (number) number))
     115(ceiling (procedure ceiling (number) number))
     116(truncate (procedure truncate (number) number))
     117(round (procedure round (number) number))
     118(exact->inexact (procedure exact->inexact (number) number))
     119(inexact->exact (procedure inexact->exact (number) number))
     120(exp (procedure exp (number) number))
     121(log (procedure log (number) number))
     122(expt (procedure expt (number number) number))
     123(sqrt (procedure sqrt (number) number))
     124(sin (procedure sin (number) number))
     125(cos (procedure cos (number) number))
     126(tan (procedure tan (number) number))
     127(asin (procedure asin (number) number))
     128(acos (procedure acos (number) number))
     129(atan (procedure atan (number number) number))
     130(number->string (procedure number->string (number #!optional number) string))
     131(string->number (procedure string->number (string #!optional number) number))
     132(char? (procedure char? (*) boolean))
     133(char=? (procedure char=? (char char) boolean))
     134(char>? (procedure char>? (char char) boolean))
     135(char<? (procedure char<? (char char) boolean))
     136(char>=? (procedure char>=? (char char) boolean))
     137(char<=? (procedure char<=? (char char) boolean))
     138(char-ci=? (procedure char-ci=? (char char) boolean))
     139(char-ci<? (procedure char-ci<? (char char) boolean))
     140(char-ci>? (procedure char-ci>? (char char) boolean))
     141(char-ci>=? (procedure char-ci>=? (char char) boolean))
     142(char-ci<=? (procedure char-ci<=? (char char) boolean))
     143(char-alphabetic? (procedure char-alphabetic? (char) boolean))
     144(char-whitespace? (procedure char-whitespace? (char) boolean))
     145(char-numeric? (procedure char-numeric? (char) boolean))
     146(char-upper-case? (procedure char-upper-case? (char) boolean))
     147(char-lower-case? (procedure char-lower-case? (char) boolean))
     148(char-upcase (procedure char-upcase (char) char))
     149(char-downcase (procedure char-downcase (char) char))
     150(char->integer (procedure char->integer (char) number))
     151(integer->char (procedure integer->char (number) char))
     152(string? (procedure string? (*) boolean))
     153(string=? (procedure string=? (string string) boolean))
     154(string>? (procedure string>? (string string) boolean))
     155(string<? (procedure string<? (string string) boolean))
     156(string>=? (procedure string>=? (string string) boolean))
     157(string<=? (procedure string<=? (string string) boolean))
     158(string-ci=? (procedure string-ci=? (string string) boolean))
     159(string-ci<? (procedure string-ci<? (string string) boolean))
     160(string-ci>? (procedure string-ci>? (string string) boolean))
     161(string-ci>=? (procedure string-ci>=? (string string) boolean))
     162(string-ci<=? (procedure string-ci<=? (string string) boolean))
     163(make-string (procedure make-string (number #!optional char) string))
     164(string-length (procedure string-length (string) number))
     165(string-ref (procedure string-ref (string number) char))
     166(string-set! (procedure string-set! (string number char) undefined))
     167(string-append (procedure string-append (#!rest string) string))
     168(string-copy (procedure string-copy (string) string))
     169(string->list (procedure string->list (string) list))
     170(list->string (procedure list->string (list) string))
     171(substring (procedure substring (string number #!optional number) string))
     172(string-fill! (procedure string-fill! (string char) string))
     173(vector? (procedure vector? (*) boolean))
     174(make-vector (procedure make-vector (number #!optional *) vector))
     175(vector-ref (procedure vector-ref (vector number) *))
     176(vector-set! (procedure vector-set! (vector number *) undefined))
     177(string (procedure string (#!rest char) string))
     178(vector (procedure vector (#!rest) vector))
     179(vector-length (procedure vector-length (vector) number))
     180(vector->list (procedure vector->list (vector) list))
     181(list->vector (procedure list->vector (list) vector))
     182(vector-fill! (procedure vector-fill! (vector *) vector))
     183(procedure? (procedure procedure? (*) boolean))
     184(map (procedure map (procedure #!rest list) list))
     185(for-each (procedure for-each (procedure #!rest list) undefined))
     186(apply (procedure apply (procedure #!rest) . *))
     187(force (procedure force (*) *))
     188(call-with-current-continuation (procedure call-with-current-continuation (procedure) . *))
     189(input-port? (procedure input-port? (*) boolean))
     190(output-port? (procedure output-port? (*) boolean))
     191(current-input-port (procedure current-input-port (#!optional port) port))
     192(current-output-port (procedure current-output-port (#!optional port) port))
     193(call-with-input-file (procedure call-with-input-file (string procedure) . *))
     194(call-with-output-file (procedure call-with-output-file (string procedure) . *))
     195(open-input-file (procedure open-input-file (string) port))
     196(open-output-file (procedure open-output-file (string) port))
     197(close-input-port (procedure close-input-port (port) undefined))
     198(close-output-port (procedure close-output-port (port) undefined))
     199(load (procedure load (string #!optional procedure) undefined))
     200(read (procedure read (#!optional port) *))
     201(eof-object? (procedure eof-object? (*) boolean))
     202(read-char (procedure read-char (#!optional port) *)) ; result (or eof char) ?
     203(peek-char (procedure peek-char (#!optional port) *))
     204(write (procedure write (* #!optional port) undefined))
     205(display (procedure display (* #!optional port) undefined))
     206(write-char (procedure write-char (char #!optional port) undefined))
     207(newline (procedure newline (#!optional port) undefined))
     208(with-input-from-file (procedure with-input-from-file (string procedure) . *))
     209(with-output-to-file (procedure with-output-to-file (string procedure) . *))
     210(dynamic-wind (procedure dynamic-wind (procedure procedure procedure) . *))
     211(values (procedure values (#!rest) . *))
     212(call-with-values (procedure call-with-values (procedure procedure) . *))
     213(eval (procedure eval (*) *))
     214(char-ready? (procedure char-ready? (#!optional port) boolean))
     215(imag-part (procedure imag-part (number) number))
     216(real-part (procedure real-part (number) number))
     217(magnitude (procedure magnitude (number) number))
     218(numerator (procedure numerator (number) number))
     219(denominator (procedure denominator (number) number))
     220(scheme-report-environment (procedure scheme-report-environment (#!optional number) *))
     221(null-environment (procedure null-environment () *))
     222(interaction-environment (procedure interaction-environment () *))
    31223
    32224#!eof
    33 
    34 boolean?
    35 eq?
    36 eqv?
    37 equal?
    38 pair?
    39 cons
    40 car
    41 cdr
    42 caar
    43 cadr
    44 cdar
    45 cddr
    46 caaar
    47 caadr
    48 cadar
    49 caddr
    50 cdaar
    51 cdadr
    52 cddar
    53 cdddr
    54 caaaar
    55 caaadr
    56 caadar
    57 caaddr
    58 cadaar
    59 cadadr
    60 caddar
    61 cadddr
    62 cdaaar
    63 cdaadr
    64 cdadar
    65 cdaddr
    66 cddaar
    67 cddadr
    68 cdddar
    69 cddddr
    70 set-car!
    71 set-cdr!
    72 null?
    73 list?
    74 list
    75 length
    76 list-tail
    77 list-ref
    78 append
    79 reverse
    80 memq
    81 memv
    82 member
    83 assq
    84 assv
    85 assoc
    86 symbol?
    87 symbol->string
    88 string->symbol
    89 number?
    90 integer?
    91 exact?
    92 real?
    93 complex?
    94 inexact?
    95 rational?
    96 zero?
    97 odd?
    98 even?
    99 positive?
    100 negative?
    101 max
    102 min
    103 +
    104 -
    105 *
    106 /
    107 =
    108 >
    109 <
    110 >=
    111 <=
    112 quotient
    113 remainder
    114 modulo
    115 gcd
    116 lcm
    117 abs
    118 floor
    119 ceiling
    120 truncate
    121 round
    122 exact->inexact
    123 inexact->exact
    124 exp
    125 log
    126 expt
    127 sqrt
    128 sin
    129 cos
    130 tan
    131 asin
    132 acos
    133 atan
    134 number->string
    135 string->number
    136 char?
    137 char=?
    138 char>?
    139 char<?
    140 char>=?
    141 char<=?
    142 char-ci=?
    143 char-ci<?
    144 char-ci>?
    145 char-ci>=?
    146 char-ci<=?
    147 char-alphabetic?
    148 char-whitespace?
    149 char-numeric?
    150 char-upper-case?
    151 char-lower-case?
    152 char-upcase
    153 char-downcase
    154 char->integer
    155 integer->char
    156 string?
    157 string=?
    158 string>?
    159 string<?
    160 string>=?
    161 string<=?
    162 string-ci=?
    163 string-ci<?
    164 string-ci>?
    165 string-ci>=?
    166 string-ci<=?
    167 make-string
    168 string-length
    169 string-ref
    170 string-set!
    171 string-append
    172 string-copy
    173 string->list
    174 list->string
    175 substring
    176 string-fill!
    177 vector?
    178 make-vector
    179 vector-ref
    180 vector-set!
    181 string
    182 vector
    183 vector-length
    184 vector->list
    185 list->vector
    186 vector-fill!
    187 procedure?
    188 map
    189 for-each
    190 apply
    191 force
    192 call-with-current-continuation
    193 input-port?
    194 output-port?
    195 current-input-port
    196 current-output-port
    197 call-with-input-file
    198 call-with-output-file
    199 open-input-file
    200 open-output-file
    201 close-input-port
    202 close-output-port
    203 load
    204 read
    205 eof-object?
    206 read-char
    207 peek-char
    208 write
    209 display
    210 write-char
    211 newline
    212 with-input-from-file
    213 with-output-to-file
    214 dynamic-wind
    215 values
    216 call-with-values
    217 eval
    218 char-ready?
    219 imag-part
    220 real-part
    221 magnitude
    222 numerator
    223 denominator
    224 scheme-report-environment
    225 null-environment
    226 interaction-environment
    227225
    228226;; chicken
Note: See TracChangeset for help on using the changeset viewer.