mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-19 21:59:16 +02:00
628 lines
48 KiB
Scheme
628 lines
48 KiB
Scheme
;;
|
|
;; A test framework to attempt to make it easier to debug generated programs.
|
|
;; The idea is to allow execution of Scheme code that has been transformed
|
|
;; using cyclone's source-to-source transformations. If the code executes
|
|
;; OK here, then it should execute fine after being transformed into C code.
|
|
;; Unless of course there is a bug here (hopefully not) or in the Scheme->C
|
|
;; compiler.
|
|
;;
|
|
|
|
;; Return a function that can be called directly to
|
|
;; invoke the closure, or indirectly to access closure
|
|
;; elements.
|
|
;;
|
|
;; When called directly, the first arg is the closure
|
|
;; itself (self), followed by args passed when the
|
|
;; closure was defined.
|
|
(define (%closure . clo-args)
|
|
(define clo-data (list->vector clo-args))
|
|
(define clo
|
|
(lambda args
|
|
(cond
|
|
((and (> (length args) 1)
|
|
(equal? 'ref (car args)))
|
|
(vector-ref clo-data (cadr args)))
|
|
(else
|
|
(apply
|
|
(car clo-args)
|
|
(cons clo args))))))
|
|
clo)
|
|
|
|
(define (%closure-ref clo idx)
|
|
(clo 'ref idx))
|
|
(define (%halt x)
|
|
(exit))
|
|
|
|
;; Test code from matt might, may need to tweak per corresponding
|
|
;; functionality in the MTA C runtime
|
|
;; Suitable definitions for the cell functions:
|
|
(define (cell value) (lambda (get? new-value)
|
|
(if get? value (set! value new-value))))
|
|
(define (set-cell! c v) (c #f v))
|
|
(define (cell-get c) (c #t #t))
|
|
;; END matt might
|
|
|
|
(define (test-fac)
|
|
((lambda (fac)
|
|
((lambda (fac)
|
|
((%closure
|
|
(lambda (self$698 r$689)
|
|
((%closure
|
|
(lambda (self$699 r$687)
|
|
((%closure
|
|
(lambda (self$700 $_$684)
|
|
((%closure-ref (cell-get (%closure-ref self$700 1)) 0)
|
|
(cell-get (%closure-ref self$700 1))
|
|
(%closure
|
|
(lambda (self$701 r$688)
|
|
((lambda (r$686) (%halt r$686)) (display r$688))))
|
|
10))
|
|
(%closure-ref self$699 1))
|
|
r$687))
|
|
(%closure-ref self$698 1))
|
|
(set-cell! (%closure-ref self$698 1) r$689)))
|
|
fac)
|
|
(%closure
|
|
(lambda (self$694 k$690 n$685)
|
|
((%closure
|
|
(lambda (self$695 r$691)
|
|
(if r$691
|
|
((%closure-ref (%closure-ref self$695 2) 0)
|
|
(%closure-ref self$695 2)
|
|
1)
|
|
((%closure
|
|
(lambda (self$696 r$693)
|
|
((%closure-ref (cell-get (%closure-ref self$696 1)) 0)
|
|
(cell-get (%closure-ref self$696 1))
|
|
(%closure
|
|
(lambda (self$697 r$692)
|
|
((%closure-ref (%closure-ref self$697 1) 0)
|
|
(%closure-ref self$697 1)
|
|
(* (%closure-ref self$697 2) r$692)))
|
|
(%closure-ref self$696 2)
|
|
(%closure-ref self$696 3))
|
|
r$693))
|
|
(%closure-ref self$695 1)
|
|
(%closure-ref self$695 2)
|
|
(%closure-ref self$695 3))
|
|
(- (%closure-ref self$695 3) 1))))
|
|
(%closure-ref self$694 1)
|
|
k$690
|
|
n$685)
|
|
(= 0 n$685)))
|
|
fac)))
|
|
(cell fac)))
|
|
#f))
|
|
;(test-fac)
|
|
|
|
(define (test-set)
|
|
((lambda (x$684)
|
|
((lambda (x$684)
|
|
((%closure
|
|
(lambda (self$687 r$686)
|
|
((lambda (r$685) (%halt r$685))
|
|
(display (cell-get (%closure-ref self$687 1)))))
|
|
x$684)
|
|
(set-cell! x$684 #t)))
|
|
(cell x$684)))
|
|
#f))
|
|
;(test-set)
|
|
|
|
(define (test-adder)
|
|
((lambda (increment make-adder)
|
|
((%closure
|
|
(lambda (self$696 increment)
|
|
((%closure
|
|
(lambda (self$697 make-adder)
|
|
((%closure
|
|
(lambda (self$700 r$693)
|
|
((%closure
|
|
(lambda (self$701 r$689)
|
|
((%closure
|
|
(lambda (self$702 $_$684)
|
|
((%closure-ref
|
|
(cell-get (%closure-ref self$702 2))
|
|
0)
|
|
(cell-get (%closure-ref self$702 2))
|
|
(%closure
|
|
(lambda (self$703 r$692)
|
|
((%closure
|
|
(lambda (self$704 r$690)
|
|
((%closure
|
|
(lambda (self$705 $_$685)
|
|
((%closure-ref
|
|
(cell-get (%closure-ref self$705 1))
|
|
0)
|
|
(cell-get (%closure-ref self$705 1))
|
|
(%closure
|
|
(lambda (self$706 r$691)
|
|
((lambda (r$688) (%halt r$688)) (display r$691))))
|
|
41))
|
|
(%closure-ref self$704 1))
|
|
r$690))
|
|
(%closure-ref self$703 1))
|
|
(set-cell! (%closure-ref self$703 1) r$692)))
|
|
(%closure-ref self$702 1))
|
|
1))
|
|
(%closure-ref self$701 1)
|
|
(%closure-ref self$701 2))
|
|
r$689))
|
|
(%closure-ref self$700 1)
|
|
(%closure-ref self$700 2))
|
|
(set-cell! (%closure-ref self$700 2) r$693)))
|
|
(%closure-ref self$697 1)
|
|
make-adder)
|
|
(%closure
|
|
(lambda (self$698 k$694 x$686)
|
|
((%closure-ref k$694 0)
|
|
k$694
|
|
(%closure
|
|
(lambda (self$699 k$695 y$687)
|
|
((%closure-ref k$695 0)
|
|
k$695
|
|
(+ (%closure-ref self$699 1) y$687)))
|
|
x$686))))))
|
|
increment)
|
|
(cell (%closure-ref self$696 1))))
|
|
make-adder)
|
|
(cell increment)))
|
|
#f
|
|
#f))
|
|
;(test-adder)
|
|
|
|
;; Transformed scheme code from if.scm
|
|
(define (test-if)
|
|
((lambda (k$699) (if #t (k$699 1) (k$699 2)))
|
|
(lambda (r$698)
|
|
((lambda (r$689)
|
|
((lambda ($_$684)
|
|
((lambda (k$697) (if #f (k$697 1) (k$697 2)))
|
|
(lambda (r$696)
|
|
((lambda (r$690)
|
|
((lambda ($_$685)
|
|
((lambda (k$694)
|
|
((lambda (r$695)
|
|
(if r$695 (k$694 (+ 3 4)) (k$694 (* 3 4))))
|
|
(+ 1 2)))
|
|
(lambda (r$691)
|
|
((lambda ($_$686)
|
|
((lambda (k$692)
|
|
((lambda (x$687)
|
|
((lambda (r$693)
|
|
(if r$693 (k$692 (+ 1 1)) (k$692 (* 0 0))))
|
|
(+ x$687 1)))
|
|
0))
|
|
(lambda (r$688) (%halt r$688))))
|
|
r$691))))
|
|
r$690))
|
|
(display r$696)))))
|
|
r$689))
|
|
(display r$698)))))
|
|
|
|
(define (test-eval)
|
|
((lambda (analyze$737
|
|
analyze-quoted$738
|
|
analyze-self-evaluating$739
|
|
env$740
|
|
eval$741
|
|
exp$742
|
|
quoted?$743
|
|
self-evaluating?$744
|
|
tag$745
|
|
tagged-list?$746)
|
|
((%closure
|
|
(lambda (self$803 analyze$737)
|
|
((%closure
|
|
(lambda (self$804 analyze-quoted$738)
|
|
((%closure
|
|
(lambda (self$805 analyze-self-evaluating$739)
|
|
((%closure
|
|
(lambda (self$806 eval$741)
|
|
((%closure
|
|
(lambda (self$807 quoted?$743)
|
|
((%closure
|
|
(lambda (self$808 self-evaluating?$744)
|
|
((%closure
|
|
(lambda (self$809 tagged-list?$746)
|
|
((%closure
|
|
(lambda (self$812 r$800)
|
|
((%closure
|
|
(lambda (self$813 r$768)
|
|
((%closure
|
|
(lambda (self$814 $_$747)
|
|
((%closure
|
|
(lambda (self$818 r$796)
|
|
((%closure
|
|
(lambda (self$819 r$769)
|
|
((%closure
|
|
(lambda (self$820 $_$748)
|
|
((%closure
|
|
(lambda (self$823 r$793)
|
|
((%closure
|
|
(lambda (self$824 r$770)
|
|
((%closure
|
|
(lambda (self$825 $_$749)
|
|
((%closure
|
|
(lambda (self$828 r$790)
|
|
((%closure
|
|
(lambda (self$829 r$771)
|
|
((%closure
|
|
(lambda (self$830 $_$750)
|
|
((%closure
|
|
(lambda (self$834 r$786)
|
|
((%closure
|
|
(lambda (self$835 r$772)
|
|
((%closure
|
|
(lambda (self$836 $_$751)
|
|
((%closure
|
|
(lambda (self$839 r$783)
|
|
((%closure
|
|
(lambda (self$840 r$773)
|
|
((%closure
|
|
(lambda (self$841 $_$752)
|
|
((%closure
|
|
(lambda (self$846 r$779)
|
|
((%closure
|
|
(lambda (self$847 r$774)
|
|
((%closure
|
|
(lambda (self$848 $_$753)
|
|
((%closure-ref
|
|
(cell-get (%closure-ref self$848 1))
|
|
0)
|
|
(cell-get (%closure-ref self$848 1))
|
|
(%closure
|
|
(lambda (self$849 r$778)
|
|
((%closure
|
|
(lambda (self$850 r$775)
|
|
((%closure
|
|
(lambda (self$851 $_$754)
|
|
((%closure
|
|
(lambda (self$852 r$777)
|
|
((%closure-ref
|
|
(cell-get (%closure-ref self$852 1))
|
|
0)
|
|
(cell-get (%closure-ref self$852 1))
|
|
(%closure
|
|
(lambda (self$853 r$776)
|
|
((lambda (r$767) (%halt r$767)) (write r$776))))
|
|
r$777
|
|
#f))
|
|
(%closure-ref self$851 1))
|
|
'(1 . 2)))
|
|
(%closure-ref self$850 1))
|
|
r$775))
|
|
(%closure-ref self$849 1))
|
|
(write r$778)))
|
|
(%closure-ref self$848 1))
|
|
2
|
|
#f))
|
|
(%closure-ref self$847 1))
|
|
r$774))
|
|
(%closure-ref self$846 2))
|
|
(set-cell! (%closure-ref self$846 1) r$779)))
|
|
(%closure-ref self$841 1)
|
|
(%closure-ref self$841 2))
|
|
(%closure
|
|
(lambda (self$842 k$780 exp$755)
|
|
((%closure
|
|
(lambda (self$843 r$781)
|
|
((%closure
|
|
(lambda (self$844 qval$756)
|
|
((%closure-ref (%closure-ref self$844 1) 0)
|
|
(%closure-ref self$844 1)
|
|
(%closure
|
|
(lambda (self$845 k$782 env$757)
|
|
((%closure-ref k$782 0)
|
|
k$782
|
|
(%closure-ref self$845 1)))
|
|
qval$756)))
|
|
(%closure-ref self$843 1))
|
|
r$781))
|
|
k$780)
|
|
(cadr exp$755))))))
|
|
(%closure-ref self$840 1)
|
|
(%closure-ref self$840 2))
|
|
r$773))
|
|
(%closure-ref self$839 1)
|
|
(%closure-ref self$839 3))
|
|
(set-cell! (%closure-ref self$839 2) r$783)))
|
|
(%closure-ref self$836 1)
|
|
(%closure-ref self$836 2)
|
|
(%closure-ref self$836 3))
|
|
(%closure
|
|
(lambda (self$837 k$784 exp$758)
|
|
((%closure-ref k$784 0)
|
|
k$784
|
|
(%closure
|
|
(lambda (self$838 k$785 env$759)
|
|
((%closure-ref k$785 0)
|
|
k$785
|
|
(%closure-ref self$838 1)))
|
|
exp$758))))))
|
|
(%closure-ref self$835 1)
|
|
(%closure-ref self$835 2)
|
|
(%closure-ref self$835 3))
|
|
r$772))
|
|
(%closure-ref self$834 2)
|
|
(%closure-ref self$834 3)
|
|
(%closure-ref self$834 4))
|
|
(set-cell! (%closure-ref self$834 1) r$786)))
|
|
(%closure-ref self$830 1)
|
|
(%closure-ref self$830 2)
|
|
(%closure-ref self$830 3)
|
|
(%closure-ref self$830 4))
|
|
(%closure
|
|
(lambda (self$831 k$787 exp$760)
|
|
((%closure-ref
|
|
(cell-get (%closure-ref self$831 4))
|
|
0)
|
|
(cell-get (%closure-ref self$831 4))
|
|
(%closure
|
|
(lambda (self$832 r$788)
|
|
(if r$788
|
|
((%closure-ref
|
|
(cell-get (%closure-ref self$832 2))
|
|
0)
|
|
(cell-get (%closure-ref self$832 2))
|
|
(%closure-ref self$832 4)
|
|
(%closure-ref self$832 3))
|
|
((%closure-ref
|
|
(cell-get (%closure-ref self$832 5))
|
|
0)
|
|
(cell-get (%closure-ref self$832 5))
|
|
(%closure
|
|
(lambda (self$833 r$789)
|
|
(if r$789
|
|
((%closure-ref
|
|
(cell-get (%closure-ref self$833 1))
|
|
0)
|
|
(cell-get (%closure-ref self$833 1))
|
|
(%closure-ref self$833 3)
|
|
(%closure-ref self$833 2))
|
|
((%closure-ref (%closure-ref self$833 3) 0)
|
|
(%closure-ref self$833 3)
|
|
#f)))
|
|
(%closure-ref self$832 1)
|
|
(%closure-ref self$832 3)
|
|
(%closure-ref self$832 4))
|
|
(%closure-ref self$832 3))))
|
|
(%closure-ref self$831 1)
|
|
(%closure-ref self$831 2)
|
|
exp$760
|
|
k$787
|
|
(%closure-ref self$831 3))
|
|
exp$760))
|
|
(%closure-ref self$830 2)
|
|
(%closure-ref self$830 3)
|
|
(%closure-ref self$830 5)
|
|
(%closure-ref self$830 6))))
|
|
(%closure-ref self$829 1)
|
|
(%closure-ref self$829 2)
|
|
(%closure-ref self$829 3)
|
|
(%closure-ref self$829 4)
|
|
(%closure-ref self$829 5)
|
|
(%closure-ref self$829 6))
|
|
r$771))
|
|
(%closure-ref self$828 1)
|
|
(%closure-ref self$828 2)
|
|
(%closure-ref self$828 3)
|
|
(%closure-ref self$828 4)
|
|
(%closure-ref self$828 5)
|
|
(%closure-ref self$828 6))
|
|
(set-cell! (%closure-ref self$828 5) r$790)))
|
|
(%closure-ref self$825 1)
|
|
(%closure-ref self$825 2)
|
|
(%closure-ref self$825 3)
|
|
(%closure-ref self$825 4)
|
|
(%closure-ref self$825 5)
|
|
(%closure-ref self$825 6))
|
|
(%closure
|
|
(lambda (self$826 k$791 exp$761)
|
|
((%closure
|
|
(lambda (self$827 r$792)
|
|
((%closure-ref
|
|
(cell-get (%closure-ref self$827 3))
|
|
0)
|
|
(cell-get (%closure-ref self$827 3))
|
|
(%closure-ref self$827 2)
|
|
(%closure-ref self$827 1)
|
|
r$792))
|
|
exp$761
|
|
k$791
|
|
(%closure-ref self$826 1))
|
|
'quote))
|
|
(%closure-ref self$825 7))))
|
|
(%closure-ref self$824 1)
|
|
(%closure-ref self$824 2)
|
|
(%closure-ref self$824 3)
|
|
(%closure-ref self$824 4)
|
|
(%closure-ref self$824 5)
|
|
(%closure-ref self$824 6)
|
|
(%closure-ref self$824 7))
|
|
r$770))
|
|
(%closure-ref self$823 1)
|
|
(%closure-ref self$823 2)
|
|
(%closure-ref self$823 3)
|
|
(%closure-ref self$823 4)
|
|
(%closure-ref self$823 5)
|
|
(%closure-ref self$823 6)
|
|
(%closure-ref self$823 7))
|
|
(set-cell! (%closure-ref self$823 6) r$793)))
|
|
(%closure-ref self$820 1)
|
|
(%closure-ref self$820 2)
|
|
(%closure-ref self$820 3)
|
|
(%closure-ref self$820 4)
|
|
(%closure-ref self$820 5)
|
|
(%closure-ref self$820 6)
|
|
(%closure-ref self$820 7))
|
|
(%closure
|
|
(lambda (self$821 k$794 exp$762)
|
|
((%closure
|
|
(lambda (self$822 r$795)
|
|
(if r$795
|
|
((%closure-ref (%closure-ref self$822 1) 0)
|
|
(%closure-ref self$822 1)
|
|
#t)
|
|
((%closure-ref (%closure-ref self$822 1) 0)
|
|
(%closure-ref self$822 1)
|
|
#f)))
|
|
k$794)
|
|
(number? exp$762))))))
|
|
(%closure-ref self$819 1)
|
|
(%closure-ref self$819 2)
|
|
(%closure-ref self$819 3)
|
|
(%closure-ref self$819 4)
|
|
(%closure-ref self$819 5)
|
|
(%closure-ref self$819 6)
|
|
(%closure-ref self$819 7))
|
|
r$769))
|
|
(%closure-ref self$818 1)
|
|
(%closure-ref self$818 2)
|
|
(%closure-ref self$818 3)
|
|
(%closure-ref self$818 4)
|
|
(%closure-ref self$818 5)
|
|
(%closure-ref self$818 6)
|
|
(%closure-ref self$818 7))
|
|
(set-cell! (%closure-ref self$818 7) r$796)))
|
|
(%closure-ref self$814 1)
|
|
(%closure-ref self$814 2)
|
|
(%closure-ref self$814 3)
|
|
(%closure-ref self$814 4)
|
|
(%closure-ref self$814 5)
|
|
(%closure-ref self$814 6)
|
|
(%closure-ref self$814 7))
|
|
(%closure
|
|
(lambda (self$815 k$797 exp$763 tag$764)
|
|
((%closure
|
|
(lambda (self$816 r$798)
|
|
(if r$798
|
|
((%closure
|
|
(lambda (self$817 r$799)
|
|
((%closure-ref (%closure-ref self$817 1) 0)
|
|
(%closure-ref self$817 1)
|
|
(equal? r$799 (%closure-ref self$817 2))))
|
|
(%closure-ref self$816 2)
|
|
(%closure-ref self$816 3))
|
|
(car (%closure-ref self$816 1)))
|
|
((%closure-ref (%closure-ref self$816 2) 0)
|
|
(%closure-ref self$816 2)
|
|
#f)))
|
|
exp$763
|
|
k$797
|
|
tag$764)
|
|
(pair? exp$763))))))
|
|
(%closure-ref self$813 1)
|
|
(%closure-ref self$813 2)
|
|
(%closure-ref self$813 3)
|
|
(%closure-ref self$813 4)
|
|
(%closure-ref self$813 5)
|
|
(%closure-ref self$813 6)
|
|
(%closure-ref self$813 7))
|
|
r$768))
|
|
(%closure-ref self$812 1)
|
|
(%closure-ref self$812 2)
|
|
(%closure-ref self$812 3)
|
|
(%closure-ref self$812 4)
|
|
(%closure-ref self$812 5)
|
|
(%closure-ref self$812 6)
|
|
(%closure-ref self$812 7))
|
|
(set-cell! (%closure-ref self$812 4) r$800)))
|
|
(%closure-ref self$809 1)
|
|
(%closure-ref self$809 2)
|
|
(%closure-ref self$809 3)
|
|
(%closure-ref self$809 4)
|
|
(%closure-ref self$809 5)
|
|
(%closure-ref self$809 6)
|
|
tagged-list?$746)
|
|
(%closure
|
|
(lambda (self$810 k$801 exp$765 env$766)
|
|
((%closure-ref
|
|
(cell-get (%closure-ref self$810 1))
|
|
0)
|
|
(cell-get (%closure-ref self$810 1))
|
|
(%closure
|
|
(lambda (self$811 r$802)
|
|
((%closure-ref r$802 0)
|
|
r$802
|
|
(%closure-ref self$811 2)
|
|
(%closure-ref self$811 1)))
|
|
env$766
|
|
k$801)
|
|
exp$765))
|
|
(%closure-ref self$809 1))))
|
|
(%closure-ref self$808 1)
|
|
(%closure-ref self$808 2)
|
|
(%closure-ref self$808 3)
|
|
(%closure-ref self$808 4)
|
|
(%closure-ref self$808 5)
|
|
self-evaluating?$744)
|
|
(cell (%closure-ref self$808 6))))
|
|
(%closure-ref self$807 1)
|
|
(%closure-ref self$807 2)
|
|
(%closure-ref self$807 3)
|
|
(%closure-ref self$807 4)
|
|
quoted?$743
|
|
(%closure-ref self$807 6))
|
|
(cell (%closure-ref self$807 5))))
|
|
(%closure-ref self$806 1)
|
|
(%closure-ref self$806 2)
|
|
(%closure-ref self$806 3)
|
|
eval$741
|
|
(%closure-ref self$806 5)
|
|
(%closure-ref self$806 6))
|
|
(cell (%closure-ref self$806 4))))
|
|
(%closure-ref self$805 1)
|
|
(%closure-ref self$805 2)
|
|
analyze-self-evaluating$739
|
|
(%closure-ref self$805 4)
|
|
(%closure-ref self$805 5)
|
|
(%closure-ref self$805 6))
|
|
(cell (%closure-ref self$805 3))))
|
|
(%closure-ref self$804 1)
|
|
analyze-quoted$738
|
|
(%closure-ref self$804 3)
|
|
(%closure-ref self$804 4)
|
|
(%closure-ref self$804 5)
|
|
(%closure-ref self$804 6))
|
|
(cell (%closure-ref self$804 2))))
|
|
analyze$737
|
|
(%closure-ref self$803 2)
|
|
(%closure-ref self$803 3)
|
|
(%closure-ref self$803 4)
|
|
(%closure-ref self$803 5)
|
|
(%closure-ref self$803 6))
|
|
(cell (%closure-ref self$803 1))))
|
|
analyze-quoted$738
|
|
analyze-self-evaluating$739
|
|
eval$741
|
|
quoted?$743
|
|
self-evaluating?$744
|
|
tagged-list?$746)
|
|
(cell analyze$737)))
|
|
#f
|
|
#f
|
|
#f
|
|
#f
|
|
#f
|
|
#f
|
|
#f
|
|
#f
|
|
#f
|
|
#f))
|
|
(test-eval)
|
|
|
|
; l21 line 1565 - passes #f to l43, which then tries to execute it:
|
|
; according to scaffolding though, this is a problem in the transformed Scheme code
|
|
;
|
|
;static void __lambda_21(object self_73833, object r_73789) {
|
|
; if( !eq(quote_f, r_73789) ){
|
|
; return_funcall2( cell_get(((closureN)self_73833)->elts[0]), ((closureN)self_73833)->elts[2], ((closureN)self_73833)->elts[1]);
|
|
;} else {
|
|
; return_funcall1( ((closureN)self_73833)->elts[2], quote_f);}
|
|
;;
|
|
;}
|
|
;static void __lambda_43(object self_73811, object r_73802) {
|
|
; return_funcall2( r_73802, ((closureN)self_73811)->elts[1], ((closureN)self_73811)->elts[0]);;
|
|
;}
|
|
|
|
|