>From 632045e07adaa0f9d47b3b695e232d5a7b784f6a Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Sun, 10 Aug 2014 18:55:12 +0200 Subject: [PATCH 08/19] compiler-modules: Convert scrutinizer to a module. In chicken-syntax, :, the, define-specialization, compiler-typecase, and define-type now expand directly to scrutinizer#[check-and-]validate-type, which is needed in order to remove these two procedures from compiler-namespace. Fixed lfa2 debugging code to look at lfa2-debug instead of scrutiny-debug. Converted use of string-concatenate to string-join to avoid dependency on srfi-13, which is slated for extraction from core. --- batch-driver.scm | 4 ++-- chicken-syntax.scm | 17 ++++++++++------- compiler-namespace.scm | 10 ---------- compiler.scm | 1 + lfa2.scm | 2 +- rules.make | 3 ++- scrutinizer.scm | 25 ++++++++++++++----------- 7 files changed, 30 insertions(+), 32 deletions(-) diff --git a/batch-driver.scm b/batch-driver.scm index 1dcd97e..0138330 100644 --- a/batch-driver.scm +++ b/batch-driver.scm @@ -31,7 +31,7 @@ (unit batch-driver) (uses extras data-structures files srfi-1 ;; TODO: Backend should be configurable - lfa2 compiler-syntax optimizer c-platform c-backend) ) + lfa2 compiler-syntax optimizer scrutinizer c-platform c-backend) ) ;; TODO: Remove these once everything's converted to modules (include "private-namespace") @@ -45,7 +45,7 @@ (import (except chicken put! get quit syntax-error) scheme extras data-structures files srfi-1 - lfa2 compiler-syntax optimizer c-platform c-backend) + lfa2 compiler-syntax optimizer scrutinizer c-platform c-backend) (include "tweaks") diff --git a/chicken-syntax.scm b/chicken-syntax.scm index edc42ec..46d3cbc 100644 --- a/chicken-syntax.scm +++ b/chicken-syntax.scm @@ -30,6 +30,9 @@ (disable-interrupts) (fixnum) ) +;; IMPORTANT: These macros expand directly into fully qualified names +;; from the scrutinizer module. + #+(not debugbuild) (declare (no-bound-checks) @@ -1174,9 +1177,9 @@ '(##core#undefined) (let* ((type1 (##sys#strip-syntax (caddr x))) (name1 (cadr x))) - ;; we need pred/pure info, so not using "##compiler#check-and-validate-type" + ;; we need pred/pure info, so not using "scrutinizer#check-and-validate-type" (let-values (((type pred pure) - (##compiler#validate-type type1 (##sys#strip-syntax name1)))) + (scrutinizer#validate-type type1 (##sys#strip-syntax name1)))) (cond ((not type) (syntax-error ': "invalid type syntax" name1 type1)) (else @@ -1192,7 +1195,7 @@ (##sys#check-syntax 'the x '(_ _ _)) (if (not (memq #:compiling ##sys#features)) (caddr x) - `(##core#the ,(##compiler#check-and-validate-type (cadr x) 'the) + `(##core#the ,(scrutinizer#check-and-validate-type (cadr x) 'the) #t ,(caddr x)))))) @@ -1235,7 +1238,7 @@ (cons atypes (if (and rtypes (pair? rtypes)) (list - (map (cut ##compiler#check-and-validate-type + (map (cut scrutinizer#check-and-validate-type <> 'define-specialization) rtypes) @@ -1261,7 +1264,7 @@ (cdr args) (cons (car arg) anames) (cons - (##compiler#check-and-validate-type + (scrutinizer#check-and-validate-type (cadr arg) 'define-specialization) atypes))) @@ -1287,7 +1290,7 @@ (if (eq? hd 'else) 'else (if val - (##compiler#check-and-validate-type + (scrutinizer#check-and-validate-type hd 'compiler-typecase) hd)) @@ -1308,7 +1311,7 @@ (##sys#put/restore! (,%quote ,name) (,%quote ##compiler#type-abbreviation) - (,%quote ,(##compiler#check-and-validate-type t0 'define-type name)))))))))) + (,%quote ,(scrutinizer#check-and-validate-type t0 'define-type name)))))))))) ;; capture current macro env diff --git a/compiler-namespace.scm b/compiler-namespace.scm index 0a4f0c9..9a7516c 100644 --- a/compiler-namespace.scm +++ b/compiler-namespace.scm @@ -43,11 +43,9 @@ c-ify-string callback-names call-info - canonicalize-list-type canonicalize-begin-body canonicalize-expression check-and-open-input-file - check-and-validate-type check-signature chop-extension chop-separator @@ -103,7 +101,6 @@ emit-profile emit-syntax-trace-info emit-trace-info - emit-type-file enable-inline-files enable-specialization estimate-foreign-result-location-size @@ -184,7 +181,6 @@ inline-table-used inlining insert-timer-checks - install-specializations installation-home internal-bindings intrinsic? @@ -211,7 +207,6 @@ llist-match? load-identifier-database load-inline-file - load-type-database local-definitions location-pointer-map make-block-variable-literal @@ -269,18 +264,14 @@ scan-free-variables scan-sharp-greater-string scan-used-variables - scrutinize - scrutiny-debug set-real-name! sexpr->node simple-lambda-node? - simplify-type slashify sort-symbols source-filename source-info->string source-info->line - specialize-node! standalone-executable standard-bindings strict-variable-types @@ -302,7 +293,6 @@ update-line-number-database! used-units valid-c-identifier? - validate-type variable-mark variable-visible? varnode diff --git a/compiler.scm b/compiler.scm index 1759458..1c0b472 100644 --- a/compiler.scm +++ b/compiler.scm @@ -265,6 +265,7 @@ (declare (unit compiler)) +(import scrutinizer) (include "compiler-namespace") diff --git a/lfa2.scm b/lfa2.scm index 4c85686..4d25e63 100644 --- a/lfa2.scm +++ b/lfa2.scm @@ -51,7 +51,7 @@ (define lfa2-debug #t) (define (d fstr . args) - (when (and scrutiny-debug (##sys#fudge 13)) + (when (and lfa2-debug (##sys#fudge 13)) (printf "[debug|~a] ~a~?~%" d-depth (make-string d-depth #\space) fstr args)) ) (define dd d) diff --git a/rules.make b/rules.make index 01aa441..85e7528 100644 --- a/rules.make +++ b/rules.make @@ -492,7 +492,7 @@ endef $(foreach lib, $(SETUP_API_OBJECTS_1),\ $(eval $(call declare-emitted-import-lib-dependency,$(lib)))) -$(foreach lib, batch-driver lfa2 compiler-syntax optimizer c-platform c-backend,\ +$(foreach lib, batch-driver lfa2 compiler-syntax optimizer scrutinizer c-platform c-backend,\ $(eval $(call declare-emitted-import-lib-dependency,$(lib)))) chicken.c: chicken.scm batch-driver.import.scm batch-driver.scm \ @@ -500,6 +500,7 @@ chicken.c: chicken.scm batch-driver.import.scm batch-driver.scm \ batch-driver.c: batch-driver.scm lfa2.import.scm lfa2.scm \ compiler-syntax.scm compiler-syntax.import.scm \ optimizer.scm optimizer.import.scm \ + scrutinizer.scm scrutinizer.import.scm \ c-platform.scm c-platform.import.scm \ c-backend.scm c-backend.import.scm c-platform.c: c-platform.scm optimizer.scm optimizer.import.scm diff --git a/scrutinizer.scm b/scrutinizer.scm index c437933..acb057b 100644 --- a/scrutinizer.scm +++ b/scrutinizer.scm @@ -26,18 +26,20 @@ (declare (unit scrutinizer) - (hide specialize-node! specialization-statistics - procedure-type? named? procedure-result-types procedure-argument-types - noreturn-type? rest-type procedure-name d-depth - noreturn-procedure-type? trail trail-restore walked-result - typename multiples procedure-arguments procedure-results - smash-component-types! generate-type-checks! over-all-instantiations - compatible-types? type<=? match-types resolve match-argument-types)) - + (uses srfi-1 data-structures extras ports files) ) +;; TODO: Remove these once everything's converted to modules +(include "private-namespace") (include "compiler-namespace") -(include "tweaks") +(module scrutinizer + (scrutinize load-type-database emit-type-file + validate-type check-and-validate-type install-specializations) + +(import (except chicken put! get quit syntax-error) scheme + srfi-1 data-structures extras ports files) + +(include "tweaks") (define d-depth 0) (define scrutiny-debug #t) @@ -826,9 +828,9 @@ (sprintf "(~a) " (first params)) "") (car ts) - (string-concatenate + (string-intersperse (map (lambda (t) (sprintf "\n ~a" t)) - (cdr params))))) + (cdr params)) ""))) ((match-types (car types) (car ts) (append (type-typeenv (car types)) typeenv) #t) @@ -2353,3 +2355,4 @@ (else (restore) (loop (cdr ts) ok)))))) +) \ No newline at end of file -- 1.7.10.4