Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-24 20:45:06 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

WIP

Browse source
This commit is contained in:
Justin Ethier 2019-02-05 13:25:40 -05:00
parent b5c23441ba
commit 20ee239b59
1 changed files with 41 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

46
analyze-pure-fncs.scm
View file

@ -24,13 +24,17 @@
;; TODO: function to actually scan a def to see if that def can be memoized ;; TODO: function to actually scan a def to see if that def can be memoized
(define (memoizable? var body) (define (memoizable? var body)
(define cont #f)
(define (scan exp return) (define (scan exp return)
;(trace:error `(DEBUG scan ,(ast:ast->pp-sexp exp))) ;(trace:error `(DEBUG scan ,(ast:ast->pp-sexp exp)))
(write `(DEBUG scan ,(ast:ast->pp-sexp exp))) (newline) (write `(DEBUG scan ,var ,cont ,(ast:ast->pp-sexp exp))) (newline)
(cond (cond
;; TODO: reject if a lambda is returned ;; TODO: reject if a lambda is returned
((ast:lambda? exp) ((ast:lambda? exp)
(scan (ast:lambda-body exp)) (map
(lambda (e)
(scan e return))
(ast:lambda-body exp))
) )
((quote? exp) exp) ((quote? exp) exp)
((const? exp) #t) ((const? exp) #t)
@ -44,9 +48,40 @@
(scan (if->then exp) return) (scan (if->then exp) return)
(scan (if->else exp) return)) (scan (if->else exp) return))
((app? exp) ((app? exp)
;TODO: call must be var or on approved list (cond
(when (not (member (car exp) (list var '+ '-))) ;(write `( ,(car exp) ,var ,cont)) (newline)
(return #f)) ((ast:lambda? (car exp))
(scan (car exp) return))
((or
(equal? (car exp) var) ;; Recursive call to self
(equal? (car exp) cont) ;; Continuation of fnc
)
#t) ;; OK to ignore this call
((not (member
(car exp)
'(+ - * / =
Cyc-fast-plus
Cyc-fast-sub
Cyc-fast-mul
Cyc-fast-div
Cyc-fast-eq
Cyc-fast-gt
Cyc-fast-lt
Cyc-fast-gte
Cyc-fast-lte
Cyc-fast-char-eq
Cyc-fast-char-gt
Cyc-fast-char-lt
Cyc-fast-char-gte
Cyc-fast-char-lte
=
>
<
>=
<=
)))
;; Call not on approved list
(return #f)))
(for-each (for-each
(lambda (e) (lambda (e)
(scan e return)) (scan e return))
@ -64,6 +99,7 @@
#t) #t)
(call/cc (call/cc
(lambda (return) (lambda (return)
(set! cont (car (ast:lambda-args body)))
(scan body return) (scan body return)
(return #t)))) (return #t))))
(else #f)) (else #f))