Changeset 34044 in project for release/4


Ignore:
Timestamp:
05/01/17 05:23:31 (3 years ago)
Author:
Ivan Raikov
Message:

internet-message: fix for letrec* bindings that result in an undefined values

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/internet-message/trunk/internet-message.scm

    r27578 r34044  
    55;;  Based on the Haskell Rfc2822 module by Peter Simons.
    66;;
    7 ;;  Copyright 2009-2012 Ivan Raikov and the Okinawa Institute of
    8 ;;  Science and Technology.
     7;;  Copyright 2009-2017 Ivan Raikov.
    98;;
    109;;
     
    12951294
    12961295(define (CoreABNF->InetMessage  A)
    1297   (letrec  (
    1298              ;; parsers for various header components
    1299              (*header        (header A))
    1300              (*fws           (fws A))
    1301              (*text          (text A))
    1302              (*quoted-pair   (quoted-pair A))
    1303              (*ctext         (ctext A))
    1304              (*ccontent      (vac ((ccontent A) *comment *ctext *quoted-pair)))
    1305              (*comment       ((comment A) *ccontent *fws))
    1306              (*cfws          ((cfws A) *comment *fws))
    1307 
    1308              (*ftext         (ftext A))
    1309              (*atext         (unicode-atext A))
    1310              (*atom          ((atom A) *atext *cfws))
    1311              (*dot-atom-text ((dot-atom-text A) *atext))
    1312              (*dot-atom      ((dot-atom A) *dot-atom-text *cfws))
    1313 
    1314              (*qtext         (qtext A))
    1315              (*qcontent      ((qcontent A) *qtext *quoted-pair))
    1316              (*quoted-string ((quoted-string A) *qcontent *fws *cfws))
    1317              (*word          ((word A) *atom *quoted-string))
    1318              (*phrase        ((phrase A) *word))
    1319              (*display-name  ((display-name A) *phrase))
    1320 
    1321              (*local-part     ((local-part A) *dot-atom *quoted-string))
    1322              (*dtext          (dtext A))
    1323              (*domain-literal ((domain-literal A) *dtext *cfws *fws))
    1324              (*domain         ((domain A) *dot-atom *domain-literal))
    1325 
    1326              (*addr-spec     ((addr-spec A) *local-part *domain))
    1327              (*angle-addr    ((angle-addr A) *addr-spec *cfws))
    1328              (*name-addr     ((name-addr A) *display-name *angle-addr))
    1329 
    1330              (*mailbox       ((mailbox  A) *name-addr *addr-spec))
    1331              (*mailbox-list  ((mailbox-list A) *mailbox))
    1332              (*group         (vac ((group A) *display-name *group-list *cfws)))
    1333              (*group-list    ((group-list A) *mailbox-list *cfws))
    1334              (*address       ((address A) *mailbox *group))
    1335              (*address-list  ((address-list A) *address))
    1336 
    1337              (*path          ((path A) *angle-addr *cfws))
    1338 
    1339              (*no-fold-literal  ((no-fold-literal A) *dtext))
    1340              (*id-left          (id-left *dot-atom-text))
    1341              (*id-right         (id-right *dot-atom-text *no-fold-literal))
    1342              (*msg-id           ((msg-id A) *id-left *id-right *cfws))
    1343 
    1344              (*unstructured     ((unstructured A) *fws))
    1345 
    1346              (*kwd-list         ((kwd-list A) *phrase))
    1347              
    1348              (*day-name         (day-name A))
    1349              (*day-of-week      ((day-of-week A) *day-name *fws))
    1350              (*year             ((year A) *fws))
    1351              (*month-name       (month-name A))
    1352              (*month            ((month A) *month-name *fws))
    1353              (*day              ((day A) *fws))
    1354              (*date             ((date A) *day *month *year ))
    1355              (*hour             (hour A))
    1356              (*minute           (minute A))
    1357              (*isecond          (isecond A))
    1358              (*time-of-day      ((time-of-day A) *hour *minute *isecond))
    1359              (*zone             ((zone A) *hour *minute *fws))
    1360              (*itime            ((itime  A) *time-of-day *zone))
    1361              (*date-time        ((date-time A) *day-of-week *date *itime *cfws))
    1362 
    1363              (*received-token   ((received-token A) *domain *angle-addr *addr-spec *word))
    1364              (*received-token-list ((received-token-list A) *received-token *date-time))
    1365              
    1366              (*field-name       ((field-name A) *ftext))
    1367              (*optional-field   ((optional-field A) *field-name *unstructured)))
     1296  (letrec*  (
     1297             ;; parsers for various header components
     1298             (*header        (header A))
     1299             (*fws           (fws A))
     1300             (*text          (text A))
     1301             (*quoted-pair   (quoted-pair A))
     1302             (*ctext         (ctext A))
     1303             (*ccontent      (vac ((ccontent A) *comment *ctext *quoted-pair)))
     1304             (*comment       ((comment A) *ccontent *fws))
     1305             (*cfws          ((cfws A) *comment *fws))
     1306             )
     1307   (let*
     1308          (
     1309           (*ftext         (ftext A))
     1310           (*atext         (unicode-atext A))
     1311           (*atom          ((atom A) *atext *cfws))
     1312           (*dot-atom-text ((dot-atom-text A) *atext))
     1313           (*dot-atom      ((dot-atom A) *dot-atom-text *cfws))
     1314
     1315           (*qtext         (qtext A))
     1316           (*qcontent      ((qcontent A) *qtext *quoted-pair))
     1317           (*quoted-string ((quoted-string A) *qcontent *fws *cfws))
     1318           (*word          ((word A) *atom *quoted-string))
     1319           (*phrase        ((phrase A) *word))
     1320           (*display-name  ((display-name A) *phrase))
     1321
     1322           (*local-part     ((local-part A) *dot-atom *quoted-string))
     1323           (*dtext          (dtext A))
     1324           (*domain-literal ((domain-literal A) *dtext *cfws *fws))
     1325           (*domain         ((domain A) *dot-atom *domain-literal))
     1326           
     1327           (*addr-spec     ((addr-spec A) *local-part *domain))
     1328           (*angle-addr    ((angle-addr A) *addr-spec *cfws))
     1329           (*name-addr     ((name-addr A) *display-name *angle-addr))
     1330
     1331           (*mailbox       ((mailbox  A) *name-addr *addr-spec))
     1332           (*mailbox-list  ((mailbox-list A) *mailbox))
     1333           )
     1334     (letrec* ((*group         (vac ((group A) *display-name *group-list *cfws)))
     1335               (*group-list    ((group-list A) *mailbox-list *cfws)))
     1336
     1337       (let* ((*address       ((address A) *mailbox *group))
     1338              (*address-list  ((address-list A) *address))
     1339             
     1340              (*path          ((path A) *angle-addr *cfws))
     1341             
     1342              (*no-fold-literal  ((no-fold-literal A) *dtext))
     1343              (*id-left          (id-left *dot-atom-text))
     1344              (*id-right         (id-right *dot-atom-text *no-fold-literal))
     1345              (*msg-id           ((msg-id A) *id-left *id-right *cfws))
     1346             
     1347              (*unstructured     ((unstructured A) *fws))
     1348             
     1349              (*kwd-list         ((kwd-list A) *phrase))
     1350             
     1351              (*day-name         (day-name A))
     1352              (*day-of-week      ((day-of-week A) *day-name *fws))
     1353              (*year             ((year A) *fws))
     1354              (*month-name       (month-name A))
     1355              (*month            ((month A) *month-name *fws))
     1356              (*day              ((day A) *fws))
     1357              (*date             ((date A) *day *month *year ))
     1358              (*hour             (hour A))
     1359              (*minute           (minute A))
     1360              (*isecond          (isecond A))
     1361              (*time-of-day      ((time-of-day A) *hour *minute *isecond))
     1362              (*zone             ((zone A) *hour *minute *fws))
     1363              (*itime            ((itime  A) *time-of-day *zone))
     1364              (*date-time        ((date-time A) *day-of-week *date *itime *cfws))
     1365             
     1366              (*received-token   ((received-token A) *domain *angle-addr *addr-spec *word))
     1367              (*received-token-list ((received-token-list A) *received-token *date-time))
     1368             
     1369              (*field-name       ((field-name A) *ftext))
     1370              (*optional-field   ((optional-field A) *field-name *unstructured)))
    13681371    (let* (
    13691372
     
    14211424                          *addr-spec *msg-id *header)
    14221425
    1423       )))
    1424 
     1426        ))
     1427       ))
     1428   ))
     1429 
    14251430 
    14261431;; RFC6532 Unicode extensions
Note: See TracChangeset for help on using the changeset viewer.