1 files changed, 0 insertions, 183 deletions
diff --git a/fff-parse.scm b/fff-parse.scm
deleted file mode 100644
index 6e524ad..0000000
--- a/fff-parse.scm
+++ /dev/null

@@ -1,183 +0,0 @@
-(use-modules (ice-9 peg)
-             (ice-9 match))
-(define-peg-pattern fff all
-  (and (* (or WHITESPACE NEWLINE))
-       (* (or comment
-              object
-              array
-              item
-              blanks))
-       (* NEWLINE)
-       (not-followed-by peg-any)))
-(define-peg-pattern comment none
-  (and HASH (* WHITESPACE)
-       (* (and (not-followed-by NEWLINE)
-               peg-any))))
-(define-peg-pattern object all
-  (and name
-       (+ object-item)))
-(define-peg-pattern array all
-  (and name
-       (+ array-item)))
-(define-peg-pattern item all
-  object-item)
-(define-peg-pattern object-item body
-  (and key (* WHITESPACE)
-       COLON (* WHITESPACE)
-       (or ref val)))
-(define-peg-pattern array-item body
-  (and (* WHITESPACE)
-       COLON (* WHITESPACE)
-       (or ref val)))
-(define-peg-pattern name all
-  (and key COLON COLON (* WHITESPACE) NEWLINE))
-(define-peg-pattern key body
-  (+ (and (not-followed-by COLON)
-          nonl)))
-(define-peg-pattern val all
-  (and (* nonl)
-       NEWLINE))
-(define-peg-pattern ref all
-  (and AT key NEWLINE))
-(define-peg-pattern escaped body
-  (and BACKSLASH (or (and NEWLINE (* WHITESPACE))
-                     peg-any)))
-(define-peg-pattern blanks none
-  (+ NEWLINE))
-(define-peg-pattern nonl body
-  (or escaped
-      (and (not-followed-by NEWLINE)
-           peg-any)))
-(define-peg-pattern NEWLINE none
-  (or "\r\n" "\r" "\n"))
-(define-peg-pattern WHITESPACE none
-  (or " " "\t"))
-(define-peg-pattern BACKSLASH none "\\")
-(define-peg-pattern COLON none ":")
-(define-peg-pattern HASH none "#")
-(define-peg-pattern AT none "@")
-(define (ensure-nested-list x)
-  (if (list? (car x))
-      x
-      (list x)))
-(define (atom? x)
-  (and (not (null? x))
-       (not (pair? x))))
-(define (car-safe x)
-  (if (pair? x)
-      (car x)
-      #f))
-(define (fff? x)
-  (and (pair? x)
-       (eq? (car x) 'fff)))
-(define (fff->scm str)
-  (let ((tree (peg:tree (match-pattern fff str))))
-    (if (fff? tree)
-        (fff-ref-resolve (fff-tree->ref-tree tree))
-        #f)))
-(define (fff-tree->ref-tree tree)
-  (let loop ((xs (cdr tree))
-             (it '()))
-    (if (null? xs)
-        (reverse it)
-        (loop (cdr xs)
-              (match (car xs)
-                (`(object (name ,name) ,pairs)
-                 (cons (cons name
-                             (map fff-pair->scm
-                                  (ensure-nested-list pairs)))
-                       it))
-                (`(array (name ,name) ,values)
-                 (cons (cons name
-                             (list->vector (map fff-value->scm
-                                                (ensure-nested-list values))))
-                       it))
-                (`(item . ,pair)
-                 (cons (fff-pair->scm pair)
-                       it))
-                (_ it))))))
-(define* (fff-ref-resolve tree #:optional environment keep-dupes?)
-  (define dupes '())
-  (define env (append (or environment '())
-                      '(("true" . #t)
-                        ("false" . #f)
-                        ("null" . null))))
-  (filter (lambda (x)
-            (if keep-dupes?
-                #t
-                (not (member (or (car-safe x) x)
-                             dupes))))
-          (let loop ((xs tree)
-                     (v? #f)
-                     (it '()))
-            (if (null? xs)
-                ((if v? list->vector identity)
-                 (reverse it))
-                (begin
-                  (loop (cdr xs)
-                        v?
-                        (cons (let ((x (car xs)))
-                                (cond
-                                 ((atom? x)
-                                  (set! env (cons x env))
-                                  x)
-                                 ((procedure? (cdr x))
-                                  (set! dupes (cons (car x) dupes))
-                                  (let ((res
-                                         (cons (car x)
-                                               ((cdr x) (append env tree)))))
-                                    (set! env (cons res env))
-                                    res))
-                                 ((atom? (cdr x))
-                                  (set! env (cons x env))
-                                  x)
-                                 ((vector? (cdr x))
-                                  (let ((vl (vector->list (cdr x))))
-                                    (set! env (cons (fff-ref-resolve vl env #t)
-                                                    env))
-                                    (cons (car x)
-                                          (loop vl #t '()))))
-                                 (else   ; object
-                                  (set! env (cons (fff-ref-resolve x env #t)
-                                                  env))
-                                  (cons (car x) ; not tail-recursive!
-                                        (loop (cdr x) #f '())))))
-                              it)))))))
-(define (fff-pair->scm pair)
-  (cons (car pair) (fff-value->scm (cadr pair))))
-(define (fff-value->scm val)
-  (match val
-    (`(val ,v) v)
-    (`(ref ,r) (lambda (alist)
-                 (assoc-ref alist r)))))

diff --git a/fff-parse.scm b/fff-parse.scm deleted file mode 100644 index 6e524ad..0000000 --- a/fff-parse.scm +++ /dev/null
@@ -1,183 +0,0 @@
1	(use-modules (ice-9 peg)
2	(ice-9 match))
3
4	(define-peg-pattern fff all
5	(and (* (or WHITESPACE NEWLINE))
6	(* (or comment
7	object
8	array
9	item
10	blanks))
11	(* NEWLINE)
12	(not-followed-by peg-any)))
13
14	(define-peg-pattern comment none
15	(and HASH (* WHITESPACE)
16	(* (and (not-followed-by NEWLINE)
17	peg-any))))
18
19	(define-peg-pattern object all
20	(and name
21	(+ object-item)))
22
23	(define-peg-pattern array all
24	(and name
25	(+ array-item)))
26
27	(define-peg-pattern item all
28	object-item)
29
30	(define-peg-pattern object-item body
31	(and key (* WHITESPACE)
32	COLON (* WHITESPACE)
33	(or ref val)))
34
35	(define-peg-pattern array-item body
36	(and (* WHITESPACE)
37	COLON (* WHITESPACE)
38	(or ref val)))
39
40	(define-peg-pattern name all
41	(and key COLON COLON (* WHITESPACE) NEWLINE))
42
43	(define-peg-pattern key body
44	(+ (and (not-followed-by COLON)
45	nonl)))
46
47	(define-peg-pattern val all
48	(and (* nonl)
49	NEWLINE))
50
51	(define-peg-pattern ref all
52	(and AT key NEWLINE))
53
54	(define-peg-pattern escaped body
55	(and BACKSLASH (or (and NEWLINE (* WHITESPACE))
56	peg-any)))
57
58	(define-peg-pattern blanks none
59	(+ NEWLINE))
60
61	(define-peg-pattern nonl body
62	(or escaped
63	(and (not-followed-by NEWLINE)
64	peg-any)))
65
66	(define-peg-pattern NEWLINE none
67	(or "\r\n" "\r" "\n"))
68
69	(define-peg-pattern WHITESPACE none
70	(or " " "\t"))
71
72	(define-peg-pattern BACKSLASH none "\\")
73
74	(define-peg-pattern COLON none ":")
75
76	(define-peg-pattern HASH none "#")
77
78	(define-peg-pattern AT none "@")
79
80
81	(define (ensure-nested-list x)
82	(if (list? (car x))
83	x
84	(list x)))
85
86	(define (atom? x)
87	(and (not (null? x))
88	(not (pair? x))))
89
90	(define (car-safe x)
91	(if (pair? x)
92	(car x)
93	#f))
94
95
96	(define (fff? x)
97	(and (pair? x)
98	(eq? (car x) 'fff)))
99
100	(define (fff->scm str)
101	(let ((tree (peg:tree (match-pattern fff str))))
102	(if (fff? tree)
103	(fff-ref-resolve (fff-tree->ref-tree tree))
104	#f)))
105
106	(define (fff-tree->ref-tree tree)
107	(let loop ((xs (cdr tree))
108	(it '()))
109	(if (null? xs)
110	(reverse it)
111	(loop (cdr xs)
112	(match (car xs)
113	(`(object (name ,name) ,pairs)
114	(cons (cons name
115	(map fff-pair->scm
116	(ensure-nested-list pairs)))
117	it))
118	(`(array (name ,name) ,values)
119	(cons (cons name
120	(list->vector (map fff-value->scm
121	(ensure-nested-list values))))
122	it))
123	(`(item . ,pair)
124	(cons (fff-pair->scm pair)
125	it))
126	(_ it))))))
127
128	(define* (fff-ref-resolve tree #:optional environment keep-dupes?)
129	(define dupes '())
130	(define env (append (or environment '())
131	'(("true" . #t)
132	("false" . #f)
133	("null" . null))))
134	(filter (lambda (x)
135	(if keep-dupes?
136	#t
137	(not (member (or (car-safe x) x)
138	dupes))))
139	(let loop ((xs tree)
140	(v? #f)
141	(it '()))
142	(if (null? xs)
143	((if v? list->vector identity)
144	(reverse it))
145	(begin
146	(loop (cdr xs)
147	v?
148	(cons (let ((x (car xs)))
149	(cond
150	((atom? x)
151	(set! env (cons x env))
152	x)
153	((procedure? (cdr x))
154	(set! dupes (cons (car x) dupes))
155	(let ((res
156	(cons (car x)
157	((cdr x) (append env tree)))))
158	(set! env (cons res env))
159	res))
160	((atom? (cdr x))
161	(set! env (cons x env))
162	x)
163	((vector? (cdr x))
164	(let ((vl (vector->list (cdr x))))
165	(set! env (cons (fff-ref-resolve vl env #t)
166	env))
167	(cons (car x)
168	(loop vl #t '()))))
169	(else ; object
170	(set! env (cons (fff-ref-resolve x env #t)
171	env))
172	(cons (car x) ; not tail-recursive!
173	(loop (cdr x) #f '())))))
174	it)))))))
175
176	(define (fff-pair->scm pair)
177	(cons (car pair) (fff-value->scm (cadr pair))))
178
179	(define (fff-value->scm val)
180	(match val
181	(`(val ,v) v)
182	(`(ref ,r) (lambda (alist)
183	(assoc-ref alist r)))))