Here a patch to be applied atop of the one introducing parameters for
global.
--- kernel.scm.orig 2013-11-17 15:00:41.000000000 +0100
+++ kernel.scm 2013-11-17 15:01:19.000000000 +0100
@@ -440,6 +440,9 @@
(define (type-of x) #f)
(define (type? x) #f)
+ (define (string->keyword s)
+ (symbol->keyword (string->symbol s)))
+
)
; -----------------------------------------------------------------------------
; R5RS Compatibility
@@ -584,6 +587,12 @@
; If #t, return |...| symbols as-is, including the vertical bars.
(define literal-barred-symbol (make-parameter #f))
+ ; Case #f: no keywords case 'prefix keywords start with colon, case
+ ; 'suffix keywords end in colon, case 'hash keywords start with #:
+ ;; The latter is not yet implemented except for guile.
+
+ (define keyword-syntax (make-parameter #f))
+
; Returns a true value (not necessarily #t)
(define (char-line-ending? char) (memv char line-ending-chars))
@@ -712,6 +721,12 @@
(is-foldcase #t) #t)
((eq? mode 'no-fold-case)
(is-foldcase #f) #t)
+ ((eq? mode 'keyword-style-hash)
+ (keyword-syntax 'hash))
+ ((eq? mode 'keyword-style-prefix)
+ (keyword-syntax 'prefix))
+ ((eq? mode 'keyword-style-suffix)
+ (keyword-syntax 'suffix))
(else (display "Warning: Unknown mode") #f)))
; -----------------------------------------------------------------------------
@@ -1315,10 +1330,21 @@
((char=? c #\| )
; Read |...| symbol (like Common Lisp and R7RS draft 9)
(get-barred-symbol port))
- (else ; Nothing else. Must be a symbol start.
- (string->symbol (fold-case-maybe port
- (list->string
- (read-until-delim port neoteric-delimiters)))))))))))
+ (else ; Nothing else. Must be a symbol or keyword start.
+ (let ((s (fold-case-maybe port (list->string (read-until-delim port neoteric-delimiters))))
+ (kws (keyword-syntax)))
+ (cond
+ ((or (eq? kws #f)
+ (eq? kws 'hash)
+ (< (string-length s) 2))
+ (string->symbol s))
+ ((and (eq? kws 'prefix)
+ (eq? (string-ref s 0) #\:))
+ (string->keyword (substring s 1 (string-length s))))
+ ((and (eq? kws 'suffix)
+ (eq? (string-ref s (sub1 (string-length s))) #\:))
+ (string->keyword (substring s 0 (sub1 (string-length s)))))
+ (else (string->symbol s)))))))))))
; -----------------------------------------------------------------------------
; Curly Infix
------------------------------------------------------------------------------
DreamFactory - Open Source REST & JSON Services for HTML5 & Native Apps
OAuth, Users, Roles, SQL, NoSQL, BLOB Storage and External API Access
Free app hosting. Or install the open source package on any LAMP server.
Sign up and see examples for AngularJS, jQuery, Sencha Touch and Native!
http://pubads.g.doubleclick.net/gampad/clk?id=63469471&iu=/4140/ostg.clktrk
_______________________________________________
Readable-discuss mailing list
Readable-discuss@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/readable-discuss
