arrays and dicts

pitfall/pitfall/parse.rkt

@@ -1,7 +1,9 @@
-#lang br/quicklang
-(require "parser.rkt" "tokenizer.rkt")
+#lang at-exp br/quicklang
+(require "parser.rkt" "tokenizer.rkt" gregor)
 (provide (matching-identifiers-out #rx"pf-" (all-defined-out)))
 
+(module+ test (require rackunit))
+
 (module+ reader (provide read-syntax))
 
 (define (read-syntax src port)
@@ -21,7 +23,36 @@
 
 (define (pf-name str)
   (let* ([str (string-trim str "/" #:right? #f)]
-         [str (regexp-replace* #px"#(\\d\\d)" str (λ (m sub) (string (integer->char (string->number sub 16)))))])
+         [str (regexp-replace* @pregexp{#(\d\d)} str (λ (m sub) (string (integer->char (string->number sub 16)))))])
          (string->symbol str)))
 
-(pf-name "B#45#20L")
+(module+ test
+  (check-equal? (pf-name "B#45#20NICE") '|BE NICE|))
+
+(define (pf-string arg . tail)
+  (cond
+    [(andmap byte? (cons arg tail)) (cons arg tail)]
+    [(string-prefix? arg "D:")
+     #;(parameterize ([current-locale "en"])
+    (parse-date "2015-03-15T02:02:02-04:00" "yyyy-MM-dd'T'HH:mm:ssxxx"))
+     #f]     
+    [else
+     (let* ([str (regexp-replace @regexp{^\((.*)\)$} arg "\\1")]
+            [str (regexp-replace* @pregexp{\\(\\|\))} str "\\1")]
+           [str (regexp-replace* @pregexp{\\(\d\d\d)} str (λ (m sub) (string (integer->char (string->number sub)))))])
+       str)]))
+
+(module+ test
+  (check-equal? (pf-string "(Testing)") "Testing")
+  (check-equal? (pf-string "(Test\\)ing)") "Test)ing")
+  (check-equal? (pf-string "(Test\\\\ing)") "Test\\ing")
+  (check-equal? (pf-string "(A\\043B)") "A+B")
+  #;(check-equal? (pf-string "(D:19990209153925-08\'00\')") )
+  #;(check-true (andmap byte? (pf-string "<1C2D3F>")))
+  #;(check-true (andmap byte? (pf-string "<1C 2D 3F>"))))
+
+(define (pf-array . xs) xs)
+
+(define (pf-dict . args)
+  (apply hash args))
+      

pitfall/pitfall/parser.rkt

@@ -1,4 +1,10 @@
 #lang brag
 
-pf-program : (NULL | CHAR | BOOLEAN | INT | REAL | pf-name)*
-pf-name : NAME
+pf-program : pf-thing*
+@pf-thing : NULL | CHAR | BOOLEAN | INT | REAL | pf-name | pf-string | pf-array | pf-dict
+pf-name : NAME
+pf-string : PAREN-TOK | /LEFT-ANGLE HEX-DIGIT-PAIR+ /RIGHT-ANGLE
+pf-array : /LEFT-BRACKET pf-thing* /RIGHT-BRACKET
+pf-dict : /DOUBLE-LEFT-ANGLE (pf-dict-key pf-dict-value)* /DOUBLE-RIGHT-ANGLE
+@pf-dict-key : pf-thing
+@pf-dict-value : pf-thing

pitfall/pitfall/test.rkt

@@ -2,4 +2,32 @@
 
 null
 true
-false
+false
+1
+-2
++100
+612
+0.05
+.25
+-3.14159
+300.9001
+/Type
+/ThisIsName37
+/Lime#20Green
+/SSCN_SomeSecondClassName
+(Testing)
+(A\053B)
+%(D:19990209153925-08'00')
+<1C2D3F>
+<1C 2D 3F>
+[0 0 612 792]
+[(T) -20.5 (H) 4 (E)]
+[[1 2 3][4 5 6]]
+% a more human-readable dictionary
+<<
+  /Type /Page
+  /Author (Leonard Rosenthol)
+  /Resources << /Font [ /F1 /F2 ] >>
+>>
+% stripped
+<</Length 3112/Subtype/XML/Type/Metadata>>

pitfall/pitfall/tokenizer.rkt

@@ -7,6 +7,7 @@
 (define-lex-abbrev digits (:+ digit))
 (define-lex-abbrev sign (:? (:or "+" "-")))
 (define-lex-abbrev blackspace (:~ whitespace))
+(define-lex-abbrev ascii-char (char-set ascii))
 
 (define-lex-abbrev nonreg-char (:seq "#" hex-digit hex-digit))
 
@@ -16,15 +17,24 @@
   (define lex-once
     (lexer-srcloc
      [(eof) eof]
-     [whitespace
-      (token 'WHITESPACE lexeme #:skip? #t)]
+     [(:or whitespace
+       (from/stop-before "%" "\n"))
+      (token 'IGNORE lexeme #:skip? #t)]
      [(:or "true" "false") (token 'BOOLEAN (equal? lexeme "true"))]
      [(:seq sign digits) (token 'INT (string->number lexeme))]
      [(:seq sign (:or (:seq digits "." (:? digits))
                       (:seq "." digits)))
       (token 'REAL (string->number lexeme))]
-     [(:seq "/" (:+ (:or nonreg-char blackspace)))
+     [(:seq "/" (:+ (:or nonreg-char alphabetic "_" numeric)))
       (token 'NAME lexeme)]
       ["null" (token 'NULL 'null)]
+      [(from/to "(" ")") (token 'PAREN-TOK lexeme)]
+      [(:seq hex-digit hex-digit) (token 'HEX-DIGIT-PAIR (string->number lexeme 16))]
+      ["<" (token 'LEFT-ANGLE)]
+      [">" (token 'RIGHT-ANGLE)]
+      ["<<" (token 'DOUBLE-LEFT-ANGLE)]
+      [">>" (token 'DOUBLE-RIGHT-ANGLE)]
+      ["[" (token 'LEFT-BRACKET)]
+      ["]" (token 'RIGHT-BRACKET)]
       [any-char (token 'CHAR lexeme)]))
 (λ () (lex-once port)))