(zilch lang ninja depfile): add depfile parser

Change-Id: I6a6a6964591c9cc4cd32dd15ab930d1675d9ca5d

lang/ninja/src/depfile.sld

@@ -0,0 +1,79 @@
+(define-library (zilch lang ninja depfile)
+ (import
+  (scheme base)
+  (srfi 128) (srfi 146))
+
+ (export
+  parse-depfile)
+
+ (begin
+  (define (parse-depfile bytes)
+   (define buf (make-bytevector 1024 0))
+   (define buf-i 0)
+   (define (reset) (define old-i buf-i) (set! buf-i 0) (bytevector-copy buf 0 old-i))
+   (define (ensure-space count)
+    (when (> (+ count buf-i) (bytevector-length buf))
+      (let ((new-buf (make-bytevector (max (* 2 (bytevector-length buf)) (+ count buf-i)) 0)))
+        (bytevector-copy! new-buf 0 buf 0 buf-i)
+        (set! buf new-buf))))
+   (define (do-append start end)
+    (unless (= start end)
+     (ensure-space (- end start))
+     (bytevector-copy! buf buf-i bytes start end)
+     (set! buf-i (+ buf-i (- end start)))))
+   (define (skip-whitespace index)
+    (define val (if (>= index (bytevector-length bytes)) #f (bytevector-u8-ref bytes index)))
+    (cond
+     ((= val #x20)
+      (skip-whitespace (+ index 1)))
+     ((= val #x5C)
+      (if (and (< (+ index 2) (bytevector-length bytes)) (= (bytevector-u8-ref bytes (+ index 1)) #x0D))
+       (skip-whitespace (+ index 2))
+       (values index 'space)))
+     (else (values index 'space))))
+   (define (read-bytes index last)
+    (define val (if (>= index (bytevector-length bytes)) #f (bytevector-u8-ref bytes index)))
+    (cond
+     ((not val) (values (+ index 1) 'eof))
+     ((= val #x5C)
+      (do-append last index)
+      (unless (or (> (+ index 1) (bytevector-length bytes)))
+       (unless (or (= (bytevector-u8-ref bytes (+ index 1)) #x0A) (= (bytevector-u8-ref bytes (+ index 1)) #x0D))
+        (do-append (+ index 1) (+ index 2))))
+      (read-bytes (+ index 2) (+ index 2)))
+     ((= val #x20)
+      (do-append last index)
+      (skip-whitespace (+ 1 index)))
+     ((or (= val #x0A) (= val #x0D))
+      (do-append last index)
+      (values (+ index 1) 'newline))
+     (else (read-bytes (+ 1 index) last))))
+
+   (define out (mapping (make-default-comparator)))
+   (define (tick-line index)
+     (define-values (next-index reason) (read-bytes index index))
+     (define path (reset))
+     (unless (or (= (bytevector-length path) 0) (= (bytevector-u8-ref path (- (bytevector-length path) 1)) #x3A))
+       (error "Expected depfile line's first path to end with a colon"))
+     (set! path (if (> (bytevector-length path) 1) (utf8->string path 0 (- (bytevector-length path) 1)) ""))
+     (define deps '())
+     (define (tick-dep index)
+      (define-values (next-dep-index dep-reason) (read-bytes index index))
+      (define dep-path (reset))
+      (if (= (bytevector-length dep-path) 0)
+       (tick-dep next-dep-index)
+       (begin
+        (when (or (= (bytevector-length dep-path) 0) (= (bytevector-u8-ref dep-path (- (bytevector-length dep-path) 1)) #x3A))
+          (error "Depfile path ends with colon, but isn't the first entry in the list"))
+        (set! deps (cons (utf8->string dep-path) deps))
+        (if (eq? dep-reason 'space)
+          (tick-dep next-dep-index)
+          next-dep-index))))
+     (when (eq? reason 'space)
+      (set! next-index (tick-dep next-index)))
+     (unless (string=? path "")
+      (set! out (mapping-set! out path deps)))
+     (unless (eq? reason 'eof)
+      (tick-line next-index)))
+   (tick-line 0)
+   out)))

lang/ninja/zilch-lang-ninja.egg

@@ -7,6 +7,8 @@
  (components
   (extension zilch.lang.ninja
     (source "src/ninja.sld"))
+  (extension zilch.lang.ninja.depfile
+    (source "src/depfile.sld"))
   (extension zilch.lang.ninja.build
     (source "src/build.sld")
     (component-dependencies zilch.lang.ninja zilch.lang.ninja.config))