Changeset 28037 in project for release/4/honu/trunk/honu.scm


Ignore:
Timestamp:
01/05/13 22:12:13 (8 years ago)
Author:
felix winkelmann
Message:

extended signature to use keywords and allow flavors

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/honu/trunk/honu.scm

    r25847 r28037  
    99
    1010(define-constant +operator-chars+
    11   '(#\- #\+ #\/ #\? #\: #\* #\% #\& #\! #\. #\~ #\_ #\| #\> #\< #\= #\^ #\\ #\@) )
    12 
    13 (define (read-honu #!optional (port (current-input-port)) line-numbers lnwrap)
     11  '(#\- #\+ #\/ #\? #\: #\* #\% #\& #\! #\. #\~ #\_ #\| #\> #\< #\= #\^) )
     12
     13;; variant to keep old signature working
     14(define (read-honu . args)
     15  (apply
     16   (if (and (pair? args) (keyword? (car args)))
     17      read-honu-expression
     18      (lambda (#!optional (port (current-input-port)) ln lnw (flv 'vanilla-flavor))
     19        (read-honu-expression port: port line-numbers: ln lnwrap: lnw flavor: flv)))
     20   args))       
     21
     22(define (read-honu-expression #!key (port (current-input-port))
     23                              line-numbers
     24                              lnwrap
     25                              (flavor 'vanilla-flavor))
    1426  (let ((ln (nth-value 0 (port-position port))))
    1527    (define (lnw x)
     
    1931       error 'read-honu
    2032       (string-append msg (if line-numbers (conc " in line " ln) "")) args) )
    21     (define (opchar? c) (memq c +operator-chars+))
     33    (define opchar?
     34      (case flavor
     35        ((prolog-flavor)
     36         (lambda (c)
     37           (or (memq c +operator-chars+)
     38               (memq c '(#\@ #\\)))))
     39        (else (cut memq <> +operator-chars+))))
    2240    (define (skip)
    2341      (let ((c (peek-char port)))
     
    3048               (read-char port)
    3149               (skip) )
    32               ((char=? #\/ c)
     50              ((and (char=? #\% c)
     51                    (eq? flavor 'prolog-flavor))
     52               (skip-line))
     53              ((and (char=? #\/ c)
     54                    (not (eq? flavor 'prolog-flavor)))
    3355               (read-char port)
    3456               (let ((c (peek-char port)))
    3557                 (case c
    36                    ((#\/)
    37                     (read-line port)
    38                     (set! ln (fx+ ln 1))
    39                     (skip) )
     58                   ((#\/) (skip-line))
    4059                   ((#\*) (skip-comment) (skip))
    4160                   (else
     
    4564                        (lnw '/) ) ) ) ) )
    4665              (else #f) ) ) )
     66    (define (skip-line)
     67      (read-line port)
     68      (set! ln (fx+ ln 1))
     69      (skip))
    4770    (define (scan)
    4871      (or (skip)
     
    6689                            ((string=? "sx" t) (read port))
    6790                            (else (err "invalid escape syntax" (conc "#" t))) ) ) ) ) ) )
    68               ((#\') 
     91              ((#\')
    6992               (read-char port)
    7093               (let ((s (read-escaped (lambda (c) (char=? #\' c)))))
    71                  (if (zero? (string-length s))
    72                      (err "empty character literal")
    73                      (lnw (string-ref s 0) ) ) ) )
     94                 (case flavor
     95                   ((prolog-flavor) (lnw (string->symbol s)))
     96                   ((javascript-flavor) (lnw s))
     97                   (else
     98                    (if (zero? (string-length s))
     99                        (err "empty character literal")
     100                        (lnw (string-ref s 0) ) ) ) ) ) )
    74101              ((#\,) (read-char port) (lnw '|,|))
    75102              ((#\;) (read-char port) (lnw '|;|))
Note: See TracChangeset for help on using the changeset viewer.