Remove spurious guile stuff

author: Case Duckworth 2023-05-16 23:11:00 -0500
committer: Case Duckworth 2023-05-16 23:11:00 -0500
commit: 7ea9d8c70e7128412763768caff0831d5463fa2b (patch)
tree: 475944d4fb106e4bbff5f41c80f5c69e3dfc275c
parent: Initial commit (chicken version) (diff)
download: fff-7ea9d8c70e7128412763768caff0831d5463fa2b.tar.gz
fff-7ea9d8c70e7128412763768caff0831d5463fa2b.zip
3 files changed, 1 insertions, 274 deletions
diff --git a/fff.scm b/fff.scm
deleted file mode 100755
index 8f5ec22..0000000
--- a/fff.scm
+++ /dev/null

@@ -1,250 +0,0 @@
-#!/bin/sh
-#| -*- scheme -*-
-exec guile -e main -s "$0" "$@"
-Flat Fuck Format
--- a new configuration format, because who doesn't need that?
-Copyright (C) 2023 Case Duckworth <acdw@acdw.net>
-Everyone is permitted to do whatever with this software, without
-limitation.  This software comes without any warranty whatsoever,
-but with two pieces of advice:
- Don't hurt yourself.
- Make good choices.
-Commentary:
-This script will convert files defined in the Flat Fuck Format (fff) into json.
-It will not convert anything back to fff.  fff is explicitly made to be as
-simple as possible, and exclusively human-written.  If a machine writes your
-configuration, ... use a better configuration format.  Or make your program
-scriptable!
-FLAT FUCK FORMAT : Specification
-|#
-!#
-(define-module (fff)
-  #:use-module (ice-9 peg)
-  #:use-module (ice-9 match)
-  #:use-module (srfi srfi-11)
-  #:version (0 1 0)
-  #:export (fff
-            fff?
-            fff/comments?
-            fff->scm))
-;;; PEG Grammar
-(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 all
-  (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
-  (and object-item
-       (* NEWLINE)))
-(define-peg-pattern object-item body
-  (and key (* WHITESPACE)
-       COLON (* WHITESPACE)
-       (or ref val)
-       (? NEWLINE)))
-(define-peg-pattern array-item body
-  (and (* WHITESPACE)
-       COLON (* WHITESPACE)
-       (or ref val)
-       (? NEWLINE)))
-(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)))
-(define-peg-pattern ref all
-  (and AT key))
-(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 "@")
-;;; Utility functions
-(define (ensure-nested-list x)
-  (if (list? (car x))
-      x
-      (list x)))
-(define (atom? x)
-  (and (not (null? x))
-       (not (pair? x))
-       (not (vector? x))))
-(define (car-safe x)
-  (if (pair? x)
-      (car x)
-      #f))
-;;; Parameters
-(define fff/comments?
-  (make-parameter #f))
-(define fff/dupes?
-  (make-parameter #f))
-;;; FFF -> Scheme structures
-(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))
-                (`(comment ,comment)
-                 (if (fff/comments?)
-                     (cons (car xs) it)
-                     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 (or keep-dupes?
-                    (fff/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
-                                 ((procedure? x)
-                                  (let-values (((resval reskey)
-                                                (x (append env tree))))
-                                    (set! env (cons reskey env))
-                                    (set! dupes (cons reskey dupes))
-                                    (list (cons reskey resval))))
-                                 ((atom? x)
-                                  (set! env (cons x env))
-                                  x)
-                                 ((procedure? (cdr x))
-                                  (set! dupes (cons (car x) dupes))
-                                  (let ((resolved
-                                         (cons (car x)
-                                               (cdr ((cdr x)
-                                                     (append env tree))))))
-                                    (set! env (cons resolved env))
-                                    resolved))
-                                 ((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 #f)
-                                                    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)
-                 (values (assoc-ref alist r)
-                         r)))))
diff --git a/test-fff.scm b/test-fff.scm
deleted file mode 100644
index f1cf746..0000000
--- a/test-fff.scm
+++ /dev/null

@@ -1,23 +0,0 @@
-(use-modules (ice-9 format)
-             (ice-9 peg)
-             (ice-9 textual-ports)
-             (fff))
-(define (read-file file)
-  (call-with-input-file file get-string-all))
-(define (test-parse input)
-  (let loop ((str "")
-             (num 0)
-             (lst (string-split input #\newline)))
-    (cond
-     ((null? lst) (match-pattern fff str))
-     ((not (match-pattern fff str))
-      (format #t "!!!!!!!!!!!!!!!!!!!!!!!~%~s~%" lst))
-     (else
-      (format #t "~s~%~%" (peg:tree (match-pattern fff str)))
-      (when (match-pattern fff str)
-        (format #t "~s~%" (car lst)))
-      (loop (string-append str "\n" (car lst))
-            (+ num 1)
-            (cdr lst))))))
diff --git a/test.fff b/test.fff
index 5df4000..d71e01b 100644
--- a/test.fff
+++ b/test.fff

@@ -45,7 +45,7 @@ Capitals::
 Fargo\: the movie: one of the films of all time
 You can even: escape new lines \
              with a backslash. it'll delete all the space preceding the value \
-              on the \#next line so you can have nice hanging indents. \
+              on the #next line so you can have nice hanging indents. \
 \             (If you need weird spacing ... you can do this weird backslash thing.)
 My twitter handle: \@iDontHaveOneLol
author	Case Duckworth	2023-05-16 23:11:00 -0500
committer	Case Duckworth	2023-05-16 23:11:00 -0500
commit	7ea9d8c70e7128412763768caff0831d5463fa2b (patch)
tree	475944d4fb106e4bbff5f41c80f5c69e3dfc275c
parent	Initial commit (chicken version) (diff)
download	fff-7ea9d8c70e7128412763768caff0831d5463fa2b.tar.gz fff-7ea9d8c70e7128412763768caff0831d5463fa2b.zip

diff --git a/fff.scm b/fff.scm deleted file mode 100755 index 8f5ec22..0000000 --- a/fff.scm +++ /dev/null
@@ -1,250 +0,0 @@
1	#!/bin/sh
2	#\| -- scheme --
3	exec guile -e main -s "$0" "$@"
4
5	Flat Fuck Format
6	--- a new configuration format, because who doesn't need that?
7
8	Copyright (C) 2023 Case Duckworth <acdw@acdw.net>
9
10	Everyone is permitted to do whatever with this software, without
11	limitation. This software comes without any warranty whatsoever,
12	but with two pieces of advice:
13
14	- Don't hurt yourself.
15	- Make good choices.
16
17	Commentary:
18
19	This script will convert files defined in the Flat Fuck Format (fff) into json.
20	It will not convert anything back to fff. fff is explicitly made to be as
21	simple as possible, and exclusively human-written. If a machine writes your
22	configuration, ... use a better configuration format. Or make your program
23	scriptable!
24
25	FLAT FUCK FORMAT : Specification
26	\|#
27	!#
28
29	(define-module (fff)
30	#:use-module (ice-9 peg)
31	#:use-module (ice-9 match)
32	#:use-module (srfi srfi-11)
33	#:version (0 1 0)
34	#:export (fff
35	fff?
36	fff/comments?
37	fff->scm))
38
39
40	;;; PEG Grammar
41
42	(define-peg-pattern fff all
43	(and (* (or WHITESPACE NEWLINE))
44	(* (or comment
45	object
46	array
47	item
48	blanks))
49	(* NEWLINE)
50	(not-followed-by peg-any)))
51
52	(define-peg-pattern comment all
53	(and (+ HASH) (* WHITESPACE)
54	(* (and (not-followed-by NEWLINE)
55	peg-any))))
56
57	(define-peg-pattern object all
58	(and name
59	(+ object-item)))
60
61	(define-peg-pattern array all
62	(and name
63	(+ array-item)))
64
65	(define-peg-pattern item all
66	(and object-item
67	(* NEWLINE)))
68
69	(define-peg-pattern object-item body
70	(and key (* WHITESPACE)
71	COLON (* WHITESPACE)
72	(or ref val)
73	(? NEWLINE)))
74
75	(define-peg-pattern array-item body
76	(and (* WHITESPACE)
77	COLON (* WHITESPACE)
78	(or ref val)
79	(? NEWLINE)))
80
81	(define-peg-pattern name all
82	(and key COLON COLON (* WHITESPACE) NEWLINE))
83
84	(define-peg-pattern key body
85	(+ (and (not-followed-by COLON)
86	nonl)))
87
88	(define-peg-pattern val all
89	(and (* nonl)))
90
91	(define-peg-pattern ref all
92	(and AT key))
93
94	(define-peg-pattern escaped body
95	(and BACKSLASH (or (and NEWLINE (* WHITESPACE))
96	peg-any)))
97
98	(define-peg-pattern blanks none
99	(+ NEWLINE))
100
101	(define-peg-pattern nonl body
102	(or escaped
103	(and (not-followed-by NEWLINE)
104	peg-any)))
105
106	(define-peg-pattern NEWLINE none
107	(or "\r\n" "\r" "\n"))
108
109	(define-peg-pattern WHITESPACE none
110	(or " " "\t"))
111
112	(define-peg-pattern BACKSLASH none "\\")
113
114	(define-peg-pattern COLON none ":")
115
116	(define-peg-pattern HASH none "#")
117
118	(define-peg-pattern AT none "@")
119
120
121	;;; Utility functions
122
123	(define (ensure-nested-list x)
124	(if (list? (car x))
125	x
126	(list x)))
127
128	(define (atom? x)
129	(and (not (null? x))
130	(not (pair? x))
131	(not (vector? x))))
132
133	(define (car-safe x)
134	(if (pair? x)
135	(car x)
136	#f))
137
138
139	;;; Parameters
140
141	(define fff/comments?
142	(make-parameter #f))
143
144	(define fff/dupes?
145	(make-parameter #f))
146
147
148	;;; FFF -> Scheme structures
149
150	(define (fff? x)
151	(and (pair? x)
152	(eq? (car x) 'fff)))
153
154	(define (fff->scm str)
155	(let ((tree (peg:tree (match-pattern fff str))))
156	(if (fff? tree)
157	(fff-ref-resolve (fff-tree->ref-tree tree))
158	#f)))
159
160	(define (fff-tree->ref-tree tree)
161	(let loop ((xs (cdr tree))
162	(it '()))
163	(if (null? xs)
164	(reverse it)
165	(loop (cdr xs)
166	(match (car xs)
167	(`(object (name ,name) ,pairs)
168	(cons (cons name
169	(map fff-pair->scm
170	(ensure-nested-list pairs)))
171	it))
172	(`(array (name ,name) ,values)
173	(cons (cons name
174	(list->vector (map fff-value->scm
175	(ensure-nested-list values))))
176	it))
177	(`(item . ,pair)
178	(cons (fff-pair->scm pair)
179	it))
180	(`(comment ,comment)
181	(if (fff/comments?)
182	(cons (car xs) it)
183	it))
184	(_ it))))))
185
186	(define* (fff-ref-resolve tree #:optional environment keep-dupes?)
187	(define dupes '())
188	(define env (append (or environment '())
189	'(("true" . #t)
190	("false" . #f)
191	("null" . null))))
192	(filter (lambda (x)
193	(if (or keep-dupes?
194	(fff/dupes?))
195	#t
196	(not (member (or (car-safe x) x)
197	dupes))))
198	(let loop ((xs tree)
199	(v? #f)
200	(it '()))
201	(if (null? xs)
202	((if v? list->vector identity)
203	(reverse it))
204	(begin
205	(loop (cdr xs)
206	v?
207	(cons (let ((x (car xs)))
208	(cond
209	((procedure? x)
210	(let-values (((resval reskey)
211	(x (append env tree))))
212	(set! env (cons reskey env))
213	(set! dupes (cons reskey dupes))
214	(list (cons reskey resval))))
215	((atom? x)
216	(set! env (cons x env))
217	x)
218	((procedure? (cdr x))
219	(set! dupes (cons (car x) dupes))
220	(let ((resolved
221	(cons (car x)
222	(cdr ((cdr x)
223	(append env tree))))))
224	(set! env (cons resolved env))
225	resolved))
226	((atom? (cdr x))
227	(set! env (cons x env))
228	x)
229	((vector? (cdr x))
230	(let ((vl (vector->list (cdr x))))
231	(set! env (cons (fff-ref-resolve vl env #f)
232	env))
233	(cons (car x)
234	(loop vl #t '()))))
235	(else ; object
236	(set! env (cons (fff-ref-resolve x env #t)
237	env))
238	(cons (car x) ; not tail-recursive!
239	(loop (cdr x) #f '())))))
240	it)))))))
241
242	(define (fff-pair->scm pair)
243	(cons (car pair) (fff-value->scm (cadr pair))))
244
245	(define (fff-value->scm val)
246	(match val
247	(`(val ,v) v)
248	(`(ref ,r) (lambda (alist)
249	(values (assoc-ref alist r)
250	r)))))


diff --git a/test-fff.scm b/test-fff.scm deleted file mode 100644 index f1cf746..0000000 --- a/test-fff.scm +++ /dev/null
@@ -1,23 +0,0 @@
1	(use-modules (ice-9 format)
2	(ice-9 peg)
3	(ice-9 textual-ports)
4	(fff))
5
6	(define (read-file file)
7	(call-with-input-file file get-string-all))
8
9	(define (test-parse input)
10	(let loop ((str "")
11	(num 0)
12	(lst (string-split input #\newline)))
13	(cond
14	((null? lst) (match-pattern fff str))
15	((not (match-pattern fff str))
16	(format #t "!!!!!!!!!!!!!!!!!!!!!!!~%~s~%" lst))
17	(else
18	(format #t "~s~%~%" (peg:tree (match-pattern fff str)))
19	(when (match-pattern fff str)
20	(format #t "~s~%" (car lst)))
21	(loop (string-append str "\n" (car lst))
22	(+ num 1)
23	(cdr lst))))))


diff --git a/test.fff b/test.fff index 5df4000..d71e01b 100644 --- a/test.fff +++ b/test.fff
@@ -45,7 +45,7 @@ Capitals::
45	Fargo\: the movie: one of the films of all time	45	Fargo\: the movie: one of the films of all time
46	You can even: escape new lines \	46	You can even: escape new lines \
47	with a backslash. it'll delete all the space preceding the value \	47	with a backslash. it'll delete all the space preceding the value \
48	on the \#next line so you can have nice hanging indents. \	48	on the #next line so you can have nice hanging indents. \
49	\ (If you need weird spacing ... you can do this weird backslash thing.)	49	\ (If you need weird spacing ... you can do this weird backslash thing.)
50		50
51	My twitter handle: \@iDontHaveOneLol	51	My twitter handle: \@iDontHaveOneLol