Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-22 07:09:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Get back up-and-running as a program

Browse source
This commit is contained in:
Justin Ethier 2018-12-13 18:22:46 -05:00
parent 0862070e52
commit dbca1ee36e
1 changed files with 241 additions and 220 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

461
scheme/cyclone/cps-opt-local-var-redux.scm
View file

@ -12,6 +12,7 @@
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme cyclone ast) (scheme cyclone ast)
(scheme cyclone primitives)
(scheme cyclone util) (scheme cyclone util)
(scheme cyclone pretty-print)))) (scheme cyclone pretty-print))))
@ -71,10 +72,14 @@
)) ))
(var (car (ast:lambda-args (cadr exp)))) (var (car (ast:lambda-args (cadr exp))))
(body (ast:lambda-body (cadr exp))) (body (ast:lambda-body (cadr exp)))
(av (adb:get/default var #f)) ;; Set to #f if unit testing (av (cond-expand
(program #f)
(else (adb:get/default var #f))))
(ref-count (ref-count
(if av (if av
(adbv:ref-count av) (cond-expand
(program #f)
(else (adbv:ref-count av)))
1)) ;; Dummy value 1)) ;; Dummy value
) )
(if (and (> ref-count 0) ;; 0 ==> local var is never used (if (and (> ref-count 0) ;; 0 ==> local var is never used
@ -178,228 +183,244 @@
(program (program
(define sexp (define sexp
'( '(
(define zunda ;(define zunda
((lambda ; ((lambda
(k$1057 first-row-perm$61$668 mat$62$669) ; (k$1057 first-row-perm$61$668 mat$62$669)
(first-row-perm$61$668 ; (first-row-perm$61$668
(lambda ; (lambda
(first-row$65$670) ; (first-row$65$670)
((lambda ; ((lambda
(number-of-cols$68$671) ; (number-of-cols$68$671)
((lambda ; ((lambda
(make-row->func$71$672) ; (make-row->func$71$672)
(first-row-perm$61$668 ; (first-row-perm$61$668
(lambda ; (lambda
(r$1062) ; (r$1062)
(make-row->func$71$672 ; (make-row->func$71$672
(lambda ; (lambda
(r$1063) ; (r$1063)
(make-row->func$71$672 ; (make-row->func$71$672
(lambda ; (lambda
(r$1064) ; (r$1064)
(zebra k$1057 ; (zebra k$1057
r$1062 ; r$1062
r$1063 ; r$1063
r$1064 ; r$1064
(cdr mat$62$669) ; (cdr mat$62$669)
number-of-cols$68$671)) ; number-of-cols$68$671))
-1 ; -1
1)) ; 1))
1 ; 1
-1)) ; -1))
'child)) ; 'child))
(lambda ; (lambda
(k$1066 if-equal$76$674 if-different$77$675) ; (k$1066 if-equal$76$674 if-different$77$675)
(k$1066 ; (k$1066
(lambda ; (lambda
(k$1067 row$78$676) ; (k$1067 row$78$676)
((lambda ; ((lambda
(vec$79$677) ; (vec$79$677)
((lambda ; ((lambda
(first$85$679 row$86$680) ; (first$85$679 row$86$680)
((lambda ; ((lambda
(lp$80$87$681) ; (lp$80$87$681)
((lambda ; ((lambda
(lp$80$87$681) ; (lp$80$87$681)
(Cyc-seq ; (Cyc-seq
(set! ; (set!
lp$80$87$681 ; lp$80$87$681
(lambda ; (lambda
(k$1073 i$88$682 first$89$683 row$90$684) ; (k$1073 i$88$682 first$89$683 row$90$684)
(if (Cyc-fast-eq ; (if (Cyc-fast-eq
i$88$682 ; i$88$682
number-of-cols$68$671) ; number-of-cols$68$671)
(k$1073 ; (k$1073
(Cyc-fast-eq ; (Cyc-fast-eq
i$88$682 ; i$88$682
number-of-cols$68$671)) ; number-of-cols$68$671))
((lambda ; ((lambda
(k$1080) ; (k$1080)
(if (Cyc-fast-eq ; (if (Cyc-fast-eq
(car first$89$683) ; (car first$89$683)
(car row$90$684)) ; (car row$90$684))
(k$1080 if-equal$76$674) ; (k$1080 if-equal$76$674)
(k$1080 if-different$77$675))) ; (k$1080 if-different$77$675)))
(lambda ; (lambda
(r$1079) ; (r$1079)
(Cyc-seq ; (Cyc-seq
(vector-set! ; (vector-set!
vec$79$677 ; vec$79$677
i$88$682 ; i$88$682
r$1079) ; r$1079)
((cell-get lp$80$87$681) ; ((cell-get lp$80$87$681)
k$1073 ; k$1073
(Cyc-fast-plus i$88$682 1) ; (Cyc-fast-plus i$88$682 1)
(cdr first$89$683) ; (cdr first$89$683)
(cdr row$90$684)))))))) ; (cdr row$90$684))))))))
((cell-get lp$80$87$681) ; ((cell-get lp$80$87$681)
(lambda ; (lambda
(r$1069) ; (r$1069)
(k$1067 ; (k$1067
(lambda ; (lambda
(k$1070 i$92$686) ; (k$1070 i$92$686)
(k$1070 ; (k$1070
(vector-ref vec$79$677 i$92$686))))) ; (vector-ref vec$79$677 i$92$686)))))
0 ; 0
first$85$679 ; first$85$679
row$86$680))) ; row$86$680)))
(cell lp$80$87$681))) ; (cell lp$80$87$681)))
#f)) ; #f))
first-row$65$670 ; first-row$65$670
row$78$676)) ; row$78$676))
(make-vector number-of-cols$68$671))))))) ; (make-vector number-of-cols$68$671)))))))
(length first-row$65$670))) ; (length first-row$65$670)))
'now)))) ; 'now))))
(define *num-passed* 0) ; (define *num-passed* 0)
(define write-to-string ;(define write-to-string
; (lambda
; (k$3086 x$892$1775)
; (call-with-output-string
; k$3086
; (lambda
; (k$3088 out$893$1776)
; ((lambda
; (x$895$1777)
; ((lambda
; (wr$896$1778)
; (Cyc-seq
; (set! wr$896$1778
; (lambda
; (k$3091 x$897$1779)
; (if (pair? x$897$1779)
; ((lambda
; (k$3112)
; (if (symbol? (car x$897$1779))
; (if (pair? (cdr x$897$1779))
; (if (null? (cddr x$897$1779))
; (k$3112
; (assq (car x$897$1779)
; '((quote . "'")
; (quasiquote . "`")
; (unquote . ",")
; (unquote-splicing . ",@"))))
; (k$3112 #f))
; (k$3112 #f))
; (k$3112 #f)))
; (lambda
; (tmp$900$902$1780)
; (if tmp$900$902$1780
; ((lambda
; (s$903$1781)
; (display
; (lambda
; (r$3094)
; (wr$896$1778 k$3091 (cadr x$897$1779)))
; (cdr s$903$1781)
; out$893$1776))
; tmp$900$902$1780)
; (display
; (lambda
; (r$3097)
; (wr$896$1778
; (lambda
; (r$3098)
; ((lambda
; (lp$907$1783)
; (Cyc-seq
; (set! lp$907$1783
; (lambda
; (k$3103 ls$908$1784)
; (if (pair? ls$908$1784)
; (display
; (lambda
; (r$3105)
; (wr$896$1778
; (lambda
; (r$3106)
; (lp$907$1783
; k$3103
; (cdr ls$908$1784)))
; (car ls$908$1784)))
; " "
; out$893$1776)
; (if (null? ls$908$1784)
; (k$3103 #f)
; (display
; (lambda
; (r$3110)
; (write k$3103
; ls$908$1784
; out$893$1776))
; " . "
; out$893$1776)))))
; (lp$907$1783
; (lambda
; (r$3099)
; (display k$3091 ")" out$893$1776))
; (cdr x$897$1779))))
; #f))
; (car x$897$1779)))
; "("
; out$893$1776))))
; (write k$3091 x$897$1779 out$893$1776))))
; (wr$896$1778 k$3088 x$895$1777)))
; #f))
; x$892$1775)))))
;(define match-gen-or-step
; (lambda
; (k$14021
; expr$3499$3540$3621$9398
; rename$3500$3541$3622$9399
; compare$3501$3542$3623$9400)
; ((lambda
; (v.1$3507$3599$3659$9436)
; ((lambda
; (k$14141)
; (if (pair? v.1$3507$3599$3659$9436)
; (Cyc-seq
; (car v.1$3507$3599$3659$9436)
; (if (pair? (cdr v.1$3507$3599$3659$9436))
; (if (null? (car (cdr v.1$3507$3599$3659$9436)))
; (if (pair? (cdr (cdr v.1$3507$3599$3659$9436)))
; (Cyc-seq
; (car (cdr (cdr v.1$3507$3599$3659$9436)))
; (if (pair? (cdr (cdr (cdr v.1$3507$3599$3659$9436))))
; (Cyc-seq
; (car (cdr (cdr (cdr v.1$3507$3599$3659$9436))))
; (if (pair? (cdr (cdr (cdr (cdr v.1$3507$3599$3659$9436)))))
; (Cyc-seq
; (cdr (cdr (cdr (cdr (cdr v.1$3507$3599$3659$9436)))))
; (k$14141
; (cons (car (cdr (cdr (cdr (cdr v.1$3507$3599$3659$9436)))))
; #f)))
; (k$14141 #f)))
; (k$14141 #f)))
; (k$14141 #f))
; (k$14141 #f))
; (k$14141 #f)))
; (k$14141 #f)))
; (lambda
; (tmp$3544$3546$3624$9401)
; (list
; (lambda (r$14022) (k$14021 (car r$14022)))))))
; (cdr expr$3499$3540$3621$9398))))
(define slot-set!
(lambda (lambda
(k$3086 x$892$1775) (k$7170
(call-with-output-string name$2424$3603
k$3086 obj$2425$3604
(lambda idx$2426$3605
(k$3088 out$893$1776) val$2427$3606)
((lambda
(x$895$1777)
((lambda
(wr$896$1778)
(Cyc-seq
(set! wr$896$1778
(lambda
(k$3091 x$897$1779)
(if (pair? x$897$1779)
((lambda
(k$3112)
(if (symbol? (car x$897$1779))
(if (pair? (cdr x$897$1779))
(if (null? (cddr x$897$1779))
(k$3112
(assq (car x$897$1779)
'((quote . "'")
(quasiquote . "`")
(unquote . ",")
(unquote-splicing . ",@"))))
(k$3112 #f))
(k$3112 #f))
(k$3112 #f)))
(lambda
(tmp$900$902$1780)
(if tmp$900$902$1780
((lambda
(s$903$1781)
(display
(lambda
(r$3094)
(wr$896$1778 k$3091 (cadr x$897$1779)))
(cdr s$903$1781)
out$893$1776))
tmp$900$902$1780)
(display
(lambda
(r$3097)
(wr$896$1778
(lambda
(r$3098)
((lambda
(lp$907$1783)
(Cyc-seq
(set! lp$907$1783
(lambda
(k$3103 ls$908$1784)
(if (pair? ls$908$1784)
(display
(lambda
(r$3105)
(wr$896$1778
(lambda
(r$3106)
(lp$907$1783
k$3103
(cdr ls$908$1784)))
(car ls$908$1784)))
" "
out$893$1776)
(if (null? ls$908$1784)
(k$3103 #f)
(display
(lambda
(r$3110)
(write k$3103
ls$908$1784
out$893$1776))
" . "
out$893$1776)))))
(lp$907$1783
(lambda
(r$3099)
(display k$3091 ")" out$893$1776))
(cdr x$897$1779))))
#f))
(car x$897$1779)))
"("
out$893$1776))))
(write k$3091 x$897$1779 out$893$1776))))
(wr$896$1778 k$3088 x$895$1777)))
#f))
x$892$1775)))))
(define match-gen-or-step
(lambda
(k$14021
expr$3499$3540$3621$9398
rename$3500$3541$3622$9399
compare$3501$3542$3623$9400)
((lambda ((lambda
(v.1$3507$3599$3659$9436) (vec$2428$3607)
((lambda ((lambda
(k$14141) (r$7171)
(if (pair? v.1$3507$3599$3659$9436) (k$7170
(Cyc-seq (vector-set! r$7171 idx$2426$3605 val$2427$3606)))
(car v.1$3507$3599$3659$9436) (vector-ref vec$2428$3607 2)))
(if (pair? (cdr v.1$3507$3599$3659$9436)) obj$2425$3604)))
(if (null? (car (cdr v.1$3507$3599$3659$9436)))
(if (pair? (cdr (cdr v.1$3507$3599$3659$9436)))
(Cyc-seq
(car (cdr (cdr v.1$3507$3599$3659$9436)))
(if (pair? (cdr (cdr (cdr v.1$3507$3599$3659$9436))))
(Cyc-seq
(car (cdr (cdr (cdr v.1$3507$3599$3659$9436))))
(if (pair? (cdr (cdr (cdr (cdr v.1$3507$3599$3659$9436)))))
(Cyc-seq
(cdr (cdr (cdr (cdr (cdr v.1$3507$3599$3659$9436)))))
(k$14141
(cons (car (cdr (cdr (cdr (cdr v.1$3507$3599$3659$9436)))))
#f)))
(k$14141 #f)))
(k$14141 #f)))
(k$14141 #f))
(k$14141 #f))
(k$14141 #f)))
(k$14141 #f)))
(lambda
(tmp$3544$3546$3624$9401)
(list
(lambda (r$14022) (k$14021 (car r$14022)))))))
(cdr expr$3499$3540$3621$9398))))
) )
) )