[Guile-commits] 03/08: CPS conversion residualizes undefined? predicate

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit f84474ef395473150f5a59783551f42e7be2c819
Author: Andy Wingo <address@hidden>
Date:   Tue Dec 5 14:49:06 2017 +0100

    CPS conversion residualizes undefined? predicate
    
    * module/language/tree-il/compile-cps.scm (init-default-value): Use
      undefined? predicate instead of reifying an unbound value in the CPS
      term.
    * module/language/cps/compile-bytecode.scm (compile-function): Add cases
      for the special immediate predicates.  Evidently we aren't emitting
      these yet!
---
 module/language/cps/compile-bytecode.scm |  7 +++++++
 module/language/tree-il/compile-cps.scm  | 15 ++++-----------
 2 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/module/language/cps/compile-bytecode.scm 
b/module/language/cps/compile-bytecode.scm
index a1733d7..af5b3f3 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -483,6 +483,13 @@
         (($ $primcall 'null? #f (a)) (unary emit-null? a))
         (($ $primcall 'nil? #f (a)) (unary emit-nil? a))
         (($ $primcall 'false? #f (a)) (unary emit-false? a))
+        (($ $primcall 'eq-false? #f (a)) (unary emit-eq-false? a))
+        (($ $primcall 'eq-nil? #f (a)) (unary emit-eq-nil? a))
+        (($ $primcall 'eq-null? #f (a)) (unary emit-eq-null? a))
+        (($ $primcall 'eq-true? #f (a)) (unary emit-eq-true? a))
+        (($ $primcall 'unspecified? #f (a)) (unary emit-unspecified? a))
+        (($ $primcall 'undefined? #f (a)) (unary emit-undefined? a))
+        (($ $primcall 'eof-object? #f (a)) (unary emit-eof-object? a))
         (($ $primcall 'pair? #f (a)) (unary emit-pair? a))
         (($ $primcall 'struct? #f (a)) (unary emit-struct? a))
         (($ $primcall 'char? #f (a)) (unary emit-char? a))
diff --git a/module/language/tree-il/compile-cps.scm 
b/module/language/tree-il/compile-cps.scm
index ed7ed47..786b965 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -164,16 +164,6 @@
                   (fold-kw kw (cdr gensyms) (cdr inits) seed)))))
        (fold-req req gensyms seed)))))
 
-(define (unbound? cps src var kt kf)
-  (define tc8-iflag 4)
-  (define unbound-val 9)
-  (define unbound-bits (logior (ash unbound-val 8) tc8-iflag))
-  (with-cps cps
-    ($ (with-cps-constants ((unbound (pointer->scm
-                                      (make-pointer unbound-bits))))
-         (build-term ($continue kf src
-                       ($branch kt ($primcall 'eq? #f (var unbound)))))))))
-
 (define (init-default-value cps name sym subst init body)
   (match (hashq-ref subst sym)
     ((orig-var subst-var box?)
@@ -200,7 +190,10 @@
                  (letk kreceive ($kreceive (list name) 'rest krest))
                  (let$ init (convert init kreceive subst))
                  (letk kunbound ($kargs () () ,init))
-                 ($ (unbound? src orig-var kunbound kbound)))))))))))
+                 (build-term
+                   ($continue kbound src
+                     ($branch kunbound
+                              ($primcall 'undefined? #f (orig-var))))))))))))))
 
 ;;; The conversion from Tree-IL to CPS essentially wraps every
 ;;; expression in a $kreceive, which models the Tree-IL semantics that