From 8b8c603a6106151188bdeab95501cacaf72912d4 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Mon, 29 Jul 2019 13:44:23 +0100 Subject: [PATCH] Add ast-find --- ast.scm | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/ast.scm b/ast.scm index a38a012..2beb945 100644 --- a/ast.scm +++ b/ast.scm @@ -48,6 +48,28 @@ (fold-map inner (cdr x)))] [else (f x)])) +(define (ast-find p x) + (define (inner y) (ast-find p y)) + (define (any p x) (fold-left + (lambda (acc y) (if acc #t (p y))) + #f + x)) + (define (either . fs) + (if (null? fs) #f + (if (car fs) (car fs) + (apply either (cdr fs))))) + + (case (ast-type x) + ['let (either (p x) + (any inner (let-bindings x)) + (any inner (let-body x)))] + ['app (either (p x) + (any inner x))] + ['lambda (either (p x) + (inner (lambda-body x)))] + ['if (either (p x) (any inner (cdr x)))] + [else (p x)])) + (define let-bindings cadr) (define let-body cddr) -- 2.30.2