Added lexical syntax for immutable texts (ticket #788).

larcenists · Jul 26, 2017 · bbe33ff · bbe33ff
1 parent 57f30dc
commit bbe33ff
Show file tree

Hide file tree

Showing 6 changed files with 1,259 additions and 1,046 deletions.
diff --git a/src/Lib/Common/larceny.pg b/src/Lib/Common/larceny.pg
@@ -22,6 +22,7 @@ boolean
 number
 character
 string
+text
 lparen
 rparen
 lbracket
@@ -61,6 +62,7 @@ xstring
                   ::=  xfaslc                                   #makeCompnum
                   ::=  xfaslf                                   #makeFlonum
                   ::=  character                                #makeChar
+                  ::=  text                                     #makeText
                   ::=  string                                   #makeString
                   ::=  xstring                                  #makeXString
                   ::=  id                                       #makeSym
@@ -72,8 +74,6 @@ xstring
 <structured>      ::=  <list>                                   #identity
                   ::=  <vector>                                 #identity
                   ::=  <bytevector>                             #identity
-<string>          ::=  string                                   #makeString
-                  ::=  xstring                                  #makeXString
 <symbol>          ::=  id                                       #makeSym
 <list>            ::=  lparen <list2>                           #identity
                   ::=  lbracket <blst2>                         #identity

diff --git a/src/Lib/Common/larcenyTokens.sch b/src/Lib/Common/larcenyTokens.sch
@@ -47,16 +47,6 @@
      (lambda (c)
        (and (char? c)
             (char<=? c (integer->char 127)))))
-    (isAsciiNotVbar
-     (lambda (c)
-       (and (char? c)
-            (char<=? c (integer->char 127))
-            (not (char=? c #\|)))))
-    (isAsciiNotDoublequote
-     (lambda (c)
-       (and (char? c)
-            (char<=? c (integer->char 127))
-            (not (char=? c #\")))))
     (isNotNewline
      (lambda (c)
        (and (char? c)
@@ -70,6 +60,23 @@
        (and (char? c)
             (not (char=? c #\|))
             (not (char=? c #\\)))))
+    (isLeftDoubleAngleQuote
+     (lambda (c)
+       (and (char? c)
+            (char=? c (integer->char #x00ab)))))
+    (isRightDoubleAngleQuote
+     (lambda (c)
+       (and (char? c)
+            (char=? c (integer->char #x00bb)))))
+    (isNotRightDoubleAngleQuote
+     (lambda (c)
+       (and (char? c)
+            (not (char=? c (integer->char #x00bb))))))
+    (isNotDoublequote
+     (lambda (c)
+       (and (char? c)
+            (char<=? c (integer->char 127))
+            (not (char=? c #\")))))
     (isZsZlZp
      (lambda (c)
        (and (char? c) (char-whitespace? c))))
@@ -622,15 +629,32 @@
               (* (! (! #\linefeed #\return (#\return #\linefeed)
                        isNel (#\return isNel) isLS)
                     (#\\ (! #\a #\b #\t #\n #\v #\f #\r #\" #\\
+                            isLeftDoubleAngleQuote isRightDoubleAngleQuote
                             (! #\linefeed #\return (#\return #\linefeed)
                                isNel (#\return isNel) isLS)
                             #\space
                             (#\x (! %0..9 %a..f %A..F)
                                  (* (! %0..9 %a..f %A..F)))
                             isChar))                 ; anything can be escaped
-                    isChar))
+                    isNotDoubleQuote))
               #\"))
 
+     ; Same as string except for opening and closing quotes.
+
+     (text (isLeftDoubleAngleQuote
+            (* (! (! #\linefeed #\return (#\return #\linefeed)
+                     isNel (#\return isNel) isLS)
+                  (#\\ (! #\a #\b #\t #\n #\v #\f #\r #\" #\\
+                          isLeftDoubleAngleQuote isRightDoubleAngleQuote
+                          (! #\linefeed #\return (#\return #\linefeed)
+                             isNel (#\return isNel) isLS)
+                          #\space
+                          (#\x (! %0..9 %a..f %A..F)
+                               (* (! %0..9 %a..f %A..F)))
+                          isChar))                 ; anything can be escaped
+                  isNotRightDoubleAngleQuote))
+            isRightDoubleAngleQuote))
+
      ; #^B #^C #^F #^G #^P (used in .fasl files)
 
      (xfaslb (#\# isCtrlB))                                         ; #^B"..."

diff --git a/src/Lib/Common/print.sch b/src/Lib/Common/print.sch
@@ -99,6 +99,8 @@
     (let ((sv (char->integer c)))
       (or (<= 32 sv 126)
           (and (<= 128 sv)
+               (not (= sv #x00ab))    ; left double angle quote
+               (not (= sv #x00bb))    ; right double angle quote
                (not (memq (char-general-category c)
                           '(Zs Zl Zp Cc Cf Cs Co Cn)))))))