Comment out typechecks on token stream.

Each such typecheck ran in linear time on the remaining tokens, which is
a bit to much. Remove it, and hope that the code behaves.

Some stats, from running

    make coverage GUILE=guile3

With typechecks
---------------
Slow test: "Parameter expansion times", took 1.077431
Slow test: "Example 3, except part below", took 16.952855
Slow test: "True test", took 18.335534
Slow test: "Example 5", took 3.351126
Slow test: "Example 7", took 2.804212
--------------------------------------------------
Without typechecks
------------------
Slow test: "Example 3, except part below", took 12.863874
Slow test: "True test", took 14.016901
Slow test: "Example 5", took 2.166008
Slow test: "Example 7", took 2.252685

2 files changed, 18 insertions, 18 deletions

diff --git a/module/c/cpp-util.scm b/module/c/cpp-util.scm
index 7969ccd5..3ea06505 100644
--- a/module/c/cpp-util.scm
+++ b/module/c/cpp-util.scm
@@ -35,7 +35,7 @@
 ;; - tokens until a newline token is met
 ;; - (potentially the newline token) and the remaining tokens
 (define (tokens-until-eol tokens)
-  (typecheck tokens (list-of lexeme?))
+  ;; (typecheck tokens (list-of lexeme?))
   (break newline-token? tokens))
 
 ;; call predicate with the remaining token stream, until we run out of token, or
@@ -74,22 +74,22 @@
 
 ;; Drop leading whitespace tokens
 (define (drop-whitespace tokens)
-  (typecheck tokens (list-of lexeme?))
+  ;; (typecheck tokens (list-of lexeme?))
   (drop-while whitespace-token? tokens))
 
 (define (drop-whitespace/line tokens)
-  (typecheck tokens (list-of lexeme?))
+  ;; (typecheck tokens (list-of lexeme?))
   (drop-while (lambda (t)
                 (and (whitespace-token? t)
                      (not (newline-token? t))))
               tokens))
 
 (define (drop-whitespace-right tokens)
-  (typecheck tokens (list-of lexeme?))
+  ;; (typecheck tokens (list-of lexeme?))
   (-> tokens reverse drop-whitespace reverse))
 
 (define (drop-whitespace-both tokens)
-  (typecheck tokens (list-of lexeme?))
+  ;; (typecheck tokens (list-of lexeme?))
   (-> tokens
       drop-whitespace
       drop-whitespace-right))
@@ -103,7 +103,7 @@
 ;; "( 2, 4 )"
 ;; 6.10.3.2 p 2
 (define (cleanup-whitespace tokens)
-  (typecheck tokens (list-of lexeme?))
+  ;; (typecheck tokens (list-of lexeme?))
   (-> tokens drop-whitespace-both squeeze-whitespace))
 
 (define (concatenate-tokens a b)
diff --git a/module/c/preprocessor2.scm b/module/c/preprocessor2.scm
index 6757521f..755eaa7b 100644
--- a/module/c/preprocessor2.scm
+++ b/module/c/preprocessor2.scm
@@ -87,7 +87,7 @@
 
 ;; 6.10.3.3
 (define (expand## tokens)
-  (typecheck tokens (list-of lexeme?))
+  ;; (typecheck tokens (list-of lexeme?))
 
   (let loop ((left '())
              (right tokens))
@@ -203,7 +203,7 @@
 (define (expand-macro environment macro noexpand-list remaining-tokens)
   (typecheck environment cpp-environment?)
   (typecheck macro cpp-macro?)
-  (typecheck remaining-tokens (list-of lexeme?))
+  ;; (typecheck remaining-tokens (list-of lexeme?))
   (typecheck noexpand-list (list-of string?))
 
   (let ((name (macro-identifier macro)))
@@ -254,7 +254,7 @@
 ;; Note that this is ONLY #define f(x) forms
 ;; not usage forms
 (define (parse-identifier-list tokens)
-  (typecheck tokens (list-of lexeme?))
+  ;; (typecheck tokens (list-of lexeme?))
   (let loop ((tokens (remove whitespace-token? tokens)) (done '()))
     (cond ((null? tokens) (values #f (reverse done)))
           ((identifier-token? (car tokens))
@@ -281,7 +281,7 @@
 ;; Note that each returned token-list might have padding whitespace which should be trimmed.
 ;; It's kept to allow __VA_ARGS__ to "remember" its whitespace
 (define (parse-parameter-list tokens*)
-  (typecheck tokens* (list-of lexeme?))
+  ;; (typecheck tokens* (list-of lexeme?))
   (let %loop ((depth 0) (newlines 0) (current '())
               (parameters '()) (tokens tokens*) (%first-iteration? #t))
     (define* (loop tokens key:
@@ -388,7 +388,7 @@
 ;; environment, tokens → environment
 (define (handle-pragma environment tokens)
   (typecheck environment cpp-environment?)
-  (typecheck tokens (list-of lexeme?))
+  ;; (typecheck tokens (list-of lexeme?))
 
   (let ((err (lambda ()
                (scm-error 'cpp-pragma-error "handle-pragma"
@@ -413,7 +413,7 @@
 
 
 (define (resolve-constant-expression tokens)
-  (typecheck tokens (list-of lexeme?))
+  ;; (typecheck tokens (list-of lexeme?))
   'TODO
   )
 
@@ -437,7 +437,7 @@
 ;; environment, tokens, [boolean] → environment, tokens
 (define* (resolve-token-stream environment tokens key: once?)
   (typecheck environment cpp-environment?)
-  (typecheck tokens (list-of lexeme?))
+  ;; (typecheck tokens (list-of lexeme?))
   ;; (pprint-environment environment)
   ;; (format (current-error-port) "~a~%~%" (unlex tokens))
   (let loop ((environment environment) (tokens tokens))
@@ -462,7 +462,7 @@
 ;; environment, (list token) → environment
 (define (resolve-for-if environment tokens)
   (typecheck environment cpp-environment?)
-  (typecheck tokens (list-of lexeme?))
+  ;; (typecheck tokens (list-of lexeme?))
 
   (-> (extend-environment environment defined-macro)
       ;; no newlines in #if line
@@ -476,7 +476,7 @@
 (define (maybe-extend-identifier environment identifier noexpand-list remaining-tokens)
   (typecheck environment cpp-environment?)
   (typecheck identifier string?)
-  (typecheck remaining-tokens (list-of lexeme?))
+  ;; (typecheck remaining-tokens (list-of lexeme?))
   (typecheck noexpand-list (list-of string?))
   (cond ((get-identifier (join-file-line environment) identifier)
          => (lambda (value)
@@ -492,7 +492,7 @@
 
 (define (resolve-and-include-header environment tokens)
   (typecheck environment cpp-environment?)
-  (typecheck tokens (list-of lexeme?))
+  ;; (typecheck tokens (list-of lexeme?))
 
   (let ((err (lambda (msg . args)
                (scm-error 'cpp-error "resolve-and-include-header"
@@ -522,7 +522,7 @@
 ;; environment, tokens → environment
 (define (handle-line-directive environment tokens*)
   (typecheck environment cpp-environment?)
-  (typecheck tokens* (list-of lexeme?))
+  ;; (typecheck tokens* (list-of lexeme?))
 
   (let ((err (lambda () (scm-error 'cpp-error "handle-line-directive"
                               "Invalid line directive: ~s"
@@ -549,7 +549,7 @@
 ;; environment, tokens → environment
 (define (resolve-define environment tokens)
   (typecheck environment cpp-environment?)
-  (typecheck tokens (list-of lexeme?))
+  ;; (typecheck tokens (list-of lexeme?))
 
   (let ((identifier (identifier-token? (car tokens)))
         (tail (cdr tokens)))