From b2f45026518602ead53ef0181a25f9614a98ae27 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 31 Aug 2018 19:50:58 -0400 Subject: [PATCH 01/19] WIP - preserve AST through to closure-conversion --- cyclone.scm | 2 +- scheme/cyclone/cps-optimizations.sld | 34 +++++++++++++++------------- scheme/cyclone/transforms.sld | 31 ++++++++++++++++--------- 3 files changed, 39 insertions(+), 28 deletions(-) diff --git a/cyclone.scm b/cyclone.scm index a0e4011b..ed495cb0 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -432,7 +432,7 @@ (wrap-mutables expr globals)) input-program)) (trace:info "---------------- after wrap-mutables:") - (trace:info input-program) ;pretty-print + (trace:info (ast:ast->pp-sexp input-program)) (set! input-program (map diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld index a05c2cc2..5a285943 100644 --- a/scheme/cyclone/cps-optimizations.sld +++ b/scheme/cyclone/cps-optimizations.sld @@ -1573,7 +1573,24 @@ (define (_closure-convert exp globals optimization-level) (define (convert exp self-var free-var-lst) (define (cc exp) +;(trace:error `(cc ,exp)) (cond + ((ast:lambda? exp) + (let* ((new-self-var (gensym 'self)) + (body (ast:lambda-body exp)) + (new-free-vars + (difference + (difference (free-vars body) (ast:lambda-formals->list exp)) + globals))) + `(%closure + (lambda + ,(list->lambda-formals + (cons new-self-var (ast:lambda-formals->list exp)) + (ast:lambda-formals-type exp)) + ,(convert (car body) new-self-var new-free-vars)) ;; TODO: should this be a map??? was a list in 90-min-scc. + ,@(map (lambda (v) ;; TODO: splice here? + (cc v)) + new-free-vars)))) ((const? exp) exp) ((quote? exp) exp) ((ref? exp) @@ -1591,22 +1608,7 @@ ,@(map cc (cdr exp)))) ;; TODO: need to splice? ((set!? exp) `(set! ,(set!->var exp) ,(cc (set!->exp exp)))) - ((lambda? exp) - (let* ((new-self-var (gensym 'self)) - (body (lambda->exp exp)) - (new-free-vars - (difference - (difference (free-vars body) (lambda-formals->list exp)) - globals))) - `(%closure - (lambda - ,(list->lambda-formals - (cons new-self-var (lambda-formals->list exp)) - (lambda-formals-type exp)) - ,(convert (car body) new-self-var new-free-vars)) ;; TODO: should this be a map??? was a list in 90-min-scc. - ,@(map (lambda (v) ;; TODO: splice here? - (cc v)) - new-free-vars)))) + ((lambda? exp) (error `(Unexpected lambda in closure-convert ,exp))) ((if? exp) `(if ,@(map cc (cdr exp)))) ((cell? exp) `(cell ,(cc (cell->value exp)))) ((cell-get? exp) `(cell-get ,(cc (cell-get->cell exp)))) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index add78d10..c851f472 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -726,22 +726,33 @@ ; wrap-mutables : exp -> exp (define (wrap-mutables exp globals) - (define (wrap-mutable-formals formals body-exp) + (define (wrap-mutable-formals id formals body-exp has-cont) (if (not (pair? formals)) body-exp + ;(list body-exp) (if (is-mutable? (car formals)) - `((lambda (,(car formals)) - ,(wrap-mutable-formals (cdr formals) body-exp)) - (cell ,(car formals))) - (wrap-mutable-formals (cdr formals) body-exp)))) + (list ;(ast:%make-lambda + ; id + (ast:make-lambda + (list (car formals)) + (wrap-mutable-formals id (cdr formals) body-exp has-cont) + has-cont) + `(cell ,(car formals))) + (wrap-mutable-formals id (cdr formals) body-exp has-cont)))) (cond ; Core forms: ((ast:lambda? exp) - `(lambda ,(ast:lambda-args exp) - ,(wrap-mutable-formals + (ast:%make-lambda + (ast:lambda-id exp) + (ast:lambda-args exp) + (wrap-mutable-formals + (ast:lambda-id exp) (ast:lambda-formals->list exp) - (wrap-mutables (car (ast:lambda-body exp)) globals)))) ;; Assume single expr in lambda body, since after CPS phase + (wrap-mutables (car (ast:lambda-body exp)) globals) + (ast:lambda-has-cont exp)) + (ast:lambda-has-cont exp) + )) ;; Assume single expr in lambda body, since after CPS phase ((const? exp) exp) ((ref? exp) (if (and (not (member exp globals)) (is-mutable? exp)) @@ -749,9 +760,7 @@ exp)) ((prim? exp) exp) ((quote? exp) exp) - ((lambda? exp) `(lambda ,(lambda->formals exp) - ,(wrap-mutable-formals (lambda-formals->list exp) - (wrap-mutables (car (lambda->exp exp)) globals)))) ;; Assume single expr in lambda body, since after CPS phase + ((lambda? exp) (error `(Unexpected lambda in wrap-mutables ,exp))) ((set!? exp) `(,(if (member (set!->var exp) globals) 'set-global! 'set-cell!) From 8f8df24b1519386d7e98166003541e4a7a691513 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 4 Sep 2018 13:09:50 -0400 Subject: [PATCH 02/19] WIP, generate proper AST output from wrap-muts --- scheme/cyclone/transforms.sld | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index c851f472..b1a799d6 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -749,7 +749,7 @@ (wrap-mutable-formals (ast:lambda-id exp) (ast:lambda-formals->list exp) - (wrap-mutables (car (ast:lambda-body exp)) globals) + (list (wrap-mutables (car (ast:lambda-body exp)) globals)) (ast:lambda-has-cont exp)) (ast:lambda-has-cont exp) )) ;; Assume single expr in lambda body, since after CPS phase From 7b764535916662c832cadbe000020b7ded592446 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 4 Sep 2018 19:00:22 -0400 Subject: [PATCH 03/19] WIP - passing AST lambda's to closure-convert --- scheme/cyclone/cps-optimizations.sld | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld index 5a285943..ee78c15e 100644 --- a/scheme/cyclone/cps-optimizations.sld +++ b/scheme/cyclone/cps-optimizations.sld @@ -1618,16 +1618,16 @@ (let ((fn (car exp)) (args (map cc (cdr exp)))) (cond - ((lambda? fn) + ((ast:lambda? fn) (cond ;; If the lambda argument is not used, flag so the C code is ;; all generated within the same function ((and #f (> optimization-level 0) - (eq? (lambda-formals-type fn) 'args:fixed) - (pair? (lambda-formals->list fn)) + (eq? (ast:lambda-formals-type fn) 'args:fixed) + (pair? (ast:lambda-formals->list fn)) (with-var - (car (lambda-formals->list fn)) + (car (ast:lambda-formals->list fn)) (lambda (var) (zero? (adbv:ref-count var)))) ;; Non-CPS args @@ -1640,12 +1640,12 @@ args)) `(Cyc-seq ,@args - ,@(map cc (lambda->exp fn)))) + ,@(map cc (ast:lambda-body fn)))) (else - (let* ((body (lambda->exp fn)) + (let* ((body (ast:lambda-body fn)) (new-free-vars (difference - (difference (free-vars body) (lambda-formals->list fn)) + (difference (free-vars body) (ast:lambda-formals->list fn)) globals)) (new-free-vars? (> (length new-free-vars) 0))) (if new-free-vars? @@ -1654,16 +1654,17 @@ `((%closure (lambda ,(list->lambda-formals - (cons new-self-var (lambda-formals->list fn)) - (lambda-formals-type fn)) + (cons new-self-var (ast:lambda-formals->list fn)) + (ast:lambda-formals-type fn)) ,(convert (car body) new-self-var new-free-vars)) ,@(map (lambda (v) (cc v)) new-free-vars)) ,@args)) ; No free vars, just create simple lambda - `((lambda ,(lambda->formals fn) + `((lambda ,(ast:lambda-args fn) ,@(map cc body)) ,@args)))))) + ((lambda? fn) (error `(Unexpected lambda in closure-convert ,exp))) (else (let ((f (cc fn))) `((%closure-ref ,f 0) From cc1bfea6f02c0ee9c495a81eaf5ea12b0bef41c0 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 5 Sep 2018 12:51:21 -0400 Subject: [PATCH 04/19] Update (free-vars) to include AST support --- scheme/cyclone/transforms.sld | 3 +++ 1 file changed, 3 insertions(+) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index b1a799d6..b2732f4e 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -630,6 +630,9 @@ (define (search exp) (cond ; Core forms: + ((ast:lambda? exp) + (difference (reduce union (map search (ast:lambda-body exp)) '()) + (ast:lambda-formals->list exp))) ((const? exp) '()) ((prim? exp) '()) ((quote? exp) '()) From 9d606f9d432274a300de0e0a2e0f112e8e12ab1a Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 5 Sep 2018 17:45:02 -0400 Subject: [PATCH 05/19] Fix for AST output for wrap-mutables --- scheme/cyclone/transforms.sld | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index b2732f4e..36cf7c3c 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -734,13 +734,14 @@ body-exp ;(list body-exp) (if (is-mutable? (car formals)) - (list ;(ast:%make-lambda - ; id - (ast:make-lambda - (list (car formals)) - (wrap-mutable-formals id (cdr formals) body-exp has-cont) - has-cont) - `(cell ,(car formals))) + (list + (list ;(ast:%make-lambda + ; id + (ast:make-lambda + (list (car formals)) + (wrap-mutable-formals id (cdr formals) body-exp has-cont) + has-cont) + `(cell ,(car formals)))) (wrap-mutable-formals id (cdr formals) body-exp has-cont)))) (cond From 4cf407ebe6a55afb0d698b907ba1b9db9b0f646f Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 5 Sep 2018 17:41:47 -0400 Subject: [PATCH 06/19] Issue #275 - Return #f instead of raising error --- CHANGELOG.md | 4 ++++ scheme/base.sld | 16 ++++++++++++---- 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index dff97050..6205faef 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,10 @@ ## 0.9.3 - TBD +Bug Fixes + +- Fix `input-port?`, `output-port?`, `input-port-open?`, and `output-port-open?` to return `#f` instead of crashing when a non-port object is passed. + ## 0.9.2 - August 26, 2018 Features diff --git a/scheme/base.sld b/scheme/base.sld index 441d9785..3a9155c7 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -1360,7 +1360,9 @@ (define-c input-port? "(void *data, int argc, closure _, object k, object port)" " port_type *p = (port_type *)port; - Cyc_check_port(data, port); + if (boolean_f == Cyc_is_port(port)) { + return_closcall1(data, k, boolean_f); + } return_closcall1( data, k, @@ -1368,7 +1370,9 @@ (define-c output-port? "(void *data, int argc, closure _, object k, object port)" " port_type *p = (port_type *)port; - Cyc_check_port(data, port); + if (boolean_f == Cyc_is_port(port)) { + return_closcall1(data, k, boolean_f); + } return_closcall1( data, k, @@ -1376,7 +1380,9 @@ (define-c input-port-open? "(void *data, int argc, closure _, object k, object port)" " port_type *p = (port_type *)port; - Cyc_check_port(data, port); + if (boolean_f == Cyc_is_port(port)) { + return_closcall1(data, k, boolean_f); + } return_closcall1( data, k, @@ -1384,7 +1390,9 @@ (define-c output-port-open? "(void *data, int argc, closure _, object k, object port)" " port_type *p = (port_type *)port; - Cyc_check_port(data, port); + if (boolean_f == Cyc_is_port(port)) { + return_closcall1(data, k, boolean_f); + } return_closcall1( data, k, From a5489fca4682cc51fb9fc675a9c132ccc8914ac1 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 5 Sep 2018 18:00:55 -0400 Subject: [PATCH 07/19] Issue #275 - Allow pretty printing of bytevectors --- scheme/cyclone/pretty-print.sld | 3 +++ 1 file changed, 3 insertions(+) diff --git a/scheme/cyclone/pretty-print.sld b/scheme/cyclone/pretty-print.sld index 8e052d3b..a9fc91ba 100644 --- a/scheme/cyclone/pretty-print.sld +++ b/scheme/cyclone/pretty-print.sld @@ -84,6 +84,9 @@ (cond ((pair? obj) (wr-expr obj col)) ((null? obj) (wr-lst obj col)) ((vector? obj) (wr-lst (vector->list obj) (out "#" col))) + ((bytevector? obj) (wr-lst + (map char->integer (string->list (utf8->string obj))) + (out "#u8" col))) ((boolean? obj) (out (if obj "#t" "#f") col)) ((number? obj) (out (number->string obj) col)) ((symbol? obj) (out (symbol->string obj) col)) From b383ea6d012e1646d2501241a72f4fb74fa45c54 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 5 Sep 2018 18:02:03 -0400 Subject: [PATCH 08/19] Issue #275 --- CHANGELOG.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6205faef..a90d56d5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,10 @@ ## 0.9.3 - TBD +Features + +- Allow pretty printing of bytevectors. + Bug Fixes - Fix `input-port?`, `output-port?`, `input-port-open?`, and `output-port-open?` to return `#f` instead of crashing when a non-port object is passed. From 8e75b435d7735658429e42c934ddce75c3d28967 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 5 Sep 2018 18:56:57 -0400 Subject: [PATCH 09/19] WIP, emit AST lambda's from closure convert --- scheme/cyclone/cps-optimizations.sld | 35 +++++++++++++++++++--------- 1 file changed, 24 insertions(+), 11 deletions(-) diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld index ee78c15e..10f81690 100644 --- a/scheme/cyclone/cps-optimizations.sld +++ b/scheme/cyclone/cps-optimizations.sld @@ -1583,11 +1583,13 @@ (difference (free-vars body) (ast:lambda-formals->list exp)) globals))) `(%closure - (lambda - ,(list->lambda-formals + ,(ast:%make-lambda + (ast:lambda-id exp) + (list->lambda-formals (cons new-self-var (ast:lambda-formals->list exp)) (ast:lambda-formals-type exp)) - ,(convert (car body) new-self-var new-free-vars)) ;; TODO: should this be a map??? was a list in 90-min-scc. + (convert (car body) new-self-var new-free-vars) + (ast:lambda-has-cont exp)) ,@(map (lambda (v) ;; TODO: splice here? (cc v)) new-free-vars)))) @@ -1652,18 +1654,27 @@ ; Free vars, create a closure for them (let* ((new-self-var (gensym 'self))) `((%closure - (lambda - ,(list->lambda-formals + ,(ast:%make-lambda + (ast:lambda-id fn) + (list->lambda-formals (cons new-self-var (ast:lambda-formals->list fn)) (ast:lambda-formals-type fn)) - ,(convert (car body) new-self-var new-free-vars)) + (convert (car body) new-self-var new-free-vars) + (ast:lambda-has-cont fn) + ) ,@(map (lambda (v) (cc v)) new-free-vars)) ,@args)) ; No free vars, just create simple lambda - `((lambda ,(ast:lambda-args fn) - ,@(map cc body)) - ,@args)))))) + `(,(ast:%make-lambda + (ast:lambda-id fn) + (ast:lambda-args fn) + (map cc body) + (ast:lambda-has-cont fn) + ) + ,@args) + + ))))) ((lambda? fn) (error `(Unexpected lambda in closure-convert ,exp))) (else (let ((f (cc fn))) @@ -1674,8 +1685,10 @@ (error "unhandled exp: " exp)))) (cc exp)) - `(lambda () - ,(convert exp #f '()))) + (ast:make-lambda + (list) + (convert exp #f '()) + #f)) (define (analyze:find-named-lets exp) (define (scan exp lp) From bea564450396b69a08390e4f14478bbcd0d5f87b Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 6 Sep 2018 12:53:26 -0400 Subject: [PATCH 10/19] Pretty-print closure converted code --- cyclone.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cyclone.scm b/cyclone.scm index ed495cb0..a95c486d 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -451,7 +451,7 @@ ; (caddr ;; Strip off superfluous lambda ; (closure-convert input-program))) (trace:info "---------------- after closure-convert:") - (trace:info input-program) ;pretty-print + (trace:info (ast:ast->pp-sexp input-program)) (when (not *do-code-gen*) (trace:error "DEBUG, existing program") From 8359f7a6f93c284a25b6a6fcf2848e80ac6db7b4 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 6 Sep 2018 13:32:01 -0400 Subject: [PATCH 11/19] WIP - emit AST lambda's from closure convert --- cyclone.scm | 8 +++----- scheme/cyclone/cps-optimizations.sld | 6 +++--- 2 files changed, 6 insertions(+), 8 deletions(-) diff --git a/cyclone.scm b/cyclone.scm index a95c486d..7d7e2e73 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -441,15 +441,13 @@ ((define? expr) ;; Global `(define ,(define->var expr) - ,@(caddr (closure-convert (define->exp expr) globals *optimization-level*)))) + ,@(car (ast:lambda-body (closure-convert (define->exp expr) globals *optimization-level*))))) ((define-c? expr) expr) (else - (caddr ;; Strip off superfluous lambda - (closure-convert expr globals *optimization-level*))))) + (car (ast:lambda-body ;; Strip off superfluous lambda + (closure-convert expr globals *optimization-level*)))))) input-program)) - ; (caddr ;; Strip off superfluous lambda - ; (closure-convert input-program))) (trace:info "---------------- after closure-convert:") (trace:info (ast:ast->pp-sexp input-program)) diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld index 10f81690..1cb20d9b 100644 --- a/scheme/cyclone/cps-optimizations.sld +++ b/scheme/cyclone/cps-optimizations.sld @@ -1588,7 +1588,7 @@ (list->lambda-formals (cons new-self-var (ast:lambda-formals->list exp)) (ast:lambda-formals-type exp)) - (convert (car body) new-self-var new-free-vars) + (list (convert (car body) new-self-var new-free-vars)) (ast:lambda-has-cont exp)) ,@(map (lambda (v) ;; TODO: splice here? (cc v)) @@ -1659,7 +1659,7 @@ (list->lambda-formals (cons new-self-var (ast:lambda-formals->list fn)) (ast:lambda-formals-type fn)) - (convert (car body) new-self-var new-free-vars) + (list (convert (car body) new-self-var new-free-vars)) (ast:lambda-has-cont fn) ) ,@(map (lambda (v) (cc v)) @@ -1687,7 +1687,7 @@ (ast:make-lambda (list) - (convert exp #f '()) + (list (convert exp #f '())) #f)) (define (analyze:find-named-lets exp) From 941930af35f7efb3bdb4ef009772c5dfe44b30bd Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 6 Sep 2018 18:55:43 -0400 Subject: [PATCH 12/19] WIP - AST lambda integration --- scheme/cyclone/cgen.sld | 69 +++++++++++++++++++++-------------------- 1 file changed, 36 insertions(+), 33 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 6d163417..bea9c0e0 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -717,6 +717,28 @@ (let* ((args (app->args exp)) (fun (app->fun exp))) (cond + ((ast:lambda? fun) + (let* ((lid (allocate-lambda (c-compile-lambda fun trace #t))) ;; TODO: pass in free vars? may be needed to track closures + ;; properly, wait until this comes up in an example + (this-cont (string-append "__lambda_" (number->string lid))) + (cgen + (c-compile-args + args + append-preamble + "" + this-cont + trace + cps?)) + (num-cargs (c:num-args cgen))) + (set-c-call-arity! num-cargs) + (c-code + (string-append + (c:allocs->str (c:allocs cgen)) + "return_direct" (number->string num-cargs) + "(data," this-cont + (if (> num-cargs 0) "," "") ; TODO: how to propagate continuation - cont " " + (c:body cgen) ");")))) + ;; Direct recursive call of top-level function ((and (pair? trace) (not (null? (cdr trace))) @@ -770,28 +792,6 @@ "goto loop;"))) ) - ((lambda? fun) - (let* ((lid (allocate-lambda (c-compile-lambda fun trace #t))) ;; TODO: pass in free vars? may be needed to track closures - ;; properly, wait until this comes up in an example - (this-cont (string-append "__lambda_" (number->string lid))) - (cgen - (c-compile-args - args - append-preamble - "" - this-cont - trace - cps?)) - (num-cargs (c:num-args cgen))) - (set-c-call-arity! num-cargs) - (c-code - (string-append - (c:allocs->str (c:allocs cgen)) - "return_direct" (number->string num-cargs) - "(data," this-cont - (if (> num-cargs 0) "," "") ; TODO: how to propagate continuation - cont " " - (c:body cgen) ");")))) - ((prim? fun) (let* ((c-fun (c-compile-prim fun cont)) @@ -1076,6 +1076,7 @@ (define inline-lambdas '()) ; allocate-lambda : (string -> string) -> lambda-id +TODO: check everything calling this function and/or using lambdas (define (allocate-lambda lam . cps?) (let ((id num-lambdas)) (set! num-lambdas (+ 1 num-lambdas)) @@ -1089,7 +1090,7 @@ ; (cdr (assv id lambdas))) (define (lambda->env exp) - (let ((formals (lambda-formals->list exp))) + (let ((formals (ast:lambda-formals->list exp))) (if (pair? formals) (car formals) 'unused))) @@ -1254,13 +1255,13 @@ (let* ((formals (c-compile-formals (if (not cps?) ;; Ignore continuation (k) arg for non-CPS funcs - (cdr (lambda->formals exp)) - (lambda->formals exp)) - (lambda-formals-type exp))) - (tmp-ident (if (> (length (lambda-formals->list exp)) 0) - (mangle (if (pair? (lambda->formals exp)) - (car (lambda->formals exp)) - (lambda->formals exp))) + (cdr (ast:lambda-args exp)) + (ast:lambda-args exp)) + (ast:lambda-formals-type exp))) + (tmp-ident (if (> (length (ast:lambda-formals->list exp)) 0) + (mangle (if (pair? (ast:lambda-args exp)) + (car (ast:lambda-args exp)) + (ast:lambda-args exp))) "")) (return-type (if cps? "void" "object")) @@ -1288,7 +1289,7 @@ formals)) (env-closure (lambda->env exp)) (body (c-compile-exp - (car (lambda->exp exp)) ;; car ==> assume single expr in lambda body after CPS + (car (ast:lambda-body exp)) ;; car ==> assume single expr in lambda body after CPS append-preamble (mangle env-closure) trace @@ -1300,18 +1301,20 @@ formals* ") {\n" preamble + TODO: this and the rest of the "exp" instances in this function: (if (lambda-varargs? exp) ;; Load varargs from C stack into Scheme list (string-append ; DEBUGGING: ;"printf(\"%d %d\\n\", argc, " - ; (number->string (length (lambda-formals->list exp))) ");" + ; (number->string (length (ast:lambda-formals->list exp))) ");" "load_varargs(" + TODO: ast equivalents for these next two: (mangle (lambda-varargs-var exp)) ", " (mangle (lambda-varargs-var exp)) "_raw, argc - " (number->string - (- (length (lambda-formals->list exp)) + (- (length (ast:lambda-formals->list exp)) 1 (if has-closure? 1 0))) ");\n"); From 8b74b495fb4b6dcc1f72f9fc723cd9c7cbf29166 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 7 Sep 2018 17:39:10 -0400 Subject: [PATCH 13/19] WIP --- scheme/cyclone/cgen.sld | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index bea9c0e0..fbcbaf1a 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -330,6 +330,7 @@ ((define-c? exp) (c-compile-raw-global-lambda exp append-preamble cont trace)) ; Special case - global function w/out a closure. Create an empty closure +TODO: convert to ast lambda ((tagged-list? 'lambda exp) (c-compile-exp `(%closure ,exp) @@ -961,6 +962,7 @@ ;(write `(add-global ,var-sym ,code)) (set! *globals* (cons (list var-sym lambda? code) *globals*))) (define (c-compile-global exp append-preamble cont trace) +TODO: assumes lambda's below: (let ((var (define->var exp)) (body (if (equal? 4 (length exp)) ; Simple var assignment contains superfluous %closure-ref (cadddr exp) @@ -1075,8 +1077,11 @@ (define lambdas '()) (define inline-lambdas '()) +;; TODO: may need to pass in AST lambda ID and store a mapping +;; of cgen lambda ID to it, in order to use data from the +;; analysis DB later on during code generation. +;; ; allocate-lambda : (string -> string) -> lambda-id -TODO: check everything calling this function and/or using lambdas (define (allocate-lambda lam . cps?) (let ((id num-lambdas)) (set! num-lambdas (+ 1 num-lambdas)) @@ -1301,18 +1306,16 @@ TODO: check everything calling this function and/or using lambdas formals* ") {\n" preamble - TODO: this and the rest of the "exp" instances in this function: - (if (lambda-varargs? exp) + (if (ast:lambda-varargs? exp) ;; Load varargs from C stack into Scheme list (string-append ; DEBUGGING: ;"printf(\"%d %d\\n\", argc, " ; (number->string (length (ast:lambda-formals->list exp))) ");" "load_varargs(" - TODO: ast equivalents for these next two: - (mangle (lambda-varargs-var exp)) + (mangle (ast:lambda-varargs-var exp)) ", " - (mangle (lambda-varargs-var exp)) + (mangle (ast:lambda-varargs-var exp)) "_raw, argc - " (number->string (- (length (ast:lambda-formals->list exp)) 1 @@ -1340,6 +1343,18 @@ TODO: check everything calling this function and/or using lambdas (define cgen:mangle-global #f) +(define (ast:lambda-varargs-var exp) + (if (ast:lambda-varargs? exp) + (if (equal? (ast:lambda-formals-type exp) 'args:varargs) + (ast:lambda-args exp) ; take symbol directly + (car (reverse (ast:lambda-formals->list exp)))) ; Last arg is varargs + #f)) + +(define (ast:lambda-varargs? exp) + (let ((type (ast:lambda-formals-type exp))) + (or (equal? type 'args:varargs) + (equal? type 'args:fixed-with-varargs)))) + ;; Convert a library name to string, so it can be ;; appended to the identifiers it exports. (define (import->string import) From ee68cce67a1bd3a170cc5c49c5369db31e002d84 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sat, 8 Sep 2018 21:34:47 -0400 Subject: [PATCH 14/19] Update CHANGELOG.md --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index a90d56d5..cf14fbb2 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,7 +8,7 @@ Features Bug Fixes -- Fix `input-port?`, `output-port?`, `input-port-open?`, and `output-port-open?` to return `#f` instead of crashing when a non-port object is passed. +- Fix `input-port?`, `output-port?`, `input-port-open?`, and `output-port-open?` to return `#f` instead of raising an error when a non-port object is passed. ## 0.9.2 - August 26, 2018 From e0f3ef9e76716ce7d0cb5f9b36ececf9dff3fb8b Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sat, 8 Sep 2018 19:09:03 -0400 Subject: [PATCH 15/19] WIP --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index cf14fbb2..cee80b63 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,6 @@ # Changelog -## 0.9.3 - TBD +## 0.9.3 - TBD Features From c84a2ab35645e637a09950110cb7a29810f0eaaf Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 10 Sep 2018 13:39:38 -0400 Subject: [PATCH 16/19] Issue #276 --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index cee80b63..28a91486 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,7 @@ Features Bug Fixes - Fix `input-port?`, `output-port?`, `input-port-open?`, and `output-port-open?` to return `#f` instead of raising an error when a non-port object is passed. +- Fix overflow detection when performing fixnum multiplication to avoid undefined behavior in the C runtime. ## 0.9.2 - August 26, 2018 From f8af9833e1977e5b8b35c4a279dca45e99acfafa Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 11 Sep 2018 12:47:58 -0400 Subject: [PATCH 17/19] WIP --- scheme/cyclone/cgen.sld | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index fbcbaf1a..3b1e7aa7 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -312,6 +312,11 @@ ;; require CPS, so this flag is not applicable to them. (define (c-compile-exp exp append-preamble cont trace cps?) (cond + ; Special case - global function w/out a closure. Create an empty closure + ((ast:lambda? exp) + (c-compile-exp + `(%closure ,exp) + append-preamble cont trace cps?)) ; Core forms: ((const? exp) (c-compile-const exp)) ((prim? exp) @@ -329,12 +334,6 @@ (c-compile-global exp append-preamble cont trace)) ((define-c? exp) (c-compile-raw-global-lambda exp append-preamble cont trace)) - ; Special case - global function w/out a closure. Create an empty closure -TODO: convert to ast lambda - ((tagged-list? 'lambda exp) - (c-compile-exp - `(%closure ,exp) - append-preamble cont trace cps?)) ; Application: ((app? exp) (c-compile-app exp append-preamble cont trace cps?)) @@ -962,14 +961,13 @@ TODO: convert to ast lambda ;(write `(add-global ,var-sym ,code)) (set! *globals* (cons (list var-sym lambda? code) *globals*))) (define (c-compile-global exp append-preamble cont trace) -TODO: assumes lambda's below: (let ((var (define->var exp)) (body (if (equal? 4 (length exp)) ; Simple var assignment contains superfluous %closure-ref (cadddr exp) (car (define->exp exp))))) (add-global var - (lambda? body) + (ast:lambda? body) (c-compile-exp body append-preamble cont (st:add-function! trace var) #t)) @@ -980,7 +978,7 @@ TODO: assumes lambda's below: ; ,(define-c->inline-var exp) ; ,(prim:udf? (define-c->inline-var exp)) ; )) - (when (and (lambda? body) + (when (and (ast:lambda? body) (prim:udf? (define-c->inline-var exp))) (add-global-inline var @@ -1114,10 +1112,12 @@ TODO: assumes lambda's below: ;; Note this must be the count before additional closure/CPS arguments ;; are added, so we need to detect those and not include them. (define (compute-num-args lam) + AST TODO: lambda-num-args does not work for AST lambda's (let ((count (lambda-num-args lam))) ;; Current arg count, may be too high (cond ((< count 0) -1) ;; Unlimited (else + AST TODO: (let ((formals (lambda-formals->list lam))) (- count (if (fl/closure? formals) 1 0) From c4de5b057e13999d4d1209a98a2d4cf057f5f9c1 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 11 Sep 2018 17:34:04 -0400 Subject: [PATCH 18/19] More ast lambda conversions --- scheme/cyclone/cgen.sld | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 3b1e7aa7..8a408290 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -1112,17 +1112,27 @@ ;; Note this must be the count before additional closure/CPS arguments ;; are added, so we need to detect those and not include them. (define (compute-num-args lam) - AST TODO: lambda-num-args does not work for AST lambda's - (let ((count (lambda-num-args lam))) ;; Current arg count, may be too high + (let ((count (ast:lambda-num-args lam))) ;; Current arg count, may be too high (cond ((< count 0) -1) ;; Unlimited (else - AST TODO: - (let ((formals (lambda-formals->list lam))) + (let ((formals (ast:lambda-formals->list lam))) (- count (if (fl/closure? formals) 1 0) (if (fl/cont? formals) 1 0))))))) +;; Minimum number of required arguments for a lambda +(define (ast:lambda-num-args exp) + (let ((type (ast:lambda-formals-type exp)) + (num (length (ast:lambda-formals->list exp)))) + (cond + ((equal? type 'args:varargs) + -1) ;; Unlimited + ((equal? type 'args:fixed-with-varargs) + (- num 1)) ;; Last arg is optional + (else + num)))) + ;; Formal list with a closure? (define (fl/closure? lis) (cond From 3fd2828b345fc3b365719bd71c2bfcfd3563e661 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 11 Sep 2018 17:58:47 -0400 Subject: [PATCH 19/19] Added note about lambda AST's --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 28a91486..b96466aa 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,7 @@ Features - Allow pretty printing of bytevectors. +- Internal change to the compiler - preserve lambda AST forms throughout compilation process. This should make it easier to implement certain optimizations in future releases. Bug Fixes