diff options
| author | Case Duckworth | 2023-03-21 09:46:53 -0500 |
|---|---|---|
| committer | Case Duckworth | 2023-03-21 09:46:53 -0500 |
| commit | 0240570b6999ae95f7bfbaf423ba34cc051c6697 (patch) | |
| tree | 7dcdb0fd960a311b3fe703df23e4e9530b5638ff | |
| parent | Add fff/dupes? parameter (diff) | |
| download | fff-0240570b6999ae95f7bfbaf423ba34cc051c6697.tar.gz fff-0240570b6999ae95f7bfbaf423ba34cc051c6697.zip | |
Support vector references
| -rwxr-xr-x | fff.scm | 20 |
1 files 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 | |||
| 206 | v? | 206 | v? |
| 207 | (cons (let ((x (car xs))) | 207 | (cons (let ((x (car xs))) |
| 208 | (cond | 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)))) | ||
| 209 | ((atom? x) | 215 | ((atom? x) |
| 210 | (set! env (cons x env)) | 216 | (set! env (cons x env)) |
| 211 | x) | 217 | x) |
| 212 | ((procedure? (cdr x)) | 218 | ((procedure? (cdr x)) |
| 213 | (set! dupes (cons (car x) dupes)) | 219 | (set! dupes (cons (car x) dupes)) |
| 214 | (let ((res | 220 | (let ((resolved |
| 215 | (cons (car x) | 221 | (cons (car x) |
| 216 | ((cdr x) (append env tree))))) | 222 | (cdr ((cdr x) |
| 217 | (set! env (cons res env)) | 223 | (append env tree)))))) |
| 218 | res)) | 224 | (set! env (cons resolved env)) |
| 225 | resolved)) | ||
| 219 | ((atom? (cdr x)) | 226 | ((atom? (cdr x)) |
| 220 | (set! env (cons x env)) | 227 | (set! env (cons x env)) |
| 221 | x) | 228 | x) |
| 222 | ((vector? (cdr x)) | 229 | ((vector? (cdr x)) |
| 223 | (let ((vl (vector->list (cdr x)))) | 230 | (let ((vl (vector->list (cdr x)))) |
| 224 | (set! env (cons (fff-ref-resolve vl env #t) | 231 | (set! env (cons (fff-ref-resolve vl env #f) |
| 225 | env)) | 232 | env)) |
| 226 | (cons (car x) | 233 | (cons (car x) |
| 227 | (loop vl #t '())))) | 234 | (loop vl #t '())))) |
| @@ -239,4 +246,5 @@ FLAT FUCK FORMAT : Specification | |||
| 239 | (match val | 246 | (match val |
| 240 | (`(val ,v) v) | 247 | (`(val ,v) v) |
| 241 | (`(ref ,r) (lambda (alist) | 248 | (`(ref ,r) (lambda (alist) |
| 242 | (assoc-ref alist r))))) | 249 | (values (assoc-ref alist r) |
| 250 | r))))) | ||