From 0240570b6999ae95f7bfbaf423ba34cc051c6697 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Tue, 21 Mar 2023 09:46:53 -0500 Subject: Support vector references --- fff.scm | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/fff.scm b/fff.scm index e37fff6..8f5ec22 100755 --- a/fff.scm +++ b/fff.scm @@ -206,22 +206,29 @@ FLAT FUCK FORMAT : Specification 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 ((res + (let ((resolved (cons (car x) - ((cdr x) (append env tree))))) - (set! env (cons res env)) - res)) + (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 #t) + (set! env (cons (fff-ref-resolve vl env #f) env)) (cons (car x) (loop vl #t '())))) @@ -239,4 +246,5 @@ FLAT FUCK FORMAT : Specification (match val (`(val ,v) v) (`(ref ,r) (lambda (alist) - (assoc-ref alist r))))) + (values (assoc-ref alist r) + r))))) -- cgit 1.4.1-21-gabe81