added foldable, flushable declarations in all relevant places

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 4860d4299b6159f5b418f3b8fd54c89a70185c00..f3d54afd2db046214cf175335ddb75c6e6bb55a2 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,6 +1,4 @@
-- fix bootstrap failure\r
 - flushing optimization\r
-- add foldable, flushable, inline to all relevant library words\r
 - new prettyprinter\r
   - limit output to n lines\r
   - limit sequences to n elements\r

diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor
index 36b589ae1d5860be4b579fd43c3164ff6fec6019..720ca33d53c8f7a574dcf548799e48f9010047b8 100644 (file)
--- a/library/bootstrap/primitives.factor
+++ b/library/bootstrap/primitives.factor
@@ -26,192 +26,185 @@ vocabularies get [
     reveal
 ] bind
 
-: set-stack-effect ( { vocab word effect } -- )
-    3unseq >r unit search r> dup string? [
-        "stack-effect" set-word-prop
-    ] [
-        "infer-effect" set-word-prop
-    ] ifte ;
-
-: make-primitive ( { vocab word effect } n -- )
-    >r dup 2unseq create r> f define set-stack-effect ;
+: make-primitive ( { vocab word } n -- )
+    >r 2unseq create r> f define ;
 
 {
-    { "execute" "words"                       [ [ word ] [ ] ] }
-    { "call" "kernel"                         [ [ general-list ] [ ] ] }
-    { "ifte" "kernel"                         [ [ object general-list general-list ] [ ] ] }
-    { "dispatch" "kernel-internals"           [ [ fixnum vector ] [ ] ] }
-    { "cons" "lists"                          [ [ object object ] [ cons ] ] }
-    { "<vector>" "vectors"                    [ [ integer ] [ vector ] ] }
-    { "rehash-string" "strings"               [ [ string ] [ ] ] }
-    { "<sbuf>" "strings"                      [ [ integer ] [ sbuf ] ] }
-    { "sbuf>string" "strings"                 [ [ sbuf ] [ string ] ] }
-    { ">fixnum" "math"                        [ [ number ] [ fixnum ] ] }
-    { ">bignum" "math"                        [ [ number ] [ bignum ] ] }
-    { ">float" "math"                         [ [ number ] [ float ] ] }
-    { "(fraction>)" "math-internals"          [ [ integer integer ] [ rational ] ] }
-    { "str>float" "parser"                    [ [ string ] [ float ] ] }
-    { "(unparse-float)" "unparser"            [ [ float ] [ string ] ] }
-    { "float>bits" "math"                     [ [ real ] [ integer ] ] }
-    { "double>bits" "math"                    [ [ real ] [ integer ] ] }
-    { "bits>float" "math"                     [ [ integer ] [ float ] ] }
-    { "bits>double" "math"                    [ [ integer ] [ float ] ] }
-    { "<complex>" "math-internals"            [ [ real real ] [ number ] ] }
-    { "fixnum+" "math-internals"              [ [ fixnum fixnum ] [ integer ] ] }
-    { "fixnum-" "math-internals"              [ [ fixnum fixnum ] [ integer ] ] }
-    { "fixnum*" "math-internals"              [ [ fixnum fixnum ] [ integer ] ] }
-    { "fixnum/i" "math-internals"             [ [ fixnum fixnum ] [ integer ] ] }
-    { "fixnum/f" "math-internals"             [ [ fixnum fixnum ] [ integer ] ] }
-    { "fixnum-mod" "math-internals"           [ [ fixnum fixnum ] [ fixnum ] ] }
-    { "fixnum/mod" "math-internals"           [ [ fixnum fixnum ] [ integer fixnum ] ] }
-    { "fixnum-bitand" "math-internals"        [ [ fixnum fixnum ] [ fixnum ] ] }
-    { "fixnum-bitor" "math-internals"         [ [ fixnum fixnum ] [ fixnum ] ] }
-    { "fixnum-bitxor" "math-internals"        [ [ fixnum fixnum ] [ fixnum ] ] }
-    { "fixnum-bitnot" "math-internals"        [ [ fixnum ] [ fixnum ] ] }
-    { "fixnum-shift" "math-internals"         [ [ fixnum fixnum ] [ integer ] ] }
-    { "fixnum<" "math-internals"              [ [ fixnum fixnum ] [ boolean ] ] }
-    { "fixnum<=" "math-internals"             [ [ fixnum fixnum ] [ boolean ] ] }
-    { "fixnum>" "math-internals"              [ [ fixnum fixnum ] [ boolean ] ] }
-    { "fixnum>=" "math-internals"             [ [ fixnum fixnum ] [ boolean ] ] }
-    { "bignum=" "math-internals"              [ [ bignum bignum ] [ boolean ] ] }
-    { "bignum+" "math-internals"              [ [ bignum bignum ] [ bignum ] ] }
-    { "bignum-" "math-internals"              [ [ bignum bignum ] [ bignum ] ] }
-    { "bignum*" "math-internals"              [ [ bignum bignum ] [ bignum ] ] }
-    { "bignum/i" "math-internals"             [ [ bignum bignum ] [ bignum ] ] }
-    { "bignum/f" "math-internals"             [ [ bignum bignum ] [ bignum ] ] }
-    { "bignum-mod" "math-internals"           [ [ bignum bignum ] [ bignum ] ] }
-    { "bignum/mod" "math-internals"           [ [ bignum bignum ] [ bignum bignum ] ] }
-    { "bignum-bitand" "math-internals"        [ [ bignum bignum ] [ bignum ] ] }
-    { "bignum-bitor" "math-internals"         [ [ bignum bignum ] [ bignum ] ] }
-    { "bignum-bitxor" "math-internals"        [ [ bignum bignum ] [ bignum ] ] }
-    { "bignum-bitnot" "math-internals"        [ [ bignum ] [ bignum ] ] }
-    { "bignum-shift" "math-internals"         [ [ bignum bignum ] [ bignum ] ] }
-    { "bignum<" "math-internals"              [ [ bignum bignum ] [ boolean ] ] }
-    { "bignum<=" "math-internals"             [ [ bignum bignum ] [ boolean ] ] }
-    { "bignum>" "math-internals"              [ [ bignum bignum ] [ boolean ] ] }
-    { "bignum>=" "math-internals"             [ [ bignum bignum ] [ boolean ] ] }
-    { "float=" "math-internals"               [ [ bignum bignum ] [ boolean ] ] }
-    { "float+" "math-internals"               [ [ float float ] [ float ] ] }
-    { "float-" "math-internals"               [ [ float float ] [ float ] ] }
-    { "float*" "math-internals"               [ [ float float ] [ float ] ] }
-    { "float/f" "math-internals"              [ [ float float ] [ float ] ] }
-    { "float<" "math-internals"               [ [ float float ] [ boolean ] ] }
-    { "float<=" "math-internals"              [ [ float float ] [ boolean ] ] }
-    { "float>" "math-internals"               [ [ float float ] [ boolean ] ] }
-    { "float>=" "math-internals"              [ [ float float ] [ boolean ] ] }
-    { "facos" "math-internals"                [ [ real ] [ float ] ] }
-    { "fasin" "math-internals"                [ [ real ] [ float ] ] }
-    { "fatan" "math-internals"                [ [ real ] [ float ] ] }
-    { "fatan2" "math-internals"               [ [ real real ] [ float ] ] }
-    { "fcos" "math-internals"                 [ [ real ] [ float ] ] }
-    { "fexp" "math-internals"                 [ [ real ] [ float ] ] }
-    { "fcosh" "math-internals"                [ [ real ] [ float ] ] }
-    { "flog" "math-internals"                 [ [ real ] [ float ] ] }
-    { "fpow" "math-internals"                 [ [ real real ] [ float ] ] }
-    { "fsin" "math-internals"                 [ [ real ] [ float ] ] }
-    { "fsinh" "math-internals"                [ [ real ] [ float ] ] }
-    { "fsqrt" "math-internals"                [ [ real ] [ float ] ] }
-    { "<word>" "words"                        [ [ ] [ word ] ] }
-    { "update-xt" "words"                     [ [ word ] [ ] ] }
-    { "compiled?" "words"                     [ [ word ] [ boolean ] ] }
-    { "drop" "kernel"                         [ [ object ] [ ] ] }
-    { "dup" "kernel"                          [ [ object ] [ object object ] ] }
-    { "swap" "kernel"                         [ [ object object ] [ object object ] ] }
-    { "over" "kernel"                         [ [ object object ] [ object object object ] ] }
-    { "pick" "kernel"                         [ [ object object object ] [ object object object object ] ] }
-    { ">r" "kernel"                           [ [ object ] [ ] ] }
-    { "r>" "kernel"                           [ [ ] [ object ] ] }
-    { "eq?" "kernel"                          [ [ object object ] [ boolean ] ] }
-    { "getenv" "kernel-internals"             [ [ fixnum ] [ object ] ] }
-    { "setenv" "kernel-internals"             [ [ object fixnum ] [ ] ] }
-    { "stat" "io"                             [ [ string ] [ general-list ] ] }
-    { "(directory)" "io"                      [ [ string ] [ general-list ] ] }
-    { "gc" "memory"                           [ [ fixnum ] [ ] ] }
-    { "gc-time" "memory"                      [ [ string ] [ ] ] }
-    { "save-image" "memory"                   [ [ string ] [ ] ] }
-    { "datastack" "kernel"                    " -- ds "          }
-    { "callstack" "kernel"                    " -- cs "          }
-    { "set-datastack" "kernel"                " ds -- "          }
-    { "set-callstack" "kernel"                " cs -- "          }
-    { "exit" "kernel"                         [ [ integer ] [ ] ] }
-    { "room" "memory"                         [ [ ] [ integer integer integer integer general-list ] ] }
-    { "os-env" "kernel"                       [ [ string ] [ object ] ] }
-    { "millis" "kernel"                       [ [ ] [ integer ] ] }
-    { "(random-int)" "math"                   [ [ ] [ integer ] ] }
-    { "type" "kernel"                         [ [ object ] [ fixnum ] ] }
-    { "tag" "kernel-internals"                [ [ object ] [ fixnum ] ] }
-    { "cwd" "io"                              [ [ ] [ string ] ] }
-    { "cd" "io"                               [ [ string ] [ ] ] }
-    { "compiled-offset" "assembler"           [ [ ] [ integer ] ] }
-    { "set-compiled-offset" "assembler"       [ [ integer ] [ ] ] }
-    { "literal-top" "assembler"               [ [ ] [ integer ] ] }
-    { "set-literal-top" "assembler"           [ [ integer ] [ ] ] }
-    { "address" "memory"                      [ [ object ] [ integer ] ] }
-    { "dlopen" "alien"                        [ [ string ] [ dll ] ] }
-    { "dlsym" "alien"                         [ [ string object ] [ integer ] ] }
-    { "dlclose" "alien"                       [ [ dll ] [ ] ] }
-    { "<alien>" "alien"                       [ [ integer ] [ alien ] ] }
-    { "<byte-array>" "kernel-internals"       [ [ integer ] [ byte-array ] ] }
-    { "<displaced-alien>" "alien"             [ [ integer c-ptr ] [ displaced-alien ] ] }
-    { "alien-signed-cell" "alien"             [ [ c-ptr integer ] [ integer ] ] }
-    { "set-alien-signed-cell" "alien"         [ [ integer c-ptr integer ] [ ] ] }
-    { "alien-unsigned-cell" "alien"           [ [ c-ptr integer ] [ integer ] ] }
-    { "set-alien-unsigned-cell" "alien"       [ [ integer c-ptr integer ] [ ] ] }
-    { "alien-signed-8" "alien"                [ [ c-ptr integer ] [ integer ] ] }
-    { "set-alien-signed-8" "alien"            [ [ integer c-ptr integer ] [ ] ] }
-    { "alien-unsigned-8" "alien"              [ [ c-ptr integer ] [ integer ] ] }
-    { "set-alien-unsigned-8" "alien"          [ [ integer c-ptr integer ] [ ] ] }
-    { "alien-signed-4" "alien"                [ [ c-ptr integer ] [ integer ] ] }
-    { "set-alien-signed-4" "alien"            [ [ integer c-ptr integer ] [ ] ] }
-    { "alien-unsigned-4" "alien"              [ [ c-ptr integer ] [ integer ] ] }
-    { "set-alien-unsigned-4" "alien"          [ [ integer c-ptr integer ] [ ] ] }
-    { "alien-signed-2" "alien"                [ [ c-ptr integer ] [ integer ] ] }
-    { "set-alien-signed-2" "alien"            [ [ integer c-ptr integer ] [ ] ] }
-    { "alien-unsigned-2" "alien"              [ [ c-ptr integer ] [ integer ] ] }
-    { "set-alien-unsigned-2" "alien"          [ [ integer c-ptr integer ] [ ] ] }
-    { "alien-signed-1" "alien"                [ [ c-ptr integer ] [ integer ] ] }
-    { "set-alien-signed-1" "alien"            [ [ integer c-ptr integer ] [ ] ] }
-    { "alien-unsigned-1" "alien"              [ [ c-ptr integer ] [ integer ] ] }
-    { "set-alien-unsigned-1" "alien"          [ [ integer c-ptr integer ] [ ] ] }
-    { "alien-float" "alien"                   [ [ c-ptr integer ] [ float ] ] }
-    { "set-alien-float" "alien"               [ [ float c-ptr integer ] [ ] ] }
-    { "alien-double" "alien"                  [ [ c-ptr integer ] [ float ] ] }
-    { "set-alien-double" "alien"              [ [ float c-ptr integer ] [ ] ] }
-    { "alien-c-string" "alien"                [ [ c-ptr integer ] [ string ] ] }
-    { "set-alien-c-string" "alien"            [ [ string c-ptr integer ] [ ] ] }
-    { "throw" "errors"                        [ [ object ] [ ] ] }
-    { "string>memory" "kernel-internals"      [ [ string integer ] [ ] ] }
-    { "memory>string" "kernel-internals"      [ [ integer integer ] [ string ] ] }
-    { "alien-address" "alien"                 [ [ alien ] [ integer ] ] }
-    { "slot" "kernel-internals"               [ [ object fixnum ] [ object ] ] }
-    { "set-slot" "kernel-internals"           [ [ object object fixnum ] [ ] ] }
-    { "integer-slot" "kernel-internals"       [ [ object fixnum ] [ integer ] ] }
-    { "set-integer-slot" "kernel-internals"   [ [ integer object fixnum ] [ ] ] }
-    { "char-slot" "kernel-internals"          [ [ object fixnum ] [ fixnum ] ] }
-    { "set-char-slot" "kernel-internals"      [ [ integer object fixnum ] [ ] ] }
-    { "resize-array" "kernel-internals"       [ [ integer array ] [ array ] ] }
-    { "resize-string" "strings"               [ [ integer string ] [ string ] ] }
-    { "<hashtable>" "hashtables"              [ [ number ] [ hashtable ] ] }
-    { "<array>" "kernel-internals"            [ [ number ] [ array ] ] }
-    { "<tuple>" "kernel-internals"            [ [ number ] [ tuple ] ] }
-    { "begin-scan" "memory"                   [ [ ] [ ] ] }
-    { "next-object" "memory"                  [ [ ] [ object ] ] }
-    { "end-scan" "memory"                     [ [ ] [ ] ] }
-    { "size" "memory"                         [ [ object ] [ fixnum ] ] }
-    { "die" "kernel"                          [ [ ] [ ] ] }
-    { "flush-icache" "assembler"              f }
-    [ "fopen"  "io-internals"                 [ [ string string ] [ alien ] ] ]
-    { "fgetc" "io-internals"                  [ [ alien ] [ object ] ] }
-    { "fwrite" "io-internals"                 [ [ string alien ] [ ] ] }
-    { "fflush" "io-internals"                 [ [ alien ] [ ] ] }
-    { "fclose" "io-internals"                 [ [ alien ] [ ] ] }
-    { "expired?" "alien"                      [ [ object ] [ boolean ] ] }
-    { "<wrapper>" "kernel"                    [ [ object ] [ wrapper ] ] }
-} dup length 3 swap [ + ] map-with [
-    make-primitive
-] 2each
-
-! These need a more descriptive comment.
+    { "execute" "words"                     }
+    { "call" "kernel"                       }
+    { "ifte" "kernel"                       }
+    { "dispatch" "kernel-internals"         }
+    { "cons" "lists"                        }
+    { "<vector>" "vectors"                  }
+    { "rehash-string" "strings"             }
+    { "<sbuf>" "strings"                    }
+    { "sbuf>string" "strings"               }
+    { ">fixnum" "math"                      }
+    { ">bignum" "math"                      }
+    { ">float" "math"                       }
+    { "(fraction>)" "math-internals"        }
+    { "str>float" "parser"                  }
+    { "(unparse-float)" "unparser"          }
+    { "float>bits" "math"                   }
+    { "double>bits" "math"                  }
+    { "bits>float" "math"                   }
+    { "bits>double" "math"                  }
+    { "<complex>" "math-internals"          }
+    { "fixnum+" "math-internals"            }
+    { "fixnum-" "math-internals"            }
+    { "fixnum*" "math-internals"            }
+    { "fixnum/i" "math-internals"           }
+    { "fixnum/f" "math-internals"           }
+    { "fixnum-mod" "math-internals"         }
+    { "fixnum/mod" "math-internals"         }
+    { "fixnum-bitand" "math-internals"      }
+    { "fixnum-bitor" "math-internals"       }
+    { "fixnum-bitxor" "math-internals"      }
+    { "fixnum-bitnot" "math-internals"      }
+    { "fixnum-shift" "math-internals"       }
+    { "fixnum<" "math-internals"            }
+    { "fixnum<=" "math-internals"           }
+    { "fixnum>" "math-internals"            }
+    { "fixnum>=" "math-internals"           }
+    { "bignum=" "math-internals"            }
+    { "bignum+" "math-internals"            }
+    { "bignum-" "math-internals"            }
+    { "bignum*" "math-internals"            }
+    { "bignum/i" "math-internals"           }
+    { "bignum/f" "math-internals"           }
+    { "bignum-mod" "math-internals"         }
+    { "bignum/mod" "math-internals"         }
+    { "bignum-bitand" "math-internals"      }
+    { "bignum-bitor" "math-internals"       }
+    { "bignum-bitxor" "math-internals"      }
+    { "bignum-bitnot" "math-internals"      }
+    { "bignum-shift" "math-internals"       }
+    { "bignum<" "math-internals"            }
+    { "bignum<=" "math-internals"           }
+    { "bignum>" "math-internals"            }
+    { "bignum>=" "math-internals"           }
+    { "float=" "math-internals"             }
+    { "float+" "math-internals"             }
+    { "float-" "math-internals"             }
+    { "float*" "math-internals"             }
+    { "float/f" "math-internals"            }
+    { "float<" "math-internals"             }
+    { "float<=" "math-internals"            }
+    { "float>" "math-internals"             }
+    { "float>=" "math-internals"            }
+    { "facos" "math-internals"              }
+    { "fasin" "math-internals"              }
+    { "fatan" "math-internals"              }
+    { "fatan2" "math-internals"             }
+    { "fcos" "math-internals"               }
+    { "fexp" "math-internals"               }
+    { "fcosh" "math-internals"              }
+    { "flog" "math-internals"               }
+    { "fpow" "math-internals"               }
+    { "fsin" "math-internals"               }
+    { "fsinh" "math-internals"              }
+    { "fsqrt" "math-internals"              }
+    { "<word>" "words"                      }
+    { "update-xt" "words"                   }
+    { "compiled?" "words"                   }
+    { "drop" "kernel"                       }
+    { "dup" "kernel"                        }
+    { "swap" "kernel"                       }
+    { "over" "kernel"                       }
+    { "pick" "kernel"                       }
+    { ">r" "kernel"                         }
+    { "r>" "kernel"                         }
+    { "eq?" "kernel"                        }
+    { "getenv" "kernel-internals"           }
+    { "setenv" "kernel-internals"           }
+    { "stat" "io"                           }
+    { "(directory)" "io"                    }
+    { "gc" "memory"                         }
+    { "gc-time" "memory"                    }
+    { "save-image" "memory"                 }
+    { "datastack" "kernel"                  }
+    { "callstack" "kernel"                  }
+    { "set-datastack" "kernel"              }
+    { "set-callstack" "kernel"              }
+    { "exit" "kernel"                       }
+    { "room" "memory"                       }
+    { "os-env" "kernel"                     }
+    { "millis" "kernel"                     }
+    { "(random-int)" "math"                 }
+    { "type" "kernel"                       }
+    { "tag" "kernel-internals"              }
+    { "cwd" "io"                            }
+    { "cd" "io"                             }
+    { "compiled-offset" "assembler"         }
+    { "set-compiled-offset" "assembler"     }
+    { "literal-top" "assembler"             }
+    { "set-literal-top" "assembler"         }
+    { "address" "memory"                    }
+    { "dlopen" "alien"                      }
+    { "dlsym" "alien"                       }
+    { "dlclose" "alien"                     }
+    { "<alien>" "alien"                     }
+    { "<byte-array>" "kernel-internals"     }
+    { "<displaced-alien>" "alien"           }
+    { "alien-signed-cell" "alien"           }
+    { "set-alien-signed-cell" "alien"       }
+    { "alien-unsigned-cell" "alien"         }
+    { "set-alien-unsigned-cell" "alien"     }
+    { "alien-signed-8" "alien"              }
+    { "set-alien-signed-8" "alien"          }
+    { "alien-unsigned-8" "alien"            }
+    { "set-alien-unsigned-8" "alien"        }
+    { "alien-signed-4" "alien"              }
+    { "set-alien-signed-4" "alien"          }
+    { "alien-unsigned-4" "alien"            }
+    { "set-alien-unsigned-4" "alien"        }
+    { "alien-signed-2" "alien"              }
+    { "set-alien-signed-2" "alien"          }
+    { "alien-unsigned-2" "alien"            }
+    { "set-alien-unsigned-2" "alien"        }
+    { "alien-signed-1" "alien"              }
+    { "set-alien-signed-1" "alien"          }
+    { "alien-unsigned-1" "alien"            }
+    { "set-alien-unsigned-1" "alien"        }
+    { "alien-float" "alien"                 }
+    { "set-alien-float" "alien"             }
+    { "alien-double" "alien"                }
+    { "set-alien-double" "alien"            }
+    { "alien-c-string" "alien"              }
+    { "set-alien-c-string" "alien"          }
+    { "throw" "errors"                      }
+    { "string>memory" "kernel-internals"    }
+    { "memory>string" "kernel-internals"    }
+    { "alien-address" "alien"               }
+    { "slot" "kernel-internals"             }
+    { "set-slot" "kernel-internals"         }
+    { "integer-slot" "kernel-internals"     }
+    { "set-integer-slot" "kernel-internals" }
+    { "char-slot" "kernel-internals"        }
+    { "set-char-slot" "kernel-internals"    }
+    { "resize-array" "kernel-internals"     }
+    { "resize-string" "strings"             }
+    { "<hashtable>" "hashtables"            }
+    { "<array>" "kernel-internals"          }
+    { "<tuple>" "kernel-internals"          }
+    { "begin-scan" "memory"                 }
+    { "next-object" "memory"                }
+    { "end-scan" "memory"                   }
+    { "size" "memory"                       }
+    { "die" "kernel"                        }
+    { "flush-icache" "assembler"            }
+    { "fopen"  "io-internals"               }
+    { "fgetc" "io-internals"                }
+    { "fwrite" "io-internals"               }
+    { "fflush" "io-internals"               }
+    { "fclose" "io-internals"               }
+    { "expired?" "alien"                    }
+    { "<wrapper>" "kernel"                  }
+} dup length 3 swap [ + ] map-with [ make-primitive ] 2each
+
+: set-stack-effect ( { vocab word effect } -- )
+    3unseq >r unit search r> "stack-effect" set-word-prop ;
+
 {
     { "drop" "kernel" " x -- " }
     { "dup" "kernel"  " x -- x x " }
@@ -220,6 +213,11 @@ vocabularies get [
     { "pick" "kernel" " x y z -- x y z x " }
     { ">r" "kernel"   " x -- r: x " }
     { "r>" "kernel"   " r: x -- x " }
+    { "datastack" "kernel" " -- ds " }
+    { "callstack" "kernel" " -- cs " }
+    { "set-datastack" "kernel" " ds -- " }
+    { "set-callstack" "kernel" " cs -- " }
+    { "flush-icache" "assembler" " -- " }
 } [
     set-stack-effect
 ] each

diff --git a/library/collections/arrays.factor b/library/collections/arrays.factor
index 5053511705b91a2cdc85c6850a3a687735202730..970e39712d425714d8a1812ec893f8167b6556c5 100644 (file)
--- a/library/collections/arrays.factor
+++ b/library/collections/arrays.factor
@@ -42,4 +42,4 @@ M: byte-array resize resize-array ;
     #! since you can fool the runtime and corrupt memory by
     #! specifying an incorrect size. Note that this word is also
     #! handled specially by the compiler's type inferencer.
-    <tuple> [ 2 set-slot ] keep ;
+    <tuple> [ 2 set-slot ] keep ; flushable

diff --git a/library/collections/assoc.factor b/library/collections/assoc.factor
index 2959adb23a02516317aadcd6dea18e6abe3a0bd4..56fd83ce9c4d6fa5241630ec6361dc4541674fa4 100644 (file)
--- a/library/collections/assoc.factor
+++ b/library/collections/assoc.factor
@@ -2,12 +2,6 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: lists USING: kernel sequences ;
 
-: assoc? ( list -- ? )
-    #! Push if the list appears to be an alist. An association
-    #! list is a list of conses where the car of each cons is a
-    #! key, and the cdr is a value.
-    dup list? [ [ cons? ] all? ] [ drop f ] ifte ;
-
 : assoc* ( key alist -- [[ key value ]] )
     #! Look up a key/value pair.
     [ car = ] find-with nip ;

diff --git a/library/collections/cons.factor b/library/collections/cons.factor
index 9e71d246e3c851c150db9492616f4ad62fb6a406..818185dedd50febb588da2b6583ea0fc151c2f35 100644 (file)
--- a/library/collections/cons.factor
+++ b/library/collections/cons.factor
@@ -18,7 +18,7 @@ M: general-list >list ( list -- list ) ;
 
 : last ( list -- last )
     #! Last cons of a list.
-    dup cdr cons? [ cdr last ] when ;
+    dup cdr cons? [ cdr last ] when ; foldable
 
 PREDICATE: general-list list ( list -- ? )
     #! Proper list test. A proper list is either f, or a cons
@@ -28,30 +28,32 @@ PREDICATE: general-list list ( list -- ? )
 : uncons ( [[ car cdr ]] -- car cdr ) dup car swap cdr ; inline
 : unswons ( [[ car cdr ]] -- cdr car ) dup cdr swap car ; inline
 
-: swons ( cdr car -- [[ car cdr ]] ) swap cons ;
-: unit ( a -- [ a ] ) f cons ;
-: 2list ( a b -- [ a b ] ) unit cons ;
-: 2unlist ( [ a b ] -- a b ) uncons car ;
+: swons ( cdr car -- [[ car cdr ]] ) swap cons ; inline
+: unit ( a -- [ a ] ) f cons ; inline
+: 2list ( a b -- [ a b ] ) unit cons ; inline
+: 2unlist ( [ a b ] -- a b ) uncons car ; inline
 
 : 2car ( cons cons -- car car ) swap car swap car ; inline
 : 2cdr ( cons cons -- car car ) swap cdr swap cdr ; inline
 
 : unpair ( list -- list1 list2 )
     [ uncons uncons unpair rot swons >r cons r> ] [ f f ] ifte* ;
+    flushable
 
 : <queue> ( -- queue )
     #! Make a new functional queue.
-    [[ [ ] [ ] ]] ;
+    [[ [ ] [ ] ]] ; foldable
 
 : queue-empty? ( queue -- ? )
-    uncons or not ;
+    uncons or not ; foldable
 
 : enque ( obj queue -- queue )
-    uncons >r cons r> cons ;
+    uncons >r cons r> cons ; foldable
 
 : deque ( queue -- obj queue )
     uncons
     [ uncons swapd cons ] [ reverse uncons f swons ] ifte* ;
+    foldable
 
 M: cons = ( obj cons -- ? )
     2dup eq? [

diff --git a/library/collections/hashtables.factor b/library/collections/hashtables.factor
index 984a6d5c759f3c586e53454603f553efa87de587..88b34ea49db4dbc5988d1352f4ef69e36d76006a 100644 (file)
--- a/library/collections/hashtables.factor
+++ b/library/collections/hashtables.factor
@@ -50,9 +50,9 @@ IN: hashtables
 
 : hash* ( key table -- [[ key value ]] )
     #! Look up a value in the hashtable.
-    2dup (hashcode) swap hash-bucket assoc* ;
+    2dup (hashcode) swap hash-bucket assoc* ; flushable
 
-: hash ( key table -- value ) hash* cdr ;
+: hash ( key table -- value ) hash* cdr ; flushable
 
 : set-hash* ( key hash quot -- )
     #! Apply the quotation to yield a new association list.
@@ -71,6 +71,7 @@ IN: hashtables
 : hash>alist ( hash -- alist )
     #! Push a list of key/value pairs in a hashtable.
     [ ] swap [ hash-bucket [ swons ] each ] each-bucket ;
+    flushable
 
 : (set-hash) ( value key hash -- )
     dup hash-size+ [ set-assoc ] set-hash* ;
@@ -106,13 +107,13 @@ IN: hashtables
 
 : alist>hash ( alist -- hash )
     dup length 1 max <hashtable> swap
-    [ unswons pick set-hash ] each ;
+    [ unswons pick set-hash ] each ; foldable
 
 : hash-keys ( hash -- list )
-    hash>alist [ car ] map ;
+    hash>alist [ car ] map ; flushable
 
 : hash-values ( hash -- alist )
-    hash>alist [ cdr ] map ;
+    hash>alist [ cdr ] map ; flushable
 
 : hash-each ( hash quot -- | quot: [[ k v ]] -- )
     swap hash-array [ swap each ] each-with ; inline
@@ -134,7 +135,7 @@ IN: hashtables
         ] [
             r> 2drop f
         ] ifte
-    ] hash-all-with? ;
+    ] hash-all-with? ; flushable
 
 : hash-subset ( hash quot -- hash | quot: [[ k v ]] -- ? )
     >r hash>alist r> subset alist>hash ; inline
@@ -174,7 +175,7 @@ M: hashtable hashcode ( hash -- n )
     [ pick set-hash ] 2each ; inline
 
 : ?hash ( key hash/f -- value/f )
-    dup [ hash ] [ 2drop f ] ifte ;
+    dup [ hash ] [ 2drop f ] ifte ; flushable
 
 : ?set-hash ( value key hash/f -- hash )
     [ 1 <hashtable> ] unless* [ set-hash ] keep ;

diff --git a/library/collections/namespaces.factor b/library/collections/namespaces.factor
index e5d9c517472fa15cd6398cc1be79007f9a55ab92..8e544dbbc9af85e1fac74089555e603c7b703fd9 100644 (file)
--- a/library/collections/namespaces.factor
+++ b/library/collections/namespaces.factor
@@ -30,7 +30,7 @@ strings vectors words ;
 
 : namespace ( -- namespace )
     #! Push the current namespace.
-    namestack car ;
+    namestack car ; inline
 
 : >n ( namespace -- n:namespace )
     #! Push a namespace on the name stack.
@@ -44,7 +44,7 @@ strings vectors words ;
 
 : <namespace> ( -- n )
     #! Create a new namespace.
-    23 <hashtable> ;
+    23 <hashtable> ; flushable
 
 : (get) ( var ns -- value )
     #! Internal word for searching the namestack.
@@ -56,12 +56,12 @@ strings vectors words ;
         ] ?ifte
     ] [
         2drop f
-    ] ifte ;
+    ] ifte ; flushable
 
 : get ( variable -- value )
     #! Push the value of a variable by searching the namestack
     #! from the top down.
-    namestack (get) ;
+    namestack (get) ; flushable
 
 : set ( value variable -- ) namespace set-hash ;
 

diff --git a/library/collections/sequence-eq.factor b/library/collections/sequence-eq.factor
index 049c2e6cdca39d59ee28d17d7defca69dc3bdab8..073bab0eee57aebb71a90916a9014197581aa25f 100644 (file)
--- a/library/collections/sequence-eq.factor
+++ b/library/collections/sequence-eq.factor
@@ -23,7 +23,7 @@ UNION: sequence array string sbuf vector ;
         swap >list swap >list =
     ] [
         2dup length= [ 0 (sequence=) ] [ 2drop f ] ifte
-    ] ifte ;
+    ] ifte ; flushable
 
 M: sequence = ( obj seq -- ? )
     2dup eq? [

diff --git a/library/collections/sequences-epilogue.factor b/library/collections/sequences-epilogue.factor
index 810d871f7a886f4cf43ee6e40e3be8be83cac9a1..6c5b1486b25bf1d766928bd9ca634dcad2469343 100644 (file)
--- a/library/collections/sequences-epilogue.factor
+++ b/library/collections/sequences-epilogue.factor
@@ -108,15 +108,15 @@ M: object empty? ( seq -- ? ) length 0 = ;
 
 M: object >list ( seq -- list ) dup length 0 rot (>list) ;
 
-: conjunction ( v -- ? ) [ ] all? ;
-: disjunction ( v -- ? ) [ ] contains? ;
+: conjunction ( v -- ? ) [ ] all? ; flushable
+: disjunction ( v -- ? ) [ ] contains? ; flushable
 
-: index   ( obj seq -- n )     [ = ] find-with drop ;
-: index*  ( obj i seq -- n )   [ = ] find-with* drop ;
-: member? ( obj seq -- ? )     [ = ] contains-with? ;
-: memq?   ( obj seq -- ? )     [ eq? ] contains-with? ;
-: remove  ( obj list -- list ) [ = not ] subset-with ;
-: remq    ( obj list -- list ) [ eq? not ] subset-with ;
+: index   ( obj seq -- n )     [ = ] find-with drop ; flushable
+: index*  ( obj i seq -- n )   [ = ] find-with* drop ; flushable
+: member? ( obj seq -- ? )     [ = ] contains-with? ; flushable
+: memq?   ( obj seq -- ? )     [ eq? ] contains-with? ; flushable
+: remove  ( obj list -- list ) [ = not ] subset-with ; flushable
+: remq    ( obj list -- list ) [ eq? not ] subset-with ; flushable
 
 : copy-into ( start to from -- )
     dup length [ >r pick r> + pick set-nth ] 2each 2drop ;
@@ -128,15 +128,15 @@ M: object >list ( seq -- list ) dup length 0 rot (>list) ;
 
 : append ( s1 s2 -- s1+s2 )
     #! Outputs a new sequence of the same type as s1.
-    swap [ swap nappend ] immutable ;
+    swap [ swap nappend ] immutable ; flushable
 
 : add ( seq elt -- seq )
     #! Outputs a new sequence of the same type as seq.
-    swap [ push ] immutable ;
+    swap [ push ] immutable ; flushable
 
 : append3 ( s1 s2 s3 -- s1+s2+s3 )
     #! Return a new sequence of the same type as s1.
-    rot [ [ rot nappend ] keep swap nappend ] immutable ;
+    rot [ [ rot nappend ] keep swap nappend ] immutable ; flushable
 
 : concat ( seq -- seq )
     #! Append a sequence of sequences together. The new sequence
@@ -144,7 +144,7 @@ M: object >list ( seq -- list ) dup length 0 rot (>list) ;
     dup empty? [
         [ 1024 <vector> swap [ dupd nappend ] each ] keep
         first like
-    ] unless ;
+    ] unless ; flushable
 
 M: object peek ( sequence -- element )
     #! Get value at end of sequence.
@@ -160,7 +160,7 @@ M: object peek ( sequence -- element )
 : prune ( seq -- seq )
     [
         dup length <vector> swap [ over push-new ] each
-    ] keep like ;
+    ] keep like ; flushable
 
 : >pop> ( stack -- stack ) dup pop drop ;
 
@@ -172,7 +172,7 @@ M: object peek ( sequence -- element )
         dup length <vector> swap
         [ over push 2dup push ] each nip >pop>
         concat
-    ] ifte ;
+    ] ifte ; flushable
 
 M: object reverse-slice ( seq -- seq ) <reversed> ;
 
@@ -180,17 +180,17 @@ M: object reverse ( seq -- seq ) [ <reversed> ] keep like ;
 
 ! Set theoretic operations
 : seq-intersect ( seq1 seq2 -- seq1/\seq2 )
-    [ swap member? ] subset-with ;
+    [ swap member? ] subset-with ; flushable
 
 : seq-diff ( seq1 seq2 -- seq2-seq1 )
-    [ swap member? not ] subset-with ;
+    [ swap member? not ] subset-with ; flushable
 
 : seq-union ( seq1 seq2 -- seq1\/seq2 )
-    append prune ;
+    append prune ; flushable
 
 : contained? ( seq1 seq2 -- ? )
     #! Is every element of seq1 in seq2
-    swap [ swap member? ] all-with? ;
+    swap [ swap member? ] all-with? ; flushable
 
 ! Lexicographic comparison
 : (lexi) ( seq seq i limit -- n )
@@ -202,24 +202,24 @@ M: object reverse ( seq -- seq ) [ <reversed> ] keep like ;
         ] [
             r> drop - >r 3drop r>
         ] ifte
-    ] ifte ;
+    ] ifte ; flushable
 
 : lexi ( s1 s2 -- n )
     #! Lexicographically compare two sequences of numbers
     #! (usually strings). Negative if s1<s2, zero if s1=s2,
     #! positive if s1>s2.
-    0 pick length pick length min (lexi) ;
+    0 pick length pick length min (lexi) ; flushable
 
 : flip ( seq -- seq )
     #! An example illustrates this word best:
     #! { { 1 2 3 } { 4 5 6 } } ==> { { 1 2 } { 3 4 } { 5 6 } }
     dup empty? [
         dup first length [ swap [ nth ] map-with ] map-with
-    ] unless ;
+    ] unless ; flushable
 
 : max-length ( seq -- n )
     #! Longest sequence length in a sequence of sequences.
-    0 [ length max ] reduce ;
+    0 [ length max ] reduce ; flushable
 
 IN: kernel
 

diff --git a/library/collections/sequences.factor b/library/collections/sequences.factor
index a21f81fabeb70590fbafb4d62ff28b83c57d65b2..7b4dd85a1e5c6c2f5d1d4af8c75b897d747dbe9e 100644 (file)
--- a/library/collections/sequences.factor
+++ b/library/collections/sequences.factor
@@ -11,19 +11,18 @@ USING: errors generic kernel math math-internals strings vectors ;
 ! kernel-internals vocabulary, so don't use them unless you have
 ! a good reason.
 
-GENERIC: empty? ( sequence -- ? )
-GENERIC: length ( sequence -- n )
-GENERIC: set-length ( n sequence -- )
-GENERIC: nth ( n sequence -- obj )
-GENERIC: set-nth ( value n sequence -- obj )
-GENERIC: thaw ( seq -- mutable-seq )
-GENERIC: like ( seq seq -- seq )
-GENERIC: reverse ( seq -- seq )
-GENERIC: reverse-slice ( seq -- seq )
-GENERIC: peek ( seq -- elt )
-GENERIC: head ( n seq -- seq )
-GENERIC: tail ( n seq -- seq )
-GENERIC: concat ( seq -- seq )
+GENERIC: empty? ( sequence -- ? ) flushable
+GENERIC: length ( sequence -- n ) flushable
+GENERIC: set-length ( n sequence -- ) flushable
+GENERIC: nth ( n sequence -- obj ) flushable
+GENERIC: set-nth ( value n sequence -- obj ) flushable
+GENERIC: thaw ( seq -- mutable-seq ) flushable
+GENERIC: like ( seq seq -- seq ) flushable
+GENERIC: reverse ( seq -- seq ) flushable
+GENERIC: reverse-slice ( seq -- seq ) flushable
+GENERIC: peek ( seq -- elt ) flushable
+GENERIC: head ( n seq -- seq ) flushable
+GENERIC: tail ( n seq -- seq ) flushable
 GENERIC: resize ( n seq -- seq )
 
 : immutable ( seq quot -- seq | quot: seq -- )
@@ -56,10 +55,10 @@ G: find ( seq quot -- i elt | quot: elt -- ? )
 : 2nth ( s s n -- x x ) tuck swap nth >r swap nth r> ; inline
 
 : 2unseq ( { x y } -- x y )
-    dup first swap second ;
+    dup first swap second ; inline
 
 : 3unseq ( { x y z } -- x y z )
-    dup first over second rot third ;
+    dup first over second rot third ; inline
 
 TUPLE: bounds-error index seq ;
 : bounds-error <bounds-error> throw ;

diff --git a/library/collections/slicing.factor b/library/collections/slicing.factor
index 264cae583b536e4d36459796179f09feef38d25d..ebd81d4a4793df0bda68619a3990b385a2d8b185 100644 (file)
--- a/library/collections/slicing.factor
+++ b/library/collections/slicing.factor
@@ -6,64 +6,64 @@ strings vectors ;
 
 : head-slice ( n seq -- slice )
     #! n is an index from the start of the sequence.
-    0 -rot <slice> ;
+    0 -rot <slice> ; flushable
 
 : head-slice* ( n seq -- slice )
     #! n is an index from the end of the sequence.
-    [ length swap - ] keep head-slice ;
+    [ length swap - ] keep head-slice ; flushable
 
 : tail-slice ( n seq -- slice )
     #! n is an index from the start of the sequence.
-    [ length ] keep <slice> ;
+    [ length ] keep <slice> ; flushable
 
 : tail-slice* ( n seq -- slice )
     #! n is an index from the end of the sequence.
-    [ length swap - ] keep tail-slice ;
+    [ length swap - ] keep tail-slice ; flushable
 
 : subseq ( from to seq -- seq )
     #! Makes a new sequence with the same contents and type as
     #! the slice of another sequence.
-    [ <slice> ] keep like ;
+    [ <slice> ] keep like ; flushable
 
 M: object head ( index seq -- seq )
     [ head-slice ] keep like ;
 
 : head* ( n seq -- seq )
-    [ head-slice* ] keep like ;
+    [ head-slice* ] keep like ; flushable
 
 M: object tail ( index seq -- seq )
     [ tail-slice ] keep like ;
 
 : tail* ( n seq -- seq )
-    [ tail-slice* ] keep like ;
+    [ tail-slice* ] keep like ; flushable
 
 : length< ( seq seq -- ? )
-    swap length swap length < ;
+    swap length swap length < ; flushable
 
 : head? ( seq begin -- ? )
     2dup length< [
         2drop f
     ] [
         dup length rot head-slice sequence=
-    ] ifte ;
+    ] ifte ; flushable
 
 : ?head ( seq begin -- str ? )
-    2dup head? [ length swap tail t ] [ drop f ] ifte ;
+    2dup head? [ length swap tail t ] [ drop f ] ifte ; flushable
 
 : tail? ( seq end -- ? )
     2dup length< [
         2drop f
     ] [
         dup length rot tail-slice* sequence=
-    ] ifte ;
+    ] ifte ; flushable
 
 : ?tail ( seq end -- seq ? )
-    2dup tail? [ length swap head* t ] [ drop f ] ifte ;
+    2dup tail? [ length swap head* t ] [ drop f ] ifte ; flushable
 
 : cut ( index seq -- seq seq )
     #! Returns 2 sequences, that when concatenated yield the
     #! original sequence.
-    [ head ] 2keep tail ;
+    [ head ] 2keep tail ; flushable
 
 : group-advance subseq , >r tuck + swap r> ;
 
@@ -78,7 +78,7 @@ M: object tail ( index seq -- seq )
 
 : group ( n seq -- list )
     #! Split a sequence into element chunks.
-    [ 0 -rot (group) ] make-list ;
+    [ 0 -rot (group) ] make-list ; flushable
 
 : start-step ( subseq seq n -- subseq slice )
     pick length dupd + rot <slice> ;
@@ -92,20 +92,20 @@ M: object tail ( index seq -- seq )
         ] [
             r> r> 1 + start*
         ] ifte
-    ] ifte ;
+    ] ifte ; flushable
 
 : start ( subseq seq -- n )
     #! The index of a subsequence in a sequence.
-    0 start* ;
+    0 start* ; flushable
 
-: subseq? ( subseq seq -- ? ) start -1 > ;
+: subseq? ( subseq seq -- ? ) start -1 > ; flushable
 
 : split1 ( seq subseq -- before after )
     dup pick start dup -1 = [
         2drop f
     ] [
         [ swap length + over tail ] keep rot head swap
-    ] ifte ;
+    ] ifte ; flushable
 
 : split-next ( index seq subseq -- next )
     pick >r dup pick r> start* dup -1 = [
@@ -124,4 +124,4 @@ M: object tail ( index seq -- seq )
 : split ( seq subseq -- list )
     #! Split the sequence at each occurrence of subseq, and push
     #! a list of the pieces.
-    [ 0 -rot (split) ] make-list ;
+    [ 0 -rot (split) ] make-list ; flushable

diff --git a/library/collections/strings-epilogue.factor b/library/collections/strings-epilogue.factor
index 6c15b6745774f60704f519db2797f51baa5c1b39..dd5ebc4df4533747933622c4ae245dde64619b96 100644 (file)
--- a/library/collections/strings-epilogue.factor
+++ b/library/collections/strings-epilogue.factor
@@ -12,14 +12,16 @@ sequences strings ;
 
 : padding ( string count char -- string )
     >r swap length - dup 0 <= [ r> 2drop "" ] [ r> fill ] ifte ;
+    flushable
 
 : pad-left ( string count char -- string )
-    pick >r padding r> append ;
+    pick >r padding r> append ; flushable
 
 : pad-right ( string count char -- string )
-    pick >r padding r> swap append ;
+    pick >r padding r> swap append ; flushable
 
-: ch>string ( ch -- str ) 1 <sbuf> [ push ] keep (sbuf>string) ;
+: ch>string ( ch -- str )
+    1 <sbuf> [ push ] keep (sbuf>string) ; flushable
 
 : >sbuf ( seq -- sbuf )
     dup length <sbuf> [ swap nappend ] keep ; inline

diff --git a/library/collections/strings.factor b/library/collections/strings.factor
index 64ce5d88088094999bcd68b0ae2d7b0e870fa731..400f0aeb56155b6c2240457310f0fcc576d85677 100644 (file)
--- a/library/collections/strings.factor
+++ b/library/collections/strings.factor
@@ -5,7 +5,7 @@ USING: generic kernel kernel-internals lists math sequences ;
 
 M: string nth ( n str -- ch ) bounds-check char-slot ;
 
-GENERIC: >string ( seq -- string )
+GENERIC: >string ( seq -- string ) flushable
 
 M: string >string ;
 
@@ -19,7 +19,7 @@ PREDICATE: integer printable CHAR: \s CHAR: ~ between? ;
 : quotable? ( ch -- ? )
     #! In a string literal, can this character be used without
     #! escaping?
-    dup printable? swap "\"\\" member? not and ;
+    dup printable? swap "\"\\" member? not and ; foldable
 
 : url-quotable? ( ch -- ? )
     #! In a URL, can this character be used without
@@ -27,4 +27,4 @@ PREDICATE: integer printable CHAR: \s CHAR: ~ between? ;
     dup letter?
     over LETTER? or
     over digit? or
-    swap "/_?." member? or ;
+    swap "/_?." member? or ; foldable

diff --git a/library/collections/vectors-epilogue.factor b/library/collections/vectors-epilogue.factor
index 36750cf78adfe1577225cc55ffff66ceb20204ad..dcb4a81d3748288ceb68d7c7f39b05f814942b46 100644 (file)
--- a/library/collections/vectors-epilogue.factor
+++ b/library/collections/vectors-epilogue.factor
@@ -23,6 +23,6 @@ M: vector like drop >vector ;
 : (2vector) [ swapd push ] keep (1vector) ; inline
 : (3vector) [ >r rot r> push ] keep (2vector) ; inline
 
-: 1vector ( x -- { x } ) 1 <vector> (1vector) ;
-: 2vector ( x y -- { x y } ) 2 <vector> (2vector) ;
-: 3vector ( x y z -- { x y z } ) 3 <vector> (3vector) ;
+: 1vector ( x -- { x } ) 1 <vector> (1vector) ; flushable
+: 2vector ( x y -- { x y } ) 2 <vector> (2vector) ; flushable
+: 3vector ( x y z -- { x y z } ) 3 <vector> (3vector) ; flushable

diff --git a/library/inference/known-words.factor b/library/inference/known-words.factor
index de99cb50cea56436e3a31c8bcb565ce79a207935..e0970d503a9a1e862249d0d01ca820ec4fe51f54 100644 (file)
--- a/library/inference/known-words.factor
+++ b/library/inference/known-words.factor
@@ -1,7 +1,7 @@
 IN: inference
-USING: errors generic hashtables interpreter kernel
-kernel-internals lists math math-internals parser sequences
-vectors words ;
+USING: alien assembler errors generic hashtables interpreter io
+io-internals kernel kernel-internals lists math math-internals
+memory parser sequences strings unparser vectors words ;
 
 ! Primitive combinators
 \ call [
@@ -81,3 +81,455 @@ vectors words ;
 \ bitnot [ [ integer ] [ integer ] ] "infer-effect" set-word-prop
 \ real [ [ number ] [ real ] ] "infer-effect" set-word-prop
 \ imaginary [ [ number ] [ real ] ] "infer-effect" set-word-prop
+
+! Stack effects for all primitives
+\ execute [ [ word ] [ ] ] "infer-effect" set-word-prop
+
+\ call [ [ general-list ] [ ] ] "infer-effect" set-word-prop
+
+\ ifte [ [ object general-list general-list ] [ ] ] "infer-effect" set-word-prop
+
+\ dispatch [ [ fixnum vector ] [ ] ] "infer-effect" set-word-prop
+
+\ cons [ [ object object ] [ cons ] ] "infer-effect" set-word-prop
+\ cons t "foldable" set-word-prop
+\ cons t "flushable" set-word-prop
+
+\ <vector> [ [ integer ] [ vector ] ] "infer-effect" set-word-prop
+\ <vector> t "flushable" set-word-prop
+
+\ rehash-string [ [ string ] [ ] ] "infer-effect" set-word-prop
+
+\ <sbuf> [ [ integer ] [ sbuf ] ] "infer-effect" set-word-prop
+\ <sbuf> t "flushable" set-word-prop
+
+\ sbuf>string [ [ sbuf ] [ string ] ] "infer-effect" set-word-prop
+\ sbuf>string t "flushable" set-word-prop
+
+\ >fixnum [ [ number ] [ fixnum ] ] "infer-effect" set-word-prop
+\ >fixnum t "flushable" set-word-prop
+\ >fixnum t "foldable" set-word-prop
+
+\ >bignum [ [ number ] [ bignum ] ] "infer-effect" set-word-prop
+\ >bignum t "flushable" set-word-prop
+\ >bignum t "foldable" set-word-prop
+
+\ >float [ [ number ] [ float ] ] "infer-effect" set-word-prop
+\ >float t "flushable" set-word-prop
+\ >float t "foldable" set-word-prop
+
+\ (fraction>) [ [ integer integer ] [ rational ] ] "infer-effect" set-word-prop
+\ (fraction>) t "flushable" set-word-prop
+\ (fraction>) t "foldable" set-word-prop
+
+\ str>float [ [ string ] [ float ] ] "infer-effect" set-word-prop
+\ str>float t "flushable" set-word-prop
+\ str>float t "foldable" set-word-prop
+
+\ (unparse-float) [ [ float ] [ string ] ] "infer-effect" set-word-prop
+\ (unparse-float) t "flushable" set-word-prop
+\ (unparse-float) t "foldable" set-word-prop
+
+\ float>bits [ [ real ] [ integer ] ] "infer-effect" set-word-prop
+\ float>bits t "flushable" set-word-prop
+\ float>bits t "foldable" set-word-prop
+
+\ double>bits [ [ real ] [ integer ] ] "infer-effect" set-word-prop
+\ double>bits t "flushable" set-word-prop
+\ double>bits t "foldable" set-word-prop
+
+\ bits>float [ [ integer ] [ float ] ] "infer-effect" set-word-prop
+\ bits>float t "flushable" set-word-prop
+\ bits>float t "foldable" set-word-prop
+
+\ bits>double [ [ integer ] [ float ] ] "infer-effect" set-word-prop
+\ bits>double t "flushable" set-word-prop
+\ bits>double t "foldable" set-word-prop
+
+\ <complex> [ [ real real ] [ number ] ] "infer-effect" set-word-prop
+\ <complex> t "flushable" set-word-prop
+\ <complex> t "foldable" set-word-prop
+
+\ fixnum+ [ [ fixnum fixnum ] [ integer ] ] "infer-effect" set-word-prop
+\ fixnum+ t "flushable" set-word-prop
+\ fixnum+ t "foldable" set-word-prop
+
+\ fixnum- [ [ fixnum fixnum ] [ integer ] ] "infer-effect" set-word-prop
+\ fixnum- t "flushable" set-word-prop
+\ fixnum- t "foldable" set-word-prop
+
+\ fixnum* [ [ fixnum fixnum ] [ integer ] ] "infer-effect" set-word-prop
+\ fixnum* t "flushable" set-word-prop
+\ fixnum* t "foldable" set-word-prop
+
+\ fixnum/i [ [ fixnum fixnum ] [ integer ] ] "infer-effect" set-word-prop
+\ fixnum/i t "flushable" set-word-prop
+\ fixnum/i t "foldable" set-word-prop
+
+\ fixnum/f [ [ fixnum fixnum ] [ integer ] ] "infer-effect" set-word-prop
+\ fixnum/f t "flushable" set-word-prop
+\ fixnum/f t "foldable" set-word-prop
+
+\ fixnum-mod [ [ fixnum fixnum ] [ fixnum ] ] "infer-effect" set-word-prop
+\ fixnum-mod t "flushable" set-word-prop
+\ fixnum-mod t "foldable" set-word-prop
+
+\ fixnum/mod [ [ fixnum fixnum ] [ integer fixnum ] ] "infer-effect" set-word-prop
+\ fixnum/mod t "flushable" set-word-prop
+\ fixnum/mod t "foldable" set-word-prop
+
+\ fixnum-bitand [ [ fixnum fixnum ] [ fixnum ] ] "infer-effect" set-word-prop
+\ fixnum-bitand t "flushable" set-word-prop
+\ fixnum-bitand t "foldable" set-word-prop
+
+\ fixnum-bitor [ [ fixnum fixnum ] [ fixnum ] ] "infer-effect" set-word-prop
+\ fixnum-bitor t "flushable" set-word-prop
+\ fixnum-bitor t "foldable" set-word-prop
+
+\ fixnum-bitxor [ [ fixnum fixnum ] [ fixnum ] ] "infer-effect" set-word-prop
+\ fixnum-bitxor t "flushable" set-word-prop
+\ fixnum-bitxor t "foldable" set-word-prop
+
+\ fixnum-bitnot [ [ fixnum ] [ fixnum ] ] "infer-effect" set-word-prop
+\ fixnum-bitnot t "flushable" set-word-prop
+\ fixnum-bitnot t "foldable" set-word-prop
+
+\ fixnum-shift [ [ fixnum fixnum ] [ integer ] ] "infer-effect" set-word-prop
+\ fixnum-shift t "flushable" set-word-prop
+\ fixnum-shift t "foldable" set-word-prop
+
+\ fixnum< [ [ fixnum fixnum ] [ boolean ] ] "infer-effect" set-word-prop
+\ fixnum< t "flushable" set-word-prop
+\ fixnum< t "foldable" set-word-prop
+
+\ fixnum<= [ [ fixnum fixnum ] [ boolean ] ] "infer-effect" set-word-prop
+\ fixnum<= t "flushable" set-word-prop
+\ fixnum<= t "foldable" set-word-prop
+
+\ fixnum> [ [ fixnum fixnum ] [ boolean ] ] "infer-effect" set-word-prop
+\ fixnum> t "flushable" set-word-prop
+\ fixnum> t "foldable" set-word-prop
+
+\ fixnum>= [ [ fixnum fixnum ] [ boolean ] ] "infer-effect" set-word-prop
+\ fixnum>= t "flushable" set-word-prop
+\ fixnum>= t "foldable" set-word-prop
+
+\ bignum= [ [ bignum bignum ] [ boolean ] ] "infer-effect" set-word-prop
+\ bignum= t "flushable" set-word-prop
+\ bignum= t "foldable" set-word-prop
+
+\ bignum+ [ [ bignum bignum ] [ bignum ] ] "infer-effect" set-word-prop
+\ bignum+ t "flushable" set-word-prop
+\ bignum+ t "foldable" set-word-prop
+
+\ bignum- [ [ bignum bignum ] [ bignum ] ] "infer-effect" set-word-prop
+\ bignum- t "flushable" set-word-prop
+\ bignum- t "foldable" set-word-prop
+
+\ bignum* [ [ bignum bignum ] [ bignum ] ] "infer-effect" set-word-prop
+\ bignum* t "flushable" set-word-prop
+\ bignum* t "foldable" set-word-prop
+
+\ bignum/i [ [ bignum bignum ] [ bignum ] ] "infer-effect" set-word-prop
+\ bignum/i t "flushable" set-word-prop
+\ bignum/i t "foldable" set-word-prop
+
+\ bignum/f [ [ bignum bignum ] [ bignum ] ] "infer-effect" set-word-prop
+\ bignum/f t "flushable" set-word-prop
+\ bignum/f t "foldable" set-word-prop
+
+\ bignum-mod [ [ bignum bignum ] [ bignum ] ] "infer-effect" set-word-prop
+\ bignum-mod t "flushable" set-word-prop
+\ bignum-mod t "foldable" set-word-prop
+
+\ bignum/mod [ [ bignum bignum ] [ bignum bignum ] ] "infer-effect" set-word-prop
+\ bignum/mod t "flushable" set-word-prop
+\ bignum/mod t "foldable" set-word-prop
+
+\ bignum-bitand [ [ bignum bignum ] [ bignum ] ] "infer-effect" set-word-prop
+\ bignum-bitand t "flushable" set-word-prop
+\ bignum-bitand t "foldable" set-word-prop
+
+\ bignum-bitor [ [ bignum bignum ] [ bignum ] ] "infer-effect" set-word-prop
+\ bignum-bitor t "flushable" set-word-prop
+\ bignum-bitor t "foldable" set-word-prop
+
+\ bignum-bitxor [ [ bignum bignum ] [ bignum ] ] "infer-effect" set-word-prop
+\ bignum-bitxor t "flushable" set-word-prop
+\ bignum-bitxor t "foldable" set-word-prop
+
+\ bignum-bitnot [ [ bignum ] [ bignum ] ] "infer-effect" set-word-prop
+\ bignum-bitnot t "flushable" set-word-prop
+\ bignum-bitnot t "foldable" set-word-prop
+
+\ bignum-shift [ [ bignum bignum ] [ bignum ] ] "infer-effect" set-word-prop
+\ bignum-shift t "flushable" set-word-prop
+\ bignum-shift t "foldable" set-word-prop
+
+\ bignum< [ [ bignum bignum ] [ boolean ] ] "infer-effect" set-word-prop
+\ bignum< t "flushable" set-word-prop
+\ bignum< t "foldable" set-word-prop
+
+\ bignum<= [ [ bignum bignum ] [ boolean ] ] "infer-effect" set-word-prop
+\ bignum<= t "flushable" set-word-prop
+\ bignum<= t "foldable" set-word-prop
+
+\ bignum> [ [ bignum bignum ] [ boolean ] ] "infer-effect" set-word-prop
+\ bignum> t "flushable" set-word-prop
+\ bignum> t "foldable" set-word-prop
+
+\ bignum>= [ [ bignum bignum ] [ boolean ] ] "infer-effect" set-word-prop
+\ bignum>= t "flushable" set-word-prop
+\ bignum>= t "foldable" set-word-prop
+
+\ float= [ [ bignum bignum ] [ boolean ] ] "infer-effect" set-word-prop
+\ float= t "flushable" set-word-prop
+\ float= t "foldable" set-word-prop
+
+\ float+ [ [ float float ] [ float ] ] "infer-effect" set-word-prop
+\ float+ t "flushable" set-word-prop
+\ float+ t "foldable" set-word-prop
+
+\ float- [ [ float float ] [ float ] ] "infer-effect" set-word-prop
+\ float- t "flushable" set-word-prop
+\ float- t "foldable" set-word-prop
+
+\ float* [ [ float float ] [ float ] ] "infer-effect" set-word-prop
+\ float* t "flushable" set-word-prop
+\ float* t "foldable" set-word-prop
+
+\ float/f [ [ float float ] [ float ] ] "infer-effect" set-word-prop
+\ float/f t "flushable" set-word-prop
+\ float/f t "foldable" set-word-prop
+
+\ float< [ [ float float ] [ boolean ] ] "infer-effect" set-word-prop
+\ float< t "flushable" set-word-prop
+\ float< t "foldable" set-word-prop
+
+\ float<= [ [ float float ] [ boolean ] ] "infer-effect" set-word-prop
+\ float<= t "flushable" set-word-prop
+\ float<= t "foldable" set-word-prop
+
+\ float> [ [ float float ] [ boolean ] ] "infer-effect" set-word-prop
+\ float> t "flushable" set-word-prop
+\ float> t "foldable" set-word-prop
+
+\ float>= [ [ float float ] [ boolean ] ] "infer-effect" set-word-prop
+\ float>= t "flushable" set-word-prop
+\ float>= t "foldable" set-word-prop
+
+\ facos [ [ real ] [ float ] ] "infer-effect" set-word-prop
+\ facos t "flushable" set-word-prop
+\ facos t "foldable" set-word-prop
+
+\ fasin [ [ real ] [ float ] ] "infer-effect" set-word-prop
+\ fasin t "flushable" set-word-prop
+\ fasin t "foldable" set-word-prop
+
+\ fatan [ [ real ] [ float ] ] "infer-effect" set-word-prop
+\ fatan t "flushable" set-word-prop
+\ fatan t "foldable" set-word-prop
+
+\ fatan2 [ [ real real ] [ float ] ] "infer-effect" set-word-prop
+\ fatan2 t "flushable" set-word-prop
+\ fatan2 t "foldable" set-word-prop
+
+\ fcos [ [ real ] [ float ] ] "infer-effect" set-word-prop
+\ fcos t "flushable" set-word-prop
+\ fcos t "foldable" set-word-prop
+
+\ fexp [ [ real ] [ float ] ] "infer-effect" set-word-prop
+\ fexp t "flushable" set-word-prop
+\ fexp t "foldable" set-word-prop
+
+\ fcosh [ [ real ] [ float ] ] "infer-effect" set-word-prop
+\ fcosh t "flushable" set-word-prop
+\ fcosh t "foldable" set-word-prop
+
+\ flog [ [ real ] [ float ] ] "infer-effect" set-word-prop
+\ flog t "flushable" set-word-prop
+\ flog t "foldable" set-word-prop
+
+\ fpow [ [ real real ] [ float ] ] "infer-effect" set-word-prop
+\ fpow t "flushable" set-word-prop
+\ fpow t "foldable" set-word-prop
+
+\ fsin [ [ real ] [ float ] ] "infer-effect" set-word-prop
+\ fsin t "flushable" set-word-prop
+\ fsin t "foldable" set-word-prop
+
+\ fsinh [ [ real ] [ float ] ] "infer-effect" set-word-prop
+\ fsinh t "flushable" set-word-prop
+\ fsinh t "foldable" set-word-prop
+
+\ fsqrt [ [ real ] [ float ] ] "infer-effect" set-word-prop
+\ fsqrt t "flushable" set-word-prop
+\ fsqrt t "foldable" set-word-prop
+
+\ <word> [ [ ] [ word ] ] "infer-effect" set-word-prop
+\ <word> t "flushable" set-word-prop
+
+\ update-xt [ [ word ] [ ] ] "infer-effect" set-word-prop
+\ compiled? [ [ word ] [ boolean ] ] "infer-effect" set-word-prop
+\ drop [ [ object ] [ ] ] "infer-effect" set-word-prop
+\ dup [ [ object ] [ object object ] ] "infer-effect" set-word-prop
+\ swap [ [ object object ] [ object object ] ] "infer-effect" set-word-prop
+\ over [ [ object object ] [ object object object ] ] "infer-effect" set-word-prop
+\ pick [ [ object object object ] [ object object object object ] ] "infer-effect" set-word-prop
+\ >r [ [ object ] [ ] ] "infer-effect" set-word-prop
+\ r> [ [ ] [ object ] ] "infer-effect" set-word-prop
+
+\ eq? [ [ object object ] [ boolean ] ] "infer-effect" set-word-prop
+\ eq? t "flushable" set-word-prop
+\ eq? t "foldable" set-word-prop
+
+\ getenv [ [ fixnum ] [ object ] ] "infer-effect" set-word-prop
+\ setenv [ [ object fixnum ] [ ] ] "infer-effect" set-word-prop
+\ stat [ [ string ] [ general-list ] ] "infer-effect" set-word-prop
+\ (directory) [ [ string ] [ general-list ] ] "infer-effect" set-word-prop
+\ gc [ [ fixnum ] [ ] ] "infer-effect" set-word-prop
+\ gc-time [ [ string ] [ ] ] "infer-effect" set-word-prop
+\ save-image [ [ string ] [ ] ] "infer-effect" set-word-prop
+\ exit [ [ integer ] [ ] ] "infer-effect" set-word-prop
+\ room [ [ ] [ integer integer integer integer general-list ] ] "infer-effect" set-word-prop
+\ os-env [ [ string ] [ object ] ] "infer-effect" set-word-prop
+\ millis [ [ ] [ integer ] ] "infer-effect" set-word-prop
+\ (random-int) [ [ ] [ integer ] ] "infer-effect" set-word-prop
+\ type [ [ object ] [ fixnum ] ] "infer-effect" set-word-prop
+\ type t "flushable" set-word-prop
+\ type t "foldable" set-word-prop
+
+\ tag [ [ object ] [ fixnum ] ] "infer-effect" set-word-prop
+\ tag t "flushable" set-word-prop
+\ tag t "foldable" set-word-prop
+
+\ cwd [ [ ] [ string ] ] "infer-effect" set-word-prop
+\ cd [ [ string ] [ ] ] "infer-effect" set-word-prop
+
+\ compiled-offset [ [ ] [ integer ] ] "infer-effect" set-word-prop
+\ compiled-offset t "flushable" set-word-prop
+
+\ set-compiled-offset [ [ integer ] [ ] ] "infer-effect" set-word-prop
+
+\ literal-top [ [ ] [ integer ] ] "infer-effect" set-word-prop
+\ literal-top t "flushable" set-word-prop
+
+\ set-literal-top [ [ integer ] [ ] ] "infer-effect" set-word-prop
+
+\ address [ [ object ] [ integer ] ] "infer-effect" set-word-prop
+\ address t "flushable" set-word-prop
+
+\ dlopen [ [ string ] [ dll ] ] "infer-effect" set-word-prop
+\ dlsym [ [ string object ] [ integer ] ] "infer-effect" set-word-prop
+\ dlclose [ [ dll ] [ ] ] "infer-effect" set-word-prop
+
+\ <alien> [ [ integer ] [ alien ] ] "infer-effect" set-word-prop
+\ <alien> t "flushable" set-word-prop
+
+\ <byte-array> [ [ integer ] [ byte-array ] ] "infer-effect" set-word-prop
+\ <byte-array> t "flushable" set-word-prop
+
+\ <displaced-alien> [ [ integer c-ptr ] [ displaced-alien ] ] "infer-effect" set-word-prop
+\ <displaced-alien> t "flushable" set-word-prop
+
+\ alien-signed-cell [ [ c-ptr integer ] [ integer ] ] "infer-effect" set-word-prop
+\ alien-signed-cell t "flushable" set-word-prop
+
+\ set-alien-signed-cell [ [ integer c-ptr integer ] [ ] ] "infer-effect" set-word-prop
+\ alien-unsigned-cell [ [ c-ptr integer ] [ integer ] ] "infer-effect" set-word-prop
+\ alien-unsigned-cell t "flushable" set-word-prop
+
+\ set-alien-unsigned-cell [ [ integer c-ptr integer ] [ ] ] "infer-effect" set-word-prop
+\ alien-signed-8 [ [ c-ptr integer ] [ integer ] ] "infer-effect" set-word-prop
+\ alien-signed-8 t "flushable" set-word-prop
+
+\ set-alien-signed-8 [ [ integer c-ptr integer ] [ ] ] "infer-effect" set-word-prop
+\ alien-unsigned-8 [ [ c-ptr integer ] [ integer ] ] "infer-effect" set-word-prop
+\ alien-unsigned-8 t "flushable" set-word-prop
+
+\ set-alien-unsigned-8 [ [ integer c-ptr integer ] [ ] ] "infer-effect" set-word-prop
+\ alien-signed-4 [ [ c-ptr integer ] [ integer ] ] "infer-effect" set-word-prop
+\ alien-signed-4 t "flushable" set-word-prop
+
+\ set-alien-signed-4 [ [ integer c-ptr integer ] [ ] ] "infer-effect" set-word-prop
+\ alien-unsigned-4 [ [ c-ptr integer ] [ integer ] ] "infer-effect" set-word-prop
+\ alien-unsigned-4 t "flushable" set-word-prop
+
+\ set-alien-unsigned-4 [ [ integer c-ptr integer ] [ ] ] "infer-effect" set-word-prop
+\ alien-signed-2 [ [ c-ptr integer ] [ integer ] ] "infer-effect" set-word-prop
+\ alien-signed-2 t "flushable" set-word-prop
+
+\ set-alien-signed-2 [ [ integer c-ptr integer ] [ ] ] "infer-effect" set-word-prop
+\ alien-unsigned-2 [ [ c-ptr integer ] [ integer ] ] "infer-effect" set-word-prop
+\ alien-unsigned-2 t "flushable" set-word-prop
+
+\ set-alien-unsigned-2 [ [ integer c-ptr integer ] [ ] ] "infer-effect" set-word-prop
+\ alien-signed-1 [ [ c-ptr integer ] [ integer ] ] "infer-effect" set-word-prop
+\ alien-signed-1 t "flushable" set-word-prop
+
+\ set-alien-signed-1 [ [ integer c-ptr integer ] [ ] ] "infer-effect" set-word-prop
+\ alien-unsigned-1 [ [ c-ptr integer ] [ integer ] ] "infer-effect" set-word-prop
+\ alien-unsigned-1 t "flushable" set-word-prop
+
+\ set-alien-unsigned-1 [ [ integer c-ptr integer ] [ ] ] "infer-effect" set-word-prop
+\ alien-float [ [ c-ptr integer ] [ float ] ] "infer-effect" set-word-prop
+\ alien-float t "flushable" set-word-prop
+
+\ set-alien-float [ [ float c-ptr integer ] [ ] ] "infer-effect" set-word-prop
+\ alien-double [ [ c-ptr integer ] [ float ] ] "infer-effect" set-word-prop
+\ alien-double t "flushable" set-word-prop
+
+\ set-alien-double [ [ float c-ptr integer ] [ ] ] "infer-effect" set-word-prop
+\ alien-c-string [ [ c-ptr integer ] [ string ] ] "infer-effect" set-word-prop
+\ alien-c-string t "flushable" set-word-prop
+
+\ set-alien-c-string [ [ string c-ptr integer ] [ ] ] "infer-effect" set-word-prop
+\ throw [ [ object ] [ ] ] "infer-effect" set-word-prop
+\ string>memory [ [ string integer ] [ ] ] "infer-effect" set-word-prop
+\ memory>string [ [ integer integer ] [ string ] ] "infer-effect" set-word-prop
+\ alien-address [ [ alien ] [ integer ] ] "infer-effect" set-word-prop
+
+\ slot [ [ object fixnum ] [ object ] ] "infer-effect" set-word-prop
+\ slot t "flushable" set-word-prop
+
+\ set-slot [ [ object object fixnum ] [ ] ] "infer-effect" set-word-prop
+
+\ integer-slot [ [ object fixnum ] [ integer ] ] "infer-effect" set-word-prop
+\ integer-slot t "flushable" set-word-prop
+
+\ set-integer-slot [ [ integer object fixnum ] [ ] ] "infer-effect" set-word-prop
+
+\ char-slot [ [ object fixnum ] [ fixnum ] ] "infer-effect" set-word-prop
+\ char-slot t "flushable" set-word-prop
+
+\ set-char-slot [ [ integer object fixnum ] [ ] ] "infer-effect" set-word-prop
+\ resize-array [ [ integer array ] [ array ] ] "infer-effect" set-word-prop
+\ resize-string [ [ integer string ] [ string ] ] "infer-effect" set-word-prop
+
+\ <hashtable> [ [ number ] [ hashtable ] ] "infer-effect" set-word-prop
+\ <hashtable> t "flushable" set-word-prop
+
+\ <array> [ [ number ] [ array ] ] "infer-effect" set-word-prop
+\ <array> t "flushable" set-word-prop
+
+\ <tuple> [ [ number ] [ tuple ] ] "infer-effect" set-word-prop
+\ <tuple> t "flushable" set-word-prop
+
+\ begin-scan [ [ ] [ ] ] "infer-effect" set-word-prop
+\ next-object [ [ ] [ object ] ] "infer-effect" set-word-prop
+\ end-scan [ [ ] [ ] ] "infer-effect" set-word-prop
+
+\ size [ [ object ] [ fixnum ] ] "infer-effect" set-word-prop
+\ size t "flushable" set-word-prop
+
+\ die [ [ ] [ ] ] "infer-effect" set-word-prop
+\ fopen [ [ string string ] [ alien ] ] "infer-effect" set-word-prop
+\ fgetc [ [ alien ] [ object ] ] "infer-effect" set-word-prop
+\ fwrite [ [ string alien ] [ ] ] "infer-effect" set-word-prop
+\ fflush [ [ alien ] [ ] ] "infer-effect" set-word-prop
+\ fclose [ [ alien ] [ ] ] "infer-effect" set-word-prop
+\ expired? [ [ object ] [ boolean ] ] "infer-effect" set-word-prop
+
+\ <wrapper> [ [ object ] [ wrapper ] ] "infer-effect" set-word-prop
+\ <wrapper> t "flushable" set-word-prop
+\ <wrapper> t "foldable" set-word-prop

diff --git a/library/kernel.factor b/library/kernel.factor
index d47c23ff43c673d025ea66c2baf6d093fa62dbd3..dd686b87c98db770e8c2c5cc01fb577a22f120e3 100644 (file)
--- a/library/kernel.factor
+++ b/library/kernel.factor
@@ -25,13 +25,13 @@ USING: generic kernel-internals vectors ;
 UNION: boolean POSTPONE: f POSTPONE: t ;
 COMPLEMENT: general-t f
 
-GENERIC: hashcode ( obj -- n )
+GENERIC: hashcode ( obj -- n ) flushable
 M: object hashcode drop 0 ;
 
-GENERIC: = ( obj obj -- ? )
+GENERIC: = ( obj obj -- ? ) flushable
 M: object = eq? ;
 
-GENERIC: clone ( obj -- obj )
+GENERIC: clone ( obj -- obj ) flushable
 M: object clone ;
 
 : set-boot ( quot -- )

diff --git a/library/math/integer.factor b/library/math/integer.factor
index 391d936aa30979a5ab8bfa12f90b9f5cb2a5b7f9..e89514e0b2383f5d872bb7e35aff63dbfcdc15c2 100644 (file)
--- a/library/math/integer.factor
+++ b/library/math/integer.factor
@@ -15,16 +15,17 @@ UNION: integer fixnum bignum ;
 : gcd ( x y -- a d )
     #! Compute the greatest common divisor d and multiplier a
     #! such that a*x=d mod y.
-    swap 0 1 2swap (gcd) abs ;
+    swap 0 1 2swap (gcd) abs ; foldable
 
 : mod-inv ( x n -- y )
     #! Compute the multiplicative inverse of x mod n.
-    gcd 1 = [ "Non-trivial divisor found" throw ] unless ;
+    gcd 1 = [ "Non-trivial divisor found" throw ] unless ; foldable
 
 : bitroll ( n s w -- n )
     #! Roll n by s bits to the right, wrapping around after
     #! w bits.
     [ mod shift ] 3keep over 0 >= [ - ] [ + ] ifte shift bitor ;
+    foldable
 
 IN: math-internals
 

diff --git a/library/math/math.factor b/library/math/math.factor
index b71e899f49eea50b3d31b999588b4960474ea2c8..4e575e4d337b9d3c37613c3ff4573f20bc3beb3a 100644 (file)
--- a/library/math/math.factor
+++ b/library/math/math.factor
@@ -52,7 +52,7 @@ GENERIC: ceiling  ( n -- n ) foldable
 
 : sgn ( n -- -1/0/1 )
     #! Push the sign of a real number.
-    dup 0 = [ drop 0 ] [ 1 < -1 1 ? ] ifte ; inline
+    dup 0 = [ drop 0 ] [ 1 < -1 1 ? ] ifte ; foldable
 
 GENERIC: abs ( z -- |z| )
 

diff --git a/library/math/pow.factor b/library/math/pow.factor
index cd174e2c8c7a76f82b6ecf4205b49f55ece9b529..172eb67a82d97ec66400b031949df8ff6d5e5de4 100644 (file)
--- a/library/math/pow.factor
+++ b/library/math/pow.factor
@@ -14,7 +14,7 @@ USING: errors kernel math math-internals ;
         drop fsqrt 0 swap rect>
     ] [
         swap fsqrt swap 2 / polar>
-    ] ifte ;
+    ] ifte ; foldable
 
 : norm ( vec -- n ) norm-sq sqrt ;
 

diff --git a/library/math/random.factor b/library/math/random.factor
index 3341d1b06c1d7727789cdc293378e19bc08271fd..e9e642ed7c1a4707424bdb1e24bc1391916eb9d9 100644 (file)
--- a/library/math/random.factor
+++ b/library/math/random.factor
@@ -16,4 +16,5 @@ IN: math USING: kernel ;
         (random-int) 2dup swap mod (random-int-0)
     ] ifte ; inline
 
-: random-int ( min max -- n ) dupd swap - random-int-0 + ;
+: random-int ( min max -- n )
+    dupd swap - random-int-0 + ; flushable

diff --git a/library/test/lists/assoc.factor b/library/test/lists/assoc.factor
index 292ff9a5c4db235098ebc4b91ddc9fb2c3282cd1..5a7f85de0eae380cd5631c938536c2608e32d01e 100644 (file)
--- a/library/test/lists/assoc.factor
+++ b/library/test/lists/assoc.factor
@@ -13,10 +13,6 @@ USE: test
     [[ [ 1 2 ]  [ 2 1 ] ]]
 ] "assoc" set
 
-[ t ] [ "assoc" get assoc? ] unit-test
-[ f ] [ [[ 1 [[ 2 [[ 3 4 ]] ]] ]] assoc? ] unit-test
-[ f ] [ "assoc" assoc? ] unit-test
-
 [ f       ] [ "monkey" f           assoc ] unit-test
 [ f       ] [ "donkey" "assoc" get assoc ] unit-test
 [ 1       ] [ "monkey" "assoc" get assoc ] unit-test