[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/02: Optimize eof-object?
From: |
Andy Wingo |
Subject: |
[Guile-commits] 02/02: Optimize eof-object? |
Date: |
Wed, 3 Feb 2021 17:08:11 -0500 (EST) |
wingo pushed a commit to branch master
in repository guile.
commit f5b3506ecea161a7551ffb412e1ffa6fe8c1ae0b
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Wed Feb 3 22:52:54 2021 +0100
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.
---
module/language/cps/types.scm | 3 ++-
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 db52956..574c39b 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 b257aa1..1cc7907 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))