From f5b3506ecea161a7551ffb412e1ffa6fe8c1ae0b Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Wed, 3 Feb 2021 22:52:54 +0100
Subject: [PATCH] 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 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))