parse / render

pitfall/pitfall/minimal-pdf-source.rkt

@@ -0,0 +1,22 @@
+#lang racket/base
+(require pitfall/struct pitfall/render)
+
+(define (io1)
+  (hasheq 'Pages "2 0 R" 'Type 'Catalog))
+
+(define (io2)
+  (hasheq 'Count 1 'Kids '("3 0 R") 'Type 'Pages 'MediaBox '(0 0 300 144)))
+
+(define (io3)
+  (hasheq 'Resources
+          (hasheq 'Font
+                  (hasheq 'F1 (hasheq 'Subtype 'Type1 'BaseFont 'Times-Roman
+                                      'Type 'Font)))
+          'Parent "2 0 R"
+          'Contents "4 0 R"
+          'Type 'Page))
+
+(define (io4)
+  ($stream (hasheq 'Length 55) #"  BT\n    /F1 18 Tf\n    0 0 Td\n    (Hello World) Tj\n  ET"))
+
+(display (cosexpr->string (list io1 io2 io3 io4)))

pitfall/pitfall/minimal-pdf.rkt

@@ -0,0 +1,46 @@
+#lang pitfall/parse
+%PDF-1.1
+%¥±ë
+
+1 0 obj
+  << /Type /Catalog
+     /Pages 2 0 R
+  >>
+endobj
+
+2 0 obj
+  << /Type /Pages
+     /Kids [3 0 R]
+     /Count 1
+     /MediaBox [0 0 300 144]
+  >>
+endobj
+
+3 0 obj
+  <<  /Type /Page
+      /Parent 2 0 R
+      /Resources
+       << /Font
+           << /F1
+               << /Type /Font
+                  /Subtype /Type1
+                  /BaseFont /Times-Roman
+               >>
+           >>
+       >>
+      /Contents 4 0 R
+  >>
+endobj
+
+4 0 obj
+  << /Length 55 >>
+stream
+  BT
+    /F1 18 Tf
+    0 0 Td
+    (Hello World) Tj
+  ET
+endstream
+endobj
+
+%%EOF

pitfall/pitfall/minimal.pdf

@@ -0,0 +1,58 @@
+%PDF-1.1
+%¥±ë
+
+1 0 obj
+  << /Type /Catalog
+     /Pages 2 0 R
+  >>
+endobj
+
+2 0 obj
+  << /Type /Pages
+     /Kids [3 0 R]
+     /Count 1
+     /MediaBox [0 0 300 144]
+  >>
+endobj
+
+3 0 obj
+  <<  /Type /Page
+      /Parent 2 0 R
+      /Resources
+       << /Font
+           << /F1
+               << /Type /Font
+                  /Subtype /Type1
+                  /BaseFont /Times-Roman
+               >>
+           >>
+       >>
+      /Contents 4 0 R
+  >>
+endobj
+
+4 0 obj
+  << /Length 55 >>
+stream
+  BT
+    /F1 18 Tf
+    0 0 Td
+    (Hello World) Tj
+  ET
+endstream
+endobj
+
+xref
+0 5
+0000000000 65535 f 
+0000000018 00000 n 
+0000000077 00000 n 
+0000000178 00000 n 
+0000000457 00000 n 
+trailer
+  <<  /Root 1 0 R
+      /Size 5
+  >>
+startxref
+565
+%%EOF

pitfall/pitfall/parse.rkt

@@ -1,5 +1,5 @@
 #lang at-exp br/quicklang
-(require "parser.rkt" "tokenizer.rkt" gregor racket/bytes)
+(require "parser.rkt" "tokenizer.rkt" "struct.rkt" gregor racket/bytes)
 (provide (matching-identifiers-out #rx"pf-" (all-defined-out)))
 
 (module+ test (require rackunit))
@@ -12,14 +12,15 @@
    #`(module pitfall-parse-mod pitfall/parse
        #,parse-tree)))
 
-(define-macro (my-mb PARSE-TREE)
-  #'(#%module-begin PARSE-TREE))
-(provide (rename-out [my-mb #%module-begin]))
+(define-macro (my-mb ARG ...)
+  #'(#%module-begin ARG ...))
+(provide (rename-out [my-mb #%module-begin])
+         require)
 
 (provide null)
 
-(define-macro (pf-program ARG ...)
-  #'(list ARG ...))
+(define-macro (pf-program COS-OBJECT ...)
+  #'(begin COS-OBJECT ...))
 
 (define (pf-name str)
   (let* ([str (string-trim str "/" #:right? #f)]
@@ -52,7 +53,7 @@
 
 (module+ test
   (check-equal? @pf-string{(Testing)} "Testing")
-   (check-equal? (pf-string @string-append{(Test\
+  (check-equal? (pf-string @string-append{(Test\
  ing)}) "Testing")
   (check-equal? @pf-string{(Test\)ing)} "Test)ing")
   (check-equal? @pf-string{(Test\ning)} "Test\ning")
@@ -66,22 +67,33 @@
 (define (pf-array . xs) xs)
 
 (define (pf-dict . args)
-  (apply hash args))
+  (apply hasheq args))
+
 
-(struct $stream (dict data) #:transparent)
 (define (pf-stream dict str)
   (define data (string->bytes/utf-8 str))
   (when (not (equal? (hash-ref dict 'Length) (bytes-length data)))
-    (raise-argument-error 'pf-stream (format "~a bytes of data" (hash-ref dict 'Length)) (format "~a = ~a" (bytes-length data) data)))
+    (raise-argument-error 'pf-stream
+                          (format "~a bytes of data" (hash-ref dict 'Length))
+                          (format "~a = ~v" (bytes-length data) data)))
   ($stream dict data))
 
-(define indirect-objects (make-hash))
-(provide indirect-objects)
-
-(define (pf-indirect-object obj-num generation-num thing)
-  (hash-set! indirect-objects (vector obj-num generation-num) thing))
-
-(define-macro (pf-indirect-object-ref (OBJ-NUM GENERATION-NUM "R"))
-  #'(hash-ref (report indirect-objects) (vector (string->number OBJ-NUM)
-                                       (string->number GENERATION-NUM))))
-  
+(define-macro (pf-indirect-object OBJ-NUM GEN-NUM THING)
+  (with-syntax ([IO-ID (prefix-id "io" #'OBJ-NUM)])
+    #'(begin
+        (define (IO-ID #:name [name #f])
+          (if name
+              (string-join (map ~a '(OBJ-NUM GEN-NUM R)) " ")
+              THING))
+        (provide IO-ID)
+        IO-ID)))
+
+(define-macro (pf-indirect-object-ref (OBJ-NUM GEN-NUM "R"))
+  (with-syntax ([IO-ID (prefix-id "io" #'OBJ-NUM)])
+    #'(string-join '(OBJ-NUM GEN-NUM "R") " ")))
+
+(define-macro (pf-version NUM)
+  (with-pattern ([VERSION-ID (prefix-id "" #'version #:context #'NUM)])
+                #'(begin
+                    (define VERSION-ID NUM)
+                    (provide version))))

pitfall/pitfall/parser.rkt

@@ -1,14 +1,15 @@
 #lang brag
 
-pf-program : pf-thing*
-@pf-thing : pf-null | CHAR | BOOLEAN | INT | REAL | pf-name | pf-string | pf-array | pf-dict | pf-stream | pf-indirect-object | pf-indirect-object-ref
+pf-program : pf-object*
+@pf-object : pf-null | CHAR | BOOLEAN | INT | REAL | pf-name | pf-string | pf-array | pf-dict | pf-stream | pf-indirect-object | pf-indirect-object-ref | pf-version
 @pf-null : NULL
 pf-name : NAME
-pf-string : STRING-TOK | /"<" HEX-DIGIT-PAIR+ /">"
-pf-array : /"[" pf-thing* /"]"
-pf-dict : /"<<" (pf-dict-key pf-dict-value)* /">>"
-@pf-dict-key : pf-thing
-@pf-dict-value : pf-thing
+pf-string : STRING-TOK | /"<" HEX-DIGIT-PAIR* /">"
+pf-array : /"[" pf-object* /"]"
+pf-dict : /"<" /"<" (pf-dict-key pf-dict-value)* /">" /">"
+@pf-dict-key : pf-object
+@pf-dict-value : pf-object
 pf-stream : pf-dict STREAM-DATA
-pf-indirect-object : INT INT /"obj" pf-thing /"endobj"
-pf-indirect-object-ref : INDIRECT-OBJECT-REF-TOK
+pf-indirect-object : INT INT /"obj" pf-object /"endobj"
+pf-indirect-object-ref : INDIRECT-OBJECT-REF-TOK
+pf-version : PDF-VERSION

pitfall/pitfall/render.rkt

@@ -0,0 +1,22 @@
+#lang racket/base
+(require racket/string pitfall/struct)
+(provide (all-defined-out))
+
+(define (cosexpr->string x)
+  (define str
+    (let loop ([x x])
+      (cond
+        [(list? x) (string-append "[" (string-join (map loop x) " ") "]")]
+        [(procedure? x) (string-join (list (string-append (x #:name #t) " obj") (loop (x)) "endobj\n\n") "\n")]
+        [(string? x) x]
+        [(hash? x) (string-append
+                    "\n<< "
+                    (string-join
+                     (for/list ([(k v) (in-hash x)])
+                               (string-join (list (loop k) (loop v)) " ")) " ")
+                    " >> ")]
+        [(symbol? x) (format "/~a" x)]
+        [(number? x) (number->string x)]
+        [($stream? x) (string-append (loop ($stream-dict x)) (string-join (list "\nstream" (format "~a" ($stream-data x)) "endstream") "\n"))]
+        [else x])))
+  (string-join (list "%%PDF1.1" str "%%EOF") "\n"))

pitfall/pitfall/struct.rkt

@@ -0,0 +1,3 @@
+#lang racket/base
+(provide (struct-out $stream))
+(struct $stream (dict data) #:transparent)

pitfall/pitfall/tokenizer.rkt

@@ -21,9 +21,10 @@
   (define lex-one-token
     (lexer-srcloc
      [(eof) eof]
+     [(:seq "%%EOF" any-string) eof]
      [(:seq digits (:+ pdf-whitespace) digits (:+ pdf-whitespace) "R")
-      (begin (println (string-split lexeme))
-      (token 'INDIRECT-OBJECT-REF-TOK (string-split lexeme)))]
+      (token 'INDIRECT-OBJECT-REF-TOK (string-split lexeme))]
+     [(:seq "%PDF-" digits "." digits) (token 'PDF-VERSION (string->number (trim-ends "%PDF-" lexeme "")))]
      [(:or pdf-whitespace
            (from/stop-before "%" #\newline)) (token 'IGNORE lexeme #:skip? #t)]
      [(:or "true" "false") (token 'BOOLEAN (equal? lexeme "true"))]
@@ -35,8 +36,8 @@
      ["null" (token 'NULL 'null)]
      [(:seq "(" (:* (:or not-right-paren substring)) ")") (token 'STRING-TOK lexeme)]
      [(:seq hex-digit hex-digit) (token 'HEX-DIGIT-PAIR (string->number lexeme 16))]
-     [(:or "<" ">" "<<" ">>" "[" "]" "obj" "endobj") (token lexeme lexeme)]
-     [(from/to "stream" "endstream") (token 'STREAM-DATA (string-trim (trim-ends "stream" lexeme "endstream")))]
+     [(:or "<" ">" "[" "]" "obj" "endobj") (token lexeme lexeme)]
+     [(from/to "stream" "endstream") (token 'STREAM-DATA (string-trim (trim-ends "stream" lexeme "endstream") "\n"))]
      [any-char (token 'CHAR lexeme)]))
   (λ () (lex-one-token port)))