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 ----------------------------------------------------------- test-fff.scm | 23 ------ test.fff | 2 +- 3 files changed, 1 insertion(+), 274 deletions(-) delete mode 100755 fff.scm delete mode 100644 test-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 - -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 -- cgit 1.4.1-21-gabe81