diff options
| author | Andy Wingo <wingo@pobox.com> | 2021-02-03 22:52:54 +0100 |
|---|---|---|
| committer | Andy Wingo <wingo@pobox.com> | 2021-02-03 23:02:27 +0100 |
| commit | f5b3506ecea161a7551ffb412e1ffa6fe8c1ae0b (patch) | |
| tree | 3bd8b00e667af1ef15ad9aa76a5325e6f71e4cc0 /module/language | |
| parent | 2e26538d6a51bdd6c2e68ad4539ab3750ef8670a (diff) | |
| download | guile-f5b3506ecea161a7551ffb412e1ffa6fe8c1ae0b.tar.gz | |
Optimize eof-object?
* module/language/cps/types.scm (constant-type): Add case for EOF.
* module/language/tree-il/primitives.scm (*interesting-primitive-names*):
(*effect+exception-free-primitives*): Add case for eof-object?.
(eof-object?): Expand to eq? on the-eof-object.
Diffstat (limited to 'module/language')
| -rw-r--r-- | module/language/cps/types.scm | 3 | ||||
| -rw-r--r-- | module/language/tree-il/primitives.scm | 11 |
2 files changed, 11 insertions, 3 deletions
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm index db52956e7..574c39bd2 100644 --- a/module/language/cps/types.scm +++ b/module/language/cps/types.scm @@ -1,5 +1,5 @@ ;;; Type analysis on CPS -;;; Copyright (C) 2014-2020 Free Software Foundation, Inc. +;;; Copyright (C) 2014-2021 Free Software Foundation, Inc. ;;; ;;; This library is free software: you can redistribute it and/or modify ;;; it under the terms of the GNU Lesser General Public License as @@ -368,6 +368,7 @@ minimum, and maximum." ((eq? val #t) (return &special-immediate &true)) ((eq? val #f) (return &special-immediate &false)) ((eqv? val *unspecified*) (return &special-immediate &unspecified)) + ((eof-object? val) (return &special-immediate &eof)) ((char? val) (return &char (char->integer val))) ((symbol? val) (return &symbol #f)) ((keyword? val) (return &keyword #f)) diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm index b257aa17c..1cc7907a8 100644 --- a/module/language/tree-il/primitives.scm +++ b/module/language/tree-il/primitives.scm @@ -1,6 +1,6 @@ ;;; open-coding primitive procedures -;; Copyright (C) 2009-2015, 2017-2020 Free Software Foundation, Inc. +;; Copyright (C) 2009-2015, 2017-2021 Free Software Foundation, Inc. ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -52,6 +52,7 @@ sqrt abs floor ceiling sin cos tan asin acos atan not pair? null? list? symbol? vector? string? struct? number? char? nil? + eof-object? bytevector? keyword? bitvector? symbol->string string->symbol @@ -199,7 +200,7 @@ eq? eqv? equal? not pair? null? nil? list? - symbol? variable? vector? struct? string? number? char? + symbol? variable? vector? struct? string? number? char? eof-object? exact-integer? bytevector? keyword? bitvector? procedure? thunk? atomic-box? @@ -404,6 +405,12 @@ (define-primitive-expander module-define! (mod sym val) (%variable-set! (module-ensure-local-variable! mod sym) val)) +(define-primitive-expander! 'eof-object? + (match-lambda* + ((src obj) + (make-primcall src 'eq? (list obj (make-const #f the-eof-object)))) + (_ #f))) + (define-primitive-expander zero? (x) (= x 0)) |