mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

Optimize eof-object?

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2021-02-03 22:52:54 +01:00
parent 2e26538d6a
commit f5b3506ece
2 changed files with 11 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

3
module/language/cps/types.scm
View file

@ -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))

11
module/language/tree-il/primitives.scm
View file

@ -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))