Start chaning $lambda-flag slot to allow multiple flag values

For the preparation of #991 .

src/compile-2.scm

@@ -200,7 +200,7 @@
                (and (= (lvar-ref-count lv) 0)
                     (lvar-immutable? lv)
                     (has-tag? (car inits) $LAMBDA)
-                    (eq? ($lambda-flag (car inits)) 'used)))
+                    ($lambda-used? (car inits))))
              ;; This lambda node has already been inlinded, so we can skip.
              (loop (cdr lvars) (cdr inits) new-lvars new-inits)]
             [(has-tag? (car inits) $CLAMBDA)
@@ -446,7 +446,7 @@
     (let loop ([env env])
       (cond [(null? env) #t]
             [(eq? (car env) lambda-node) #t]
-            [(eq? ($lambda-flag (car env)) 'dissolved)
+            [($lambda-dissolved? (car env))
              (loop (cdr env))] ;; skip dissolved (inlined) lambdas
             [else #f])))
   (let loop ([call&envs call&envs]

src/compile-4.scm

@@ -166,7 +166,7 @@
                ;; we don't need to lift it, nor need to set free-lvars.
                ;; We just mark it by setting lifted-var to #t so that
                ;; pass4/lift phase can treat it specially.
-               (unless (eq? ($lambda-flag iform) 'dissolved)
+               (unless ($lambda-dissolved? iform)
                  (label-dic-info-push! labels iform) ;save the lambda node
                  (when t?                            ;mark this is toplevel
                    ($lambda-lifted-var-set! iform #t)))

src/compile-5.scm

@@ -606,13 +606,11 @@
   0)
 
 (define (pass5/lambda iform target renv)
-  (let* ([inliner (let1 v ($lambda-flag iform)
-                   (and (vector? v) v))]
-         [ccb (make-compiled-code-builder ($lambda-reqargs iform)
+  (let* ([ccb (make-compiled-code-builder ($lambda-reqargs iform)
                                           ($lambda-optarg iform)
                                           ($lambda-name iform)
                                           (ctarget-ccb target) ; parent
-                                          inliner)]
+                                          ($lambda-inliner iform))]
          [ntarget (make-child-compile-target ccb target)])
     (compiled-code-attach-source-info! ccb ($lambda-src iform))
 

src/compile.scm

@@ -554,14 +554,18 @@
    optarg           ; 0 or 1, # of optional arg
    lvars            ; list of lvars
    body             ; IForm for the body
-   flag             ; Marks some special state of this node.
+   flag             ; List of marks for the nature of this lambda node. (*1)
+                    ; Members can be:
                     ;   'dissolved: indicates that this lambda has been
                     ;               inline expanded.
                     ;   'used: indicates that this lambda has been already dealt
                     ;          with, and need to be eliminated.  This one is
                     ;          specifically used for communication between
                     ;          pass2/$CALL and pass2/$LET.
                     ;   <packed-iform>  : inlinable lambda
+                    ;   'constant: This lambda form is constant, meaning
+                    ;          it yields the same result if all the arguments
+                    ;          are constant.
    ;; The following slots are used temporarily during pass2-5, and
    ;; need not be saved when packed.
    (calls '())      ; list of call sites
@@ -571,6 +575,34 @@
                     ; is to be bound.  See pass 4.
    ))
 
+;; (*1) Up to 0.9.14, this slot contains a symbol or a packed-iform, not a
+;; list.  This slot is embedded in the precompiled files, so we need to
+;; deal with such a case.  Because of this, $lambda-flag slot must
+;; be accessed with the following utillities.
+
+(define-inline ($lambda-flags iform)
+  (let1 f ($lambda-flag iform)
+    (if (or (null? f) (pair? f))
+      f
+      (list f))))
+
+(define-inline ($lambda-dissolved? iform)
+  (let1 f ($lambda-flag iform)
+    (or (eq? f 'dissolved) (memq 'dissolved f))))
+(define-inline ($lambda-used? iform)
+  (let1 f ($lambda-flag iform)
+    (or (eq? f 'used) (memq 'used f))))
+(define-inline ($lambda-constant? iform)
+  (let1 f ($lambda-flag iform)
+    (or (eq? f 'used) (memq 'used f))))
+(define-inline ($lambda-inlinable? iform)
+  (let1 f ($lambda-flag iform)
+    (or (vector? f) (and (pair? f) (any vector? f)))))
+
+(define-inline ($lambda-inliner iform)
+  (let1 f ($lambda-flag iform)
+    (if (vector? f) f (and (pair? f) (find vector? f)))))
+
 ;; $clambda <src> <name> <lambda-node> ...
 ;;   Case-lambda.
 ;;   Closures slot contains two or more IForms.  They're initially $LAMBDA
@@ -781,7 +813,7 @@
        [($LAMBDA) (format #t "($lambda[~a.~a~a~a] ~a" ($lambda-name iform)
                           (length ($lambda-calls iform))
                           (if (null? ($lambda-free-lvars iform)) "" "c")
-                          (if (vector? ($lambda-flag iform)) " inlinable" "")
+                          (if ($lambda-inlinable? iform) " inlinable" "")
                           (map lvar->string ($lambda-lvars iform)))
         (nl (+ ind 2))
         (rec (+ ind 2) ($lambda-body iform)) (display ")")]
@@ -914,7 +946,7 @@
                       ($lambda-optarg iform)
                       (map get-ref ($lambda-lvars iform))
                       (get-ref ($lambda-body iform))
-                      ($lambda-flag iform))]
+                      ($lambda-flags iform))]
      [($CLAMBDA) (put! iform '$CLAMBDA ($*-src iform)
                        ($clambda-name iform)
                        (map get-ref ($clambda-closures iform)))]