about summary refs log tree commit diff stats
diff options
context:
space:
mode:
-rw-r--r--.repl17
-rw-r--r--fff.parse.sld20
-rw-r--r--fff.parse.ss125
-rw-r--r--fff.read.sld15
-rw-r--r--fff.read.ss166
-rw-r--r--thoughts.md8
6 files changed, 351 insertions, 0 deletions
diff --git a/.repl b/.repl new file mode 100644 index 0000000..7d50383 --- /dev/null +++ b/.repl
@@ -0,0 +1,17 @@
1;;; -*- scheme -*-
2
3#+chicken (import (r7rs))
4
5(let loop ((load-files '("fff.parse"
6 "fff.read")))
7 (if (null? load-files)
8 #t
9 (let ((this (car load-files)))
10 (load (string-append (car load-files) ".sld"))
11 (eval `(import ,(map string->symbol (string-split this "."))))
12 (load (string-append (car load-files) ".ss"))
13 (loop (cdr load-files)))))
14
15(define input (call-with-input-file "test.fff" read-port))
16
17(print "Ready.")
diff --git a/fff.parse.sld b/fff.parse.sld new file mode 100644 index 0000000..1f9eac3 --- /dev/null +++ b/fff.parse.sld
@@ -0,0 +1,20 @@
1;;; (fff parse) --- parse fff format
2;; (C) Case Duckworth <acdw@acdw.net>
3
4#+chicken (import (r7rs))
5
6(define-library (fff parse)
7 (export
8 ;; FFF objects
9 fff-val
10 fff-key
11 fff-ref
12 fff-comment
13 fff-item
14 fff-item*
15 fff-object
16 fff-document
17 ;; Parsing procedure
18 parse-fff)
19
20 (include "fff.parse.ss"))
diff --git a/fff.parse.ss b/fff.parse.ss new file mode 100644 index 0000000..0ff7806 --- /dev/null +++ b/fff.parse.ss
@@ -0,0 +1,125 @@
1;;; Syntax
2;; an fff document translates to a key-value object containing lists or other
3;; objects. Nesting objects are accomplished using references, which start with @.
4
5;; # comments start with '#' and go to the end of the line.
6;; fff-object::
7;; key: value
8;; key2: value2
9;; key3: @reference # a reference refers to another defined object
10;;
11;; # lists are similar to objects, just without keys
12;; fff-list::
13;; : item1
14;; : item2
15;; : item3
16;;
17;; name: something # this is okay too
18
19(import (scheme base)
20 (scheme case-lambda)
21 (utf8)
22 (comparse)
23 (srfi 14))
24
25(define anything
26 (in char-set:full))
27
28(define nl+ws
29 (sequence* ((_ (is #\newline))
30 (_ ws*))
31 (result " ")))
32
33(define end
34 (any-of nl+ws
35 end-of-input))
36
37(define end*
38 (any-of (one-or-more nl+ws)
39 end-of-input))
40
41(define (escaped parser)
42 (preceded-by (is #\\) parser))
43
44(define (unescaped parser)
45 (none-of* (escaped parser)
46 parser))
47
48(define ws
49 (in char-set:blank))
50
51(define ws*
52 (zero-or-more ws))
53
54(define nonl
55 (in (char-set-delete char-set:full #\newline)))
56
57(define fff-val
58 (sequence* ((@? (maybe (escaped (is #\@))))
59 (v (as-string
60 (zero-or-more
61 (any-of (escaped nl+ws)
62 (none-of* nl+ws item))))))
63 (result (if @?
64 (string-append "@" v)
65 v))))
66
67(define fff-key
68 (as-string
69 (one-or-more
70 (all-of (any-of (escaped (is #\:))
71 (escaped nl+ws)
72 (none-of* (is #\:) nl+ws item))))))
73
74(define fff-ref
75 (sequence* ((_ (unescaped (is #\@)))
76 (k fff-key))
77 (result (cons 'ref k))))
78
79(define fff-comment
80 (sequence* ((_ (one-or-more (is #\#)))
81 (_ ws*)
82 (c (as-string (zero-or-more nonl)))
83 (_ end*))
84 (result (cons 'comment c))))
85
86(define fff-comment+
87 (bind (one-or-more fff-comment)
88 (lambda (xs)
89 (result (cons 'comment (map cdr xs))))))
90
91(define fff-item
92 (sequence* ((k (maybe fff-key))
93 (_ ws*)
94 (_ (is #\:))
95 (_ ws*)
96 (v (any-of fff-ref fff-val))
97 (_ end))
98 (result (cons k v))))
99
100(define fff-item*
101 (sequence* ((k fff-key)
102 (_ ws*)
103 (_ (is #\:))
104 (_ ws*)
105 (v (any-of fff-ref fff-val))
106 (_ end*))
107 (result (cons k v))))
108
109(define fff-object
110 (sequence* ((name fff-key)
111 (_ ws*)
112 (_ (sequence (is #\:) (is #\:) (is #\newline)))
113 (contents (one-or-more
114 (any-of fff-comment+
115 fff-item)))
116 (_ end*))
117 (result (cons name contents))))
118
119(define fff-document
120 (zero-or-more (any-of fff-comment+
121 fff-object
122 fff-item*)))
123
124(define (parse-fff x)
125 (parse fff-document x))
diff --git a/fff.read.sld b/fff.read.sld new file mode 100644 index 0000000..a5c5dad --- /dev/null +++ b/fff.read.sld
@@ -0,0 +1,15 @@
1;;; (fff read)
2
3#+chicken (import (r7rs))
4
5(define-library (fff read)
6 (export
7 ;; Parameters
8 chunk-size
9 ignore-comments?
10 base-environment
11 ;; Reading
12 read-fff
13 read-fff-string)
14
15 (include "fff.read.ss"))
diff --git a/fff.read.ss b/fff.read.ss new file mode 100644 index 0000000..fa1aec2 --- /dev/null +++ b/fff.read.ss
@@ -0,0 +1,166 @@
1;;; (fff read) --- read an fff file into a scheme structure
2;; (C) Case Duckworth <acdw@acdw.net>
3
4(import (scheme base)
5 (scheme case-lambda)
6
7 (fff parse)
8
9 (srfi 1)
10 (utf8))
11
12;;; Parameters
13
14(define chunk-size
15 (make-parameter 2048))
16
17(define ignore-comments?
18 (make-parameter #t))
19
20(define base-environment
21 (make-parameter '(("true" . #t)
22 ("false" . #f)
23 ("null" . null))))
24
25;;; Transforming parsed intermediate representation into fff
26
27(define (comment? it)
28 (eq? 'comment (car it)))
29
30(define (singleton it)
31 (if (pair? it)
32 (if (not (pair? (cdr it)))
33 #t
34 (and (eq? 'ref (cadr it))
35 (not (pair? (cddr it)))
36 'ref))
37 #f))
38
39(define (resolve-ref obj env)
40 (let ((ref (cddr obj)))
41 (if (assoc ref env)
42 (cons (car obj)
43 (cdr (assoc ref env)))
44 (error "Reference doesn't exist: " ref env))))
45
46(define (resolve-refs obj env)
47 ;;; Resolve references in OBJ using ENV.
48 (let loop ((items (cdr obj))
49 (new-obj (list (car obj)))
50 (resolved-refs '()))
51 (if (null? items)
52 (values (reverse new-obj)
53 resolved-refs)
54
55 (let ((this (car items)))
56 (if (and (pair? (cdr this))
57 (eq? 'ref (cadr this)))
58 (loop (cdr items)
59 (cons (resolve-ref this env) new-obj)
60 (cons (cddr this) resolved-refs))
61 (loop (cdr items)
62 (cons this new-obj)
63 resolved-refs))))))
64
65(define (maybe-vector obj)
66 (let loop ((items (cdr obj))
67 (type #f))
68 (cond
69 ((comment? obj)
70 (cons 'comment
71 (apply string-append
72 (map (lambda (s)
73 (string-append s "\n"))
74 (cdr obj)))))
75 ((and (null? items)
76 (eq? type 'object))
77 obj)
78 ((and (null? items)
79 (eq? type 'vector))
80 (cons (car obj)
81 (list->vector (map cdr (cdr obj)))))
82 ((not (pair? items))
83 obj)
84 (else
85 (loop (cdr items)
86 (if (caar items)
87 (if (eq? type 'vector)
88 (error "Item type mismatch" 'object type)
89 'object)
90 (if (eq? type 'object)
91 (error "Item type mismatch" 'vector type)
92 'vector)))))))
93
94(define (%fff->scm fff env acc dupes)
95 (if (null? fff)
96 (map maybe-vector
97 (reverse
98 (filter
99 (lambda (x) (not (member (car x) dupes)))
100 acc)))
101 (let ((this (car fff))
102 (rest (cdr fff)))
103 (cond
104 ((comment? this)
105 (if (ignore-comments?)
106 (%fff->scm (cdr fff) env acc dupes)
107 (%fff->scm rest env (cons this acc) dupes)))
108 ((singleton this) =>
109 (lambda (x)
110 (%fff->scm rest
111 (cons this env)
112 (cons (if (eq? 'ref x)
113 (resolve-ref this (append env fff))
114 this)
115 acc)
116 (if (eq? 'ref x)
117 (cons (cddr this) dupes)
118 dupes))))
119 (else
120 (let-values (((resolved references)
121 (resolve-refs this (append env fff))))
122 (%fff->scm rest
123 (cons this env)
124 (cons resolved acc)
125 (append references dupes))))))))
126
127(define fff->scm
128 (case-lambda
129 ((fff)
130 (%fff->scm fff (base-environment) '() '()))
131 ((fff env)
132 (%fff->scm fff env '() '()))))
133
134;;; Reading fff
135
136(define (read-port port)
137 (let loop ((next (read-string (chunk-size) port))
138 (blank? #f)
139 (acc '()))
140 (cond
141 ((or (eof-object? next)
142 (and blank? (equal? next "")))
143 (close-input-port port)
144 (apply string-append (reverse acc)))
145 ((equal? next "")
146 (loop (read-string (chunk-size) port)
147 #t
148 (cons next acc)))
149 (else
150 (loop (read-string (chunk-size) port)
151 blank?
152 (cons next acc))))))
153
154(define (%read-fff port)
155 (or (fff->scm (parse-fff (read-port port)))
156 (error "Invalid fff" port)))
157
158(define read-fff
159 (case-lambda
160 (()
161 (%read-fff (current-input-port)))
162 ((port)
163 (%read-fff port))))
164
165(define (read-fff-string str)
166 (call-with-port (open-input-string str) %read-fff))
diff --git a/thoughts.md b/thoughts.md new file mode 100644 index 0000000..b769352 --- /dev/null +++ b/thoughts.md
@@ -0,0 +1,8 @@
1# Thoughts
2
3## Files
4
5- (fff read)
6- (fff parse)
7- (fff json)
8- (fff write) <!-- do i want this though? hm -->