mirror of
https://github.com/justinethier/cyclone.git
synced 2025-07-11 06:47:37 +02:00
Integrate code for well-known lambdas
This commit is contained in:
parent
0526dadde7
commit
dbd1e4799f
1 changed files with 79 additions and 14 deletions
|
@ -40,6 +40,9 @@
|
||||||
adb:get-db
|
adb:get-db
|
||||||
simple-lambda?
|
simple-lambda?
|
||||||
one-instance-of-new-mutable-obj?
|
one-instance-of-new-mutable-obj?
|
||||||
|
;; Analysis - well-known lambdas
|
||||||
|
well-known-lambda?
|
||||||
|
analyze:find-known-lambdas
|
||||||
;; Analyze variables
|
;; Analyze variables
|
||||||
adb:make-var
|
adb:make-var
|
||||||
%adb:make-var
|
%adb:make-var
|
||||||
|
@ -1926,36 +1929,98 @@
|
||||||
exp))
|
exp))
|
||||||
)
|
)
|
||||||
|
|
||||||
|
;; Does the given symbol refer to a well-known lambda?
|
||||||
|
(define (well-known-lambda? sym)
|
||||||
|
(and *well-known-lambda-sym-lookup-tbl*
|
||||||
|
(hash-table-ref/default *well-known-lambda-sym-lookup-tbl* sym #f)))
|
||||||
|
|
||||||
|
(define *well-known-lambda-sym-lookup-tbl* #f)
|
||||||
|
|
||||||
|
;; Scan for well-known lambdas:
|
||||||
|
;; - app of a lambda is well-known, that's easy
|
||||||
|
;; - lambda passed as a cont. If we can identify all the places the cont is
|
||||||
|
;; called and it is not used for anything but calls, then I suppose that
|
||||||
|
;; also qualifies as well-known.
|
||||||
|
;; - ?? must be other cases
|
||||||
(define (analyze:find-known-lambdas exp)
|
(define (analyze:find-known-lambdas exp)
|
||||||
TODO: scan for well-known lambdas:
|
;; Lambda conts that are candidates for well-known functions,
|
||||||
- app of a lambda is well-known, that's easy
|
;; we won't know until we check exactly how the cont is used...
|
||||||
- lambda can be passed as a cont. If we can identify all the places the cont is called (?) and it is not used for anything but calls, then I suppose that also qualifies as well-known.
|
(define candidates (make-hash-table))
|
||||||
this is more problematic to generate code for, though.
|
|
||||||
may need a lookup table of symbol to well-known function (if any)
|
;; Add given lambda to candidate table
|
||||||
- ?? must be other cases
|
;; 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: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)
|
||||||
|
(let ((lid (ast:lambda-id exp)))
|
||||||
|
(trace:info `(found known lambda with id ,lid))
|
||||||
|
(with-fnc! lid (lambda (fnc)
|
||||||
|
(adbf:set-well-known! fnc #t)))))
|
||||||
|
|
||||||
(define (scan exp)
|
(define (scan exp)
|
||||||
(cond
|
(cond
|
||||||
((ast:lambda? exp)
|
((ast:lambda? exp)
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (e)
|
(lambda (e)
|
||||||
(scan e def-sym))
|
(scan e))
|
||||||
(ast:lambda-body exp)))
|
(ast:lambda-body exp)))
|
||||||
((quote? exp) exp)
|
((quote? exp) exp)
|
||||||
((const? exp) exp)
|
((const? exp) exp)
|
||||||
((ref? exp)
|
((ref? exp)
|
||||||
|
(remove-candidate exp)
|
||||||
exp)
|
exp)
|
||||||
((define? exp) #f) ;; TODO ??
|
((define? exp)
|
||||||
((set!? exp) #f) ;; TODO ??
|
(for-each
|
||||||
|
(lambda (e)
|
||||||
|
(scan e))
|
||||||
|
(define->exp exp)))
|
||||||
|
;((set!? exp) #f) ;; TODO ??
|
||||||
((if? exp)
|
((if? exp)
|
||||||
(scan (if->condition exp) def-sym)
|
(scan (if->condition exp))
|
||||||
(scan (if->then exp) def-sym)
|
(scan (if->then exp))
|
||||||
(scan (if->else exp) def-sym))
|
(scan (if->else exp)))
|
||||||
((app? exp)
|
((app? exp)
|
||||||
)
|
(cond
|
||||||
|
((ast:lambda? (car exp))
|
||||||
|
(found (car exp)) ;; We immediately know these lambdas are well-known
|
||||||
|
(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
|
||||||
|
(for-each
|
||||||
|
(lambda (e)
|
||||||
|
(scan e))
|
||||||
|
exp))
|
||||||
|
(else
|
||||||
|
(for-each
|
||||||
|
(lambda (e)
|
||||||
|
(scan e))
|
||||||
|
;; 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)
|
||||||
|
;; Record all well-known lambdas that were found indirectly
|
||||||
|
(for-each
|
||||||
|
(lambda (sym/lamb)
|
||||||
|
(found (cdr sym/lamb)))
|
||||||
|
(hash-table->alist candidates))
|
||||||
|
;; Save the candidate list so we can use it to lookup
|
||||||
|
;; well-known lambda's by var references to them.
|
||||||
|
(set! *well-known-lambda-sym-lookup-tbl* candidates)
|
||||||
|
)
|
||||||
|
|
||||||
))
|
))
|
||||||
|
|
Loading…
Add table
Reference in a new issue