Added a special (program) feature

This commit is contained in:
Justin Ethier 2018-11-10 06:52:54 -05:00
parent 74e56aeb2f
commit 8cbcf82121
2 changed files with 53 additions and 41 deletions

View file

@ -547,10 +547,13 @@
(in-prog-raw (read-file in-file)) (in-prog-raw (read-file in-file))
(program? (not (library? (car in-prog-raw)))) (program? (not (library? (car in-prog-raw))))
(in-prog (in-prog
(if program? (cond
in-prog-raw (program?
(Cyc-add-feature! 'program) ;; Load special feature
in-prog-raw)
(else
;; Account for any cond-expand declarations in the library ;; Account for any cond-expand declarations in the library
(list (lib:cond-expand (car in-prog-raw) expander)))) (list (lib:cond-expand (car in-prog-raw) expander)))))
;; TODO: expand in-prog, if a library, using lib:cond-expand. (OK, this works now) ;; TODO: expand in-prog, if a library, using lib:cond-expand. (OK, this works now)
;; TODO: will also need to do below in lib:get-all-import-deps, after reading each library ;; TODO: will also need to do below in lib:get-all-import-deps, after reading each library
(program:imports/code (if program? (import-reduction in-prog expander) '())) (program:imports/code (if program? (import-reduction in-prog expander) '()))

View file

@ -1,4 +1,10 @@
(import (scheme base) (scheme write) (scheme cyclone ast) (scheme cyclone util) (scheme cyclone pretty-print)) (cond-expand
(program
(import (scheme base)
(scheme write)
(scheme cyclone ast)
(scheme cyclone util)
(scheme cyclone pretty-print))))
;; Local variable reduction: ;; Local variable reduction:
;; Reduce given sexp by replacing certain lambda calls with a let containing ;; Reduce given sexp by replacing certain lambda calls with a let containing
@ -122,40 +128,43 @@
(return (return
(scan sexp))))) (scan sexp)))))
(define sexp (cond-expand
'(lambda (program
(k$1073 i$88$682 first$89$683 row$90$684) (define sexp
(if (Cyc-fast-eq '(lambda
i$88$682 (k$1073 i$88$682 first$89$683 row$90$684)
number-of-cols$68$671) (if (Cyc-fast-eq
(k$1073 i$88$682
(Cyc-fast-eq number-of-cols$68$671)
i$88$682 (k$1073
number-of-cols$68$671)) (Cyc-fast-eq
((lambda i$88$682
(k$1080) number-of-cols$68$671))
(if (Cyc-fast-eq ((lambda
(car first$89$683) (k$1080)
(car row$90$684)) (if (Cyc-fast-eq
(k$1080 if-equal$76$674) (car first$89$683)
(k$1080 if-different$77$675))) (car row$90$684))
(lambda (k$1080 if-equal$76$674)
(r$1079) (k$1080 if-different$77$675)))
(Cyc-seq (lambda
(vector-set! (r$1079)
vec$79$677 (Cyc-seq
i$88$682 (vector-set!
r$1079) vec$79$677
((cell-get lp$80$87$681) i$88$682
k$1073 r$1079)
(Cyc-fast-plus i$88$682 1) ((cell-get lp$80$87$681)
(cdr first$89$683) k$1073
(cdr row$90$684)))))))) (Cyc-fast-plus i$88$682 1)
(cdr first$89$683)
(cdr row$90$684))))))))
;(pretty-print ;(pretty-print
; (ast:ast->pp-sexp ; (ast:ast->pp-sexp
; (ast:sexp->ast sexp))) ; (ast:sexp->ast sexp)))
(pretty-print (pretty-print
(ast:ast->pp-sexp (ast:ast->pp-sexp
(opt:local-var-reduction (ast:sexp->ast sexp)))) (opt:local-var-reduction (ast:sexp->ast sexp))))
))