Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-15 16:57:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

WIP

Browse source
This commit is contained in:
Justin Ethier 2018-09-13 18:49:03 -04:00
parent 18997af478
commit 8f06bd8de9
1 changed files with 33 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

35
tests/debug/find-known-lambdas.scm
View file

@ -3,8 +3,10 @@
(scheme cyclone ast) (scheme cyclone ast)
(scheme cyclone util) (scheme cyclone util)
(scheme cyclone pretty-print) (scheme cyclone pretty-print)
(scheme cyclone transforms)
(scheme write) (scheme write)
(srfi 2) (srfi 2)
(srfi 69)
) )
(define (analyze:find-known-lambdas exp) (define (analyze:find-known-lambdas exp)
@ -15,6 +17,21 @@
; may need a lookup table of symbol to well-known function (if any) ; may need a lookup table of symbol to well-known function (if any)
;- ?? must be other cases ;- ?? must be other cases
;; Lambda conts that are candidates for well-known functions,
;; we won't know until we check exactly how the cont is used...
(define candidates (make-hash-table))
;; Add given lambda to candidate table
;; ast:lam - AST Lambda object
;; param-sym - Symbol of the parameter that the lambda is passed as
(define (add-candidate! ast:lam param-sym)
(hash-table-set! candidates param-sym (ast:lambda-id ast:lam)))
;; Remove given lambda from candidate table
;; param-sym - Symbol representing the lambda to remove
(define (remove-candidate param-sym)
(hash-table-delete! candidates param-sym))
(define (found exp) (define (found exp)
(write `(found known lambda with id ,(ast:lambda-id exp))) (write `(found known lambda with id ,(ast:lambda-id exp)))
(newline)) (newline))
@ -29,6 +46,7 @@
((quote? exp) exp) ((quote? exp) exp)
((const? exp) exp) ((const? exp) exp)
((ref? exp) ((ref? exp)
(remove-candidate exp)
exp) exp)
((define? exp) ((define? exp)
(for-each (for-each
@ -44,6 +62,12 @@
(cond (cond
((ast:lambda? (car exp)) ((ast:lambda? (car exp))
(found (car exp)) (found (car exp))
(let ((formals (ast:lambda-formals->list (car exp))))
(when (and (pair? formals)
(pair? (cdr exp))
(ast:lambda? (cadr exp)))
(add-candidate! (cadr exp) (car formals)))
)
;; Scan the rest of the args ;; Scan the rest of the args
(for-each (for-each
(lambda (e) (lambda (e)
@ -53,11 +77,18 @@
(for-each (for-each
(lambda (e) (lambda (e)
(scan e)) (scan e))
exp)))) ;; Allow candidates to remain if they are just function calls
(if (ref? (car exp))
(cdr exp)
exp)))))
(else #f))) (else #f)))
;(trace:error `(update-lambda-atv! ,syms ,value)) ;(trace:error `(update-lambda-atv! ,syms ,value))
(scan exp)) (scan exp)
(write "Other known lambdas:")
(write (hash-table->alist candidates))
(newline)
)
;; TEST code: ;; TEST code: