mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +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 ;;; 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 ;;; This library is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU Lesser General Public License as ;;; 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 #t) (return &special-immediate &true))
((eq? val #f) (return &special-immediate &false)) ((eq? val #f) (return &special-immediate &false))
((eqv? val *unspecified*) (return &special-immediate &unspecified)) ((eqv? val *unspecified*) (return &special-immediate &unspecified))
((eof-object? val) (return &special-immediate &eof))
((char? val) (return &char (char->integer val))) ((char? val) (return &char (char->integer val)))
((symbol? val) (return &symbol #f)) ((symbol? val) (return &symbol #f))
((keyword? val) (return &keyword #f)) ((keyword? val) (return &keyword #f))

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

@ -1,6 +1,6 @@
;;; open-coding primitive procedures ;;; 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 ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; 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 sqrt abs floor ceiling sin cos tan asin acos atan
not not
pair? null? list? symbol? vector? string? struct? number? char? nil? pair? null? list? symbol? vector? string? struct? number? char? nil?
eof-object?
bytevector? keyword? bitvector? bytevector? keyword? bitvector?
symbol->string string->symbol symbol->string string->symbol
@ -199,7 +200,7 @@
eq? eqv? equal? eq? eqv? equal?
not not
pair? null? nil? list? pair? null? nil? list?
symbol? variable? vector? struct? string? number? char? symbol? variable? vector? struct? string? number? char? eof-object?
exact-integer? exact-integer?
bytevector? keyword? bitvector? bytevector? keyword? bitvector?
procedure? thunk? atomic-box? procedure? thunk? atomic-box?
@ -404,6 +405,12 @@
(define-primitive-expander module-define! (mod sym val) (define-primitive-expander module-define! (mod sym val)
(%variable-set! (module-ensure-local-variable! 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) (define-primitive-expander zero? (x)
(= x 0)) (= x 0))