From 7ea9d8c70e7128412763768caff0831d5463fa2b Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Tue, 16 May 2023 23:11:00 -0500
Subject: Remove spurious guile stuff

---
 fff.scm | 250 ----------------------------------------------------------------
 1 file changed, 250 deletions(-)
 delete mode 100755 fff.scm

(limited to 'fff.scm')

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)))))
-- 
cgit 1.4.1-21-gabe81