! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel effects accessors math math.private math.libm
-math.partial-dispatch math.intervals layouts words sequences
-sequences.private arrays assocs classes classes.algebra
-combinators generic.math fry locals
-compiler.tree.propagation.info
-compiler.tree.propagation.nodes
+math.partial-dispatch math.intervals math.parser layouts words
+sequences sequences.private arrays assocs classes
+classes.algebra combinators generic.math splitting fry locals
+classes.tuple alien.accessors classes.tuple.private
+compiler.tree.propagation.info compiler.tree.propagation.nodes
compiler.tree.propagation.constraints ;
IN: compiler.tree.propagation.known-words
+\ and [
+ [ [ <true-constraint> ] bi@ <conjunction> ] dip if-true
+] +constraints+ set-word-prop
+
+\ not [
+ [ [ <false-constraint> ] [ <true-constraint> ] bi ] dip
+ <conditional>
+] +constraints+ set-word-prop
+
\ fixnum
most-negative-fixnum most-positive-fixnum [a,b]
+interval+ set-word-prop
\ abs [ [ interval-abs ] ?change-interval ] +outputs+ set-word-prop
: math-closure ( class -- newclass )
- { null fixnum bignum integer rational float real number }
- [ class<= ] with find nip number or ;
-
-: interval-subset?' ( i1 i2 -- ? )
- {
- { [ over not ] [ 2drop t ] }
- { [ dup not ] [ 2drop f ] }
- [ interval-subset? ]
- } cond ;
+ { fixnum bignum integer rational float real number object }
+ [ class<= ] with find nip ;
: fits? ( interval class -- ? )
- +interval+ word-prop interval-subset?' ;
+ +interval+ word-prop interval-subset? ;
: binary-op-class ( info1 info2 -- newclass )
- [ class>> math-closure ] bi@ math-class-max ;
+ [ class>> ] bi@
+ 2dup [ null class<= ] either? [ 2drop null ] [
+ [ math-closure ] bi@ math-class-max
+ ] if ;
: binary-op-interval ( info1 info2 quot -- newinterval )
[ [ interval>> ] bi@ 2dup and ] dip [ 2drop f ] if ; inline
-: <class/interval-info> ( class interval -- info )
- [ f f <value-info> ] [ <class-info> ] if* ;
-
: won't-overflow? ( class interval -- ? )
[ fixnum class<= ] [ fixnum fits? ] bi* and ;
: may-overflow ( class interval -- class' interval' )
- 2dup won't-overflow?
- [ [ integer math-class-max ] dip ] unless ;
+ over null class<= [
+ 2dup won't-overflow?
+ [ [ integer math-class-max ] dip ] unless
+ ] unless ;
: may-be-rational ( class interval -- class' interval' )
over null class<= [
[ rational math-class-max ] dip
] unless ;
+: number-valued ( class interval -- class' interval' )
+ [ number math-class-min ] dip ;
+
: integer-valued ( class interval -- class' interval' )
[ integer math-class-min ] dip ;
<class/interval-info>
] +outputs+ set-word-prop ;
-\ + [ [ interval+ ] [ may-overflow ] binary-op ] each-derived-op
-\ + [ [ interval+ ] [ ] binary-op ] each-fast-derived-op
+\ + [ [ interval+ ] [ may-overflow number-valued ] binary-op ] each-derived-op
+\ + [ [ interval+ ] [ number-valued ] binary-op ] each-fast-derived-op
-\ - [ [ interval+ ] [ may-overflow ] binary-op ] each-derived-op
-\ - [ [ interval+ ] [ ] binary-op ] each-fast-derived-op
+\ - [ [ interval- ] [ may-overflow number-valued ] binary-op ] each-derived-op
+\ - [ [ interval- ] [ number-valued ] binary-op ] each-fast-derived-op
-\ * [ [ interval* ] [ may-overflow ] binary-op ] each-derived-op
-\ * [ [ interval* ] [ ] binary-op ] each-fast-derived-op
+\ * [ [ interval* ] [ may-overflow number-valued ] binary-op ] each-derived-op
+\ * [ [ interval* ] [ number-valued ] binary-op ] each-fast-derived-op
-\ shift [ [ interval-shift-safe ] [ may-overflow ] binary-op ] each-derived-op
-\ shift [ [ interval-shift-safe ] [ ] binary-op ] each-fast-derived-op
-
-\ / [ [ interval/-safe ] [ may-be-rational ] binary-op ] each-derived-op
+\ / [ [ interval/-safe ] [ may-be-rational number-valued ] binary-op ] each-derived-op
\ /i [ [ interval/i ] [ may-overflow integer-valued ] binary-op ] each-derived-op
\ /f [ [ interval/f ] [ float-valued ] binary-op ] each-derived-op
\ mod [ [ interval-mod ] [ real-valued ] binary-op ] each-derived-op
\ rem [ [ interval-rem ] [ may-overflow real-valued ] binary-op ] each-derived-op
+\ shift [ [ interval-shift-safe ] [ may-overflow integer-valued ] binary-op ] each-derived-op
+\ shift [ [ interval-shift-safe ] [ integer-valued ] binary-op ] each-fast-derived-op
+
\ bitand [ [ interval-bitand ] [ integer-valued ] binary-op ] each-derived-op
\ bitor [ [ interval-bitor ] [ integer-valued ] binary-op ] each-derived-op
\ bitxor [ [ interval-bitxor ] [ integer-valued ] binary-op ] each-derived-op
:: (comparison-constraints) ( in1 in2 op -- constraint )
[let | i1 [ in1 value-info interval>> ]
i2 [ in2 value-info interval>> ] |
- i1 i2 and [
- in1 i1 i2 op assume-interval <interval-constraint>
- in2 i2 i1 op swap-comparison assume-interval <interval-constraint>
- <conjunction>
- ] [
- f
- ] if
+ in1 i1 i2 op assume-interval <interval-constraint>
+ in2 i2 i1 op swap-comparison assume-interval <interval-constraint>
+ <conjunction>
] ;
: comparison-constraints ( in1 in2 out op -- constraint )
] dip <conditional> ;
: comparison-op ( word op -- )
- '[
- [ in-d>> first2 ] [ out-d>> first ] bi
- , comparison-constraints
- ] +constraints+ set-word-prop ;
+ '[ , comparison-constraints ] +constraints+ set-word-prop ;
{ < > <= >= } [ dup [ comparison-op ] curry each-derived-op ] each
,
[ nip ] [
[ interval>> ] [ class-interval ] bi*
- interval-intersect'
+ interval-intersect
] 2bi
<class/interval-info>
] +outputs+ set-word-prop
] assoc-each
-!
-! {
-! alien-signed-1
-! alien-unsigned-1
-! alien-signed-2
-! alien-unsigned-2
-! alien-signed-4
-! alien-unsigned-4
-! alien-signed-8
-! alien-unsigned-8
-! } [
-! dup name>> {
-! {
-! [ "alien-signed-" ?head ]
-! [ string>number 8 * 1- 2^ dup neg swap 1- [a,b] ]
-! }
-! {
-! [ "alien-unsigned-" ?head ]
-! [ string>number 8 * 2^ 1- 0 swap [a,b] ]
-! }
-! } cond 1array
-! [ nip f swap ] curry "output-classes" set-word-prop
-! ] each
-!
-!
-! { <tuple> <tuple-boa> (tuple) } [
-! [
-! dup node-in-d peek node-literal
-! dup tuple-layout? [ class>> ] [ drop tuple ] if
-! 1array f
-! ] "output-classes" set-word-prop
-! ] each
-!
-! \ new [
-! dup node-in-d peek node-literal
-! dup class? [ drop tuple ] unless 1array f
-! ] "output-classes" set-word-prop
-!
-! ! the output of clone has the same type as the input
-! { clone (clone) } [
-! [
-! node-in-d [ value-class* ] map f
-! ] "output-classes" set-word-prop
-! ] each
-!
-! ! if the result of eq? is t and the second input is a literal,
-! ! the first input is equal to the second
-! \ eq? [
-! dup node-in-d second dup value? [
-! swap [
-! value-literal 0 `input literal,
-! \ f class-not 0 `output class,
-! ] set-constraints
-! ] [
-! 2drop
-! ] if
-! ] "constraints" set-word-prop
-
-: and-constraints ( in1 in2 out -- constraint )
- [ [ <true-constraint> ] bi@ ] dip <conditional> ;
-
-! XXX...
+{
+ alien-signed-1
+ alien-unsigned-1
+ alien-signed-2
+ alien-unsigned-2
+ alien-signed-4
+ alien-unsigned-4
+ alien-signed-8
+ alien-unsigned-8
+} [
+ dup name>> {
+ {
+ [ "alien-signed-" ?head ]
+ [ string>number 8 * 1- 2^ dup neg swap 1- [a,b] ]
+ }
+ {
+ [ "alien-unsigned-" ?head ]
+ [ string>number 8 * 2^ 1- 0 swap [a,b] ]
+ }
+ } cond
+ [ fixnum fits? fixnum bignum ? ] keep <class/interval-info>
+ [ 2nip ] curry +outputs+ set-word-prop
+] each
+
+{ <tuple> <tuple-boa> } [
+ [
+ literal>> dup tuple-layout? [ class>> ] [ drop tuple ] if
+ [ clear ] dip
+ ] +outputs+ set-word-prop
+] each
+
+\ new [
+ literal>> dup tuple-class? [ drop tuple ] unless <class-info>
+] +outputs+ set-word-prop
+
+! the output of clone has the same type as the input
+{ clone (clone) } [ [ ] +outputs+ set-word-prop ] each
! See http://factorcode.org/license.txt for BSD license.
USING: fry accessors alien alien.accessors arrays byte-arrays
classes sequences.private continuations.private effects generic
-hashtables hashtables.private io io.backend io.files io.files.private
-io.streams.c kernel kernel.private math math.private memory
-namespaces namespaces.private parser prettyprint quotations
-quotations.private sbufs sbufs.private sequences
-sequences.private slots.private strings strings.private system
-threads.private classes.tuple classes.tuple.private vectors
-vectors.private words words.private assocs summary
-compiler.units system.private
-stack-checker.state stack-checker.backend stack-checker.branches
-stack-checker.errors stack-checker.visitor ;
+hashtables hashtables.private io io.backend io.files
+io.files.private io.streams.c kernel kernel.private math
+math.private memory namespaces namespaces.private parser
+prettyprint quotations quotations.private sbufs sbufs.private
+sequences sequences.private slots.private strings
+strings.private system threads.private classes.tuple
+classes.tuple.private vectors vectors.private words definitions
+words.private assocs summary compiler.units system.private
+combinators locals.backend stack-checker.state
+stack-checker.backend stack-checker.branches
+stack-checker.errors stack-checker.transforms
+stack-checker.visitor ;
IN: stack-checker.known-words
-: infer-shuffle ( shuffle -- )
- [ in>> length consume-d ] keep ! inputs shuffle
- [ drop ] [ shuffle* dup copy-values dup output-d ] 2bi ! inputs outputs copies
- [ nip ] [ swap zip ] 2bi ! inputs copies mapping
- #shuffle, ;
-
-: define-shuffle ( word shuffle -- )
- '[ , infer-shuffle ] +infer+ set-word-prop ;
+: infer-primitive ( word -- )
+ dup
+ [ "input-classes" word-prop ]
+ [ "default-output-classes" word-prop ] bi <effect>
+ apply-word/effect ;
{
{ drop (( x -- )) }
{ over (( x y -- x y x )) }
{ pick (( x y z -- x y z x )) }
{ swap (( x y -- y x )) }
-} [ define-shuffle ] assoc-each
+} [ +shuffle+ set-word-prop ] assoc-each
-\ >r [ 1 infer->r ] +infer+ set-word-prop
-\ r> [ 1 infer-r> ] +infer+ set-word-prop
+: infer-shuffle ( shuffle -- )
+ [ in>> length consume-d ] keep ! inputs shuffle
+ [ drop ] [ shuffle* dup copy-values dup output-d ] 2bi ! inputs outputs copies
+ [ nip ] [ swap zip ] 2bi ! inputs copies mapping
+ #shuffle, ;
+: infer-shuffle-word ( word -- )
+ +shuffle+ word-prop infer-shuffle ;
-\ declare [
+: infer-declare ( -- )
pop-literal nip
[ length consume-d dup copy-values dup output-d ] keep
- #declare,
-] +infer+ set-word-prop
+ #declare, ;
-! Primitive combinators
GENERIC: infer-call* ( value known -- )
: infer-call ( value -- ) dup known infer-call* ;
[ quot2>> known pop-d [ set-known ] keep ]
[ quot1>> known pop-d [ set-known ] keep ] bi
push-d push-d
- [ slip call ] recursive-state get infer-quot ;
+ 1 infer->r pop-d infer-call
+ terminated? get [ 1 infer-r> pop-d infer-call ] unless ;
M: object infer-call*
\ literal-expected inference-warning ;
-\ call [ pop-d infer-call ] +infer+ set-word-prop
-
-\ call t "no-compile" set-word-prop
-
-\ curry [
+: infer-curry ( -- )
2 consume-d
dup first2 <curried> make-known
[ push-d ] [ 1array ] bi
- \ curry #call,
-] +infer+ set-word-prop
+ \ curry #call, ;
-\ compose [
+: infer-compose ( -- )
2 consume-d
dup first2 <composed> make-known
[ push-d ] [ 1array ] bi
- \ compose #call,
-] +infer+ set-word-prop
+ \ compose #call, ;
-\ execute [
+: infer-execute ( -- )
pop-literal nip
dup word? [
apply-object
] [
drop
"execute must be given a word" time-bomb
- ] if
-] +infer+ set-word-prop
-
-\ execute t "no-compile" set-word-prop
+ ] if ;
-\ if [
- 2 consume-d
- dup [ known [ curry? ] [ composed? ] bi or ] contains? [
- output-d
- [ rot [ drop call ] [ nip call ] if ]
- recursive-state get infer-quot
- ] [
- [ #drop, ] [ [ literal ] map infer-if ] bi
- ] if
-] +infer+ set-word-prop
-
-\ dispatch [
- pop-literal nip [ <literal> ] map infer-dispatch
-] +infer+ set-word-prop
-
-\ dispatch t "no-compile" set-word-prop
-
-! Variadic tuple constructor
-\ <tuple-boa> [
+: infer-<tuple-boa> ( -- )
\ <tuple-boa>
peek-d literal value>> size>> { tuple } <effect>
- apply-word/effect
-] +infer+ set-word-prop
+ apply-word/effect ;
-! Non-standard control flow
-\ (throw) [
+: infer-(throw) ( -- )
\ (throw)
peek-d literal value>> 2 + f <effect> t >>terminated?
- apply-word/effect
-] +infer+ set-word-prop
+ apply-word/effect ;
+
+: infer-exit ( -- )
+ \ exit
+ { integer } { } t >>terminated? <effect>
+ apply-word/effect ;
-: set-primitive-effect ( word effect -- )
- [ in>> "input-classes" set-word-prop ]
- [ out>> "default-output-classes" set-word-prop ]
- [ dupd '[ , , apply-word/effect ] +infer+ set-word-prop ]
- 2tri ;
+: infer-load-locals ( -- )
+ pop-literal nip
+ [ dup reverse <effect> infer-shuffle ]
+ [ infer->r ]
+ bi ;
+
+: infer-get-local ( -- )
+ pop-literal nip
+ [ infer-r> ]
+ [ dup 0 prefix <effect> infer-shuffle ]
+ [ infer->r ]
+ tri ;
+
+: infer-drop-locals ( -- )
+ pop-literal nip
+ [ infer-r> ]
+ [ { } <effect> infer-shuffle ] bi ;
+
+: infer-special ( word -- )
+ {
+ { \ >r [ 1 infer->r ] }
+ { \ r> [ 1 infer-r> ] }
+ { \ declare [ infer-declare ] }
+ { \ call [ pop-d infer-call ] }
+ { \ curry [ infer-curry ] }
+ { \ compose [ infer-compose ] }
+ { \ execute [ infer-execute ] }
+ { \ if [ infer-if ] }
+ { \ dispatch [ infer-dispatch ] }
+ { \ <tuple-boa> [ infer-<tuple-boa> ] }
+ { \ (throw) [ infer-(throw) ] }
+ { \ exit [ infer-exit ] }
+ { \ load-locals [ infer-load-locals ] }
+ { \ get-local [ infer-get-local ] }
+ { \ drop-locals [ infer-drop-locals ] }
+ { \ do-primitive [ \ do-primitive cannot-infer-effect ] }
+ } case ;
+
+{
+ >r r> declare call curry compose
+ execute if dispatch <tuple-boa>
+ (throw) load-locals get-local drop-locals
+ do-primitive
+} [ t +special+ set-word-prop ] each
+
+{ call execute dispatch load-locals get-local drop-locals }
+[ t "no-compile" set-word-prop ] each
+
+: non-inline-word ( word -- )
+ dup +called+ depends-on
+ {
+ { [ dup +shuffle+ word-prop ] [ infer-shuffle-word ] }
+ { [ dup +special+ word-prop ] [ infer-special ] }
+ { [ dup primitive? ] [ infer-primitive ] }
+ { [ dup +cannot-infer+ word-prop ] [ cannot-infer-effect ] }
+ { [ dup +inferred-effect+ word-prop ] [ cached-infer ] }
+ { [ dup +transform-quot+ word-prop ] [ apply-transform ] }
+ { [ dup "macro" word-prop ] [ apply-macro ] }
+ { [ dup recursive-label ] [ call-recursive-word ] }
+ [ dup infer-word apply-word/effect ]
+ } cond ;
+
+: define-primitive ( word inputs outputs -- )
+ [ drop "input-classes" set-word-prop ]
+ [ nip "default-output-classes" set-word-prop ]
+ 3bi ;
! Stack effects for all primitives
-\ fixnum< { fixnum fixnum } { object } <effect> set-primitive-effect
+\ fixnum< { fixnum fixnum } { object } define-primitive
\ fixnum< make-foldable
-\ fixnum<= { fixnum fixnum } { object } <effect> set-primitive-effect
+\ fixnum<= { fixnum fixnum } { object } define-primitive
\ fixnum<= make-foldable
-\ fixnum> { fixnum fixnum } { object } <effect> set-primitive-effect
+\ fixnum> { fixnum fixnum } { object } define-primitive
\ fixnum> make-foldable
-\ fixnum>= { fixnum fixnum } { object } <effect> set-primitive-effect
+\ fixnum>= { fixnum fixnum } { object } define-primitive
\ fixnum>= make-foldable
-\ eq? { object object } { object } <effect> set-primitive-effect
+\ eq? { object object } { object } define-primitive
\ eq? make-foldable
-\ rehash-string { string } { } <effect> set-primitive-effect
-
-\ bignum>fixnum { bignum } { fixnum } <effect> set-primitive-effect
+\ bignum>fixnum { bignum } { fixnum } define-primitive
\ bignum>fixnum make-foldable
-\ float>fixnum { float } { fixnum } <effect> set-primitive-effect
+\ float>fixnum { float } { fixnum } define-primitive
\ bignum>fixnum make-foldable
-\ fixnum>bignum { fixnum } { bignum } <effect> set-primitive-effect
+\ fixnum>bignum { fixnum } { bignum } define-primitive
\ fixnum>bignum make-foldable
-\ float>bignum { float } { bignum } <effect> set-primitive-effect
+\ float>bignum { float } { bignum } define-primitive
\ float>bignum make-foldable
-\ fixnum>float { fixnum } { float } <effect> set-primitive-effect
+\ fixnum>float { fixnum } { float } define-primitive
\ fixnum>float make-foldable
-\ bignum>float { bignum } { float } <effect> set-primitive-effect
+\ bignum>float { bignum } { float } define-primitive
\ bignum>float make-foldable
-\ <ratio> { integer integer } { ratio } <effect> set-primitive-effect
+\ <ratio> { integer integer } { ratio } define-primitive
\ <ratio> make-foldable
-\ string>float { string } { float } <effect> set-primitive-effect
+\ string>float { string } { float } define-primitive
\ string>float make-foldable
-\ float>string { float } { string } <effect> set-primitive-effect
+\ float>string { float } { string } define-primitive
\ float>string make-foldable
-\ float>bits { real } { integer } <effect> set-primitive-effect
+\ float>bits { real } { integer } define-primitive
\ float>bits make-foldable
-\ double>bits { real } { integer } <effect> set-primitive-effect
+\ double>bits { real } { integer } define-primitive
\ double>bits make-foldable
-\ bits>float { integer } { float } <effect> set-primitive-effect
+\ bits>float { integer } { float } define-primitive
\ bits>float make-foldable
-\ bits>double { integer } { float } <effect> set-primitive-effect
+\ bits>double { integer } { float } define-primitive
\ bits>double make-foldable
-\ <complex> { real real } { complex } <effect> set-primitive-effect
+\ <complex> { real real } { complex } define-primitive
\ <complex> make-foldable
-\ fixnum+ { fixnum fixnum } { integer } <effect> set-primitive-effect
+\ fixnum+ { fixnum fixnum } { integer } define-primitive
\ fixnum+ make-foldable
-\ fixnum+fast { fixnum fixnum } { fixnum } <effect> set-primitive-effect
+\ fixnum+fast { fixnum fixnum } { fixnum } define-primitive
\ fixnum+fast make-foldable
-\ fixnum- { fixnum fixnum } { integer } <effect> set-primitive-effect
+\ fixnum- { fixnum fixnum } { integer } define-primitive
\ fixnum- make-foldable
-\ fixnum-fast { fixnum fixnum } { fixnum } <effect> set-primitive-effect
+\ fixnum-fast { fixnum fixnum } { fixnum } define-primitive
\ fixnum-fast make-foldable
-\ fixnum* { fixnum fixnum } { integer } <effect> set-primitive-effect
+\ fixnum* { fixnum fixnum } { integer } define-primitive
\ fixnum* make-foldable
-\ fixnum*fast { fixnum fixnum } { fixnum } <effect> set-primitive-effect
+\ fixnum*fast { fixnum fixnum } { fixnum } define-primitive
\ fixnum*fast make-foldable
-\ fixnum/i { fixnum fixnum } { integer } <effect> set-primitive-effect
+\ fixnum/i { fixnum fixnum } { integer } define-primitive
\ fixnum/i make-foldable
-\ fixnum-mod { fixnum fixnum } { fixnum } <effect> set-primitive-effect
+\ fixnum-mod { fixnum fixnum } { fixnum } define-primitive
\ fixnum-mod make-foldable
-\ fixnum/mod { fixnum fixnum } { integer fixnum } <effect> set-primitive-effect
+\ fixnum/mod { fixnum fixnum } { integer fixnum } define-primitive
\ fixnum/mod make-foldable
-\ fixnum-bitand { fixnum fixnum } { fixnum } <effect> set-primitive-effect
+\ fixnum-bitand { fixnum fixnum } { fixnum } define-primitive
\ fixnum-bitand make-foldable
-\ fixnum-bitor { fixnum fixnum } { fixnum } <effect> set-primitive-effect
+\ fixnum-bitor { fixnum fixnum } { fixnum } define-primitive
\ fixnum-bitor make-foldable
-\ fixnum-bitxor { fixnum fixnum } { fixnum } <effect> set-primitive-effect
+\ fixnum-bitxor { fixnum fixnum } { fixnum } define-primitive
\ fixnum-bitxor make-foldable
-\ fixnum-bitnot { fixnum } { fixnum } <effect> set-primitive-effect
+\ fixnum-bitnot { fixnum } { fixnum } define-primitive
\ fixnum-bitnot make-foldable
-\ fixnum-shift { fixnum fixnum } { integer } <effect> set-primitive-effect
+\ fixnum-shift { fixnum fixnum } { integer } define-primitive
\ fixnum-shift make-foldable
-\ fixnum-shift-fast { fixnum fixnum } { fixnum } <effect> set-primitive-effect
+\ fixnum-shift-fast { fixnum fixnum } { fixnum } define-primitive
\ fixnum-shift-fast make-foldable
-\ bignum= { bignum bignum } { object } <effect> set-primitive-effect
+\ bignum= { bignum bignum } { object } define-primitive
\ bignum= make-foldable
-\ bignum+ { bignum bignum } { bignum } <effect> set-primitive-effect
+\ bignum+ { bignum bignum } { bignum } define-primitive
\ bignum+ make-foldable
-\ bignum- { bignum bignum } { bignum } <effect> set-primitive-effect
+\ bignum- { bignum bignum } { bignum } define-primitive
\ bignum- make-foldable
-\ bignum* { bignum bignum } { bignum } <effect> set-primitive-effect
+\ bignum* { bignum bignum } { bignum } define-primitive
\ bignum* make-foldable
-\ bignum/i { bignum bignum } { bignum } <effect> set-primitive-effect
+\ bignum/i { bignum bignum } { bignum } define-primitive
\ bignum/i make-foldable
-\ bignum-mod { bignum bignum } { bignum } <effect> set-primitive-effect
+\ bignum-mod { bignum bignum } { bignum } define-primitive
\ bignum-mod make-foldable
-\ bignum/mod { bignum bignum } { bignum bignum } <effect> set-primitive-effect
+\ bignum/mod { bignum bignum } { bignum bignum } define-primitive
\ bignum/mod make-foldable
-\ bignum-bitand { bignum bignum } { bignum } <effect> set-primitive-effect
+\ bignum-bitand { bignum bignum } { bignum } define-primitive
\ bignum-bitand make-foldable
-\ bignum-bitor { bignum bignum } { bignum } <effect> set-primitive-effect
+\ bignum-bitor { bignum bignum } { bignum } define-primitive
\ bignum-bitor make-foldable
-\ bignum-bitxor { bignum bignum } { bignum } <effect> set-primitive-effect
+\ bignum-bitxor { bignum bignum } { bignum } define-primitive
\ bignum-bitxor make-foldable
-\ bignum-bitnot { bignum } { bignum } <effect> set-primitive-effect
+\ bignum-bitnot { bignum } { bignum } define-primitive
\ bignum-bitnot make-foldable
-\ bignum-shift { bignum bignum } { bignum } <effect> set-primitive-effect
+\ bignum-shift { bignum bignum } { bignum } define-primitive
\ bignum-shift make-foldable
-\ bignum< { bignum bignum } { object } <effect> set-primitive-effect
+\ bignum< { bignum bignum } { object } define-primitive
\ bignum< make-foldable
-\ bignum<= { bignum bignum } { object } <effect> set-primitive-effect
+\ bignum<= { bignum bignum } { object } define-primitive
\ bignum<= make-foldable
-\ bignum> { bignum bignum } { object } <effect> set-primitive-effect
+\ bignum> { bignum bignum } { object } define-primitive
\ bignum> make-foldable
-\ bignum>= { bignum bignum } { object } <effect> set-primitive-effect
+\ bignum>= { bignum bignum } { object } define-primitive
\ bignum>= make-foldable
-\ bignum-bit? { bignum integer } { object } <effect> set-primitive-effect
+\ bignum-bit? { bignum integer } { object } define-primitive
\ bignum-bit? make-foldable
-\ bignum-log2 { bignum } { bignum } <effect> set-primitive-effect
+\ bignum-log2 { bignum } { bignum } define-primitive
\ bignum-log2 make-foldable
-\ byte-array>bignum { byte-array } { bignum } <effect> set-primitive-effect
+\ byte-array>bignum { byte-array } { bignum } define-primitive
\ byte-array>bignum make-foldable
-\ float= { float float } { object } <effect> set-primitive-effect
+\ float= { float float } { object } define-primitive
\ float= make-foldable
-\ float+ { float float } { float } <effect> set-primitive-effect
+\ float+ { float float } { float } define-primitive
\ float+ make-foldable
-\ float- { float float } { float } <effect> set-primitive-effect
+\ float- { float float } { float } define-primitive
\ float- make-foldable
-\ float* { float float } { float } <effect> set-primitive-effect
+\ float* { float float } { float } define-primitive
\ float* make-foldable
-\ float/f { float float } { float } <effect> set-primitive-effect
+\ float/f { float float } { float } define-primitive
\ float/f make-foldable
-\ float< { float float } { object } <effect> set-primitive-effect
+\ float< { float float } { object } define-primitive
\ float< make-foldable
-\ float-mod { float float } { float } <effect> set-primitive-effect
+\ float-mod { float float } { float } define-primitive
\ float-mod make-foldable
-\ float<= { float float } { object } <effect> set-primitive-effect
+\ float<= { float float } { object } define-primitive
\ float<= make-foldable
-\ float> { float float } { object } <effect> set-primitive-effect
+\ float> { float float } { object } define-primitive
\ float> make-foldable
-\ float>= { float float } { object } <effect> set-primitive-effect
+\ float>= { float float } { object } define-primitive
\ float>= make-foldable
-\ <word> { object object } { word } <effect> set-primitive-effect
+\ <word> { object object } { word } define-primitive
\ <word> make-flushable
-\ word-xt { word } { integer integer } <effect> set-primitive-effect
+\ word-xt { word } { integer integer } define-primitive
\ word-xt make-flushable
-\ getenv { fixnum } { object } <effect> set-primitive-effect
+\ getenv { fixnum } { object } define-primitive
\ getenv make-flushable
-\ setenv { object fixnum } { } <effect> set-primitive-effect
+\ setenv { object fixnum } { } define-primitive
-\ (exists?) { string } { object } <effect> set-primitive-effect
+\ (exists?) { string } { object } define-primitive
-\ (directory) { string } { array } <effect> set-primitive-effect
+\ (directory) { string } { array } define-primitive
-\ gc { } { } <effect> set-primitive-effect
+\ gc { } { } define-primitive
-\ gc-stats { } { array } <effect> set-primitive-effect
+\ gc-stats { } { array } define-primitive
-\ save-image { string } { } <effect> set-primitive-effect
+\ save-image { string } { } define-primitive
-\ save-image-and-exit { string } { } <effect> set-primitive-effect
+\ save-image-and-exit { string } { } define-primitive
-\ exit { integer } { } <effect> t >>terminated? set-primitive-effect
-
-\ data-room { } { integer integer array } <effect> set-primitive-effect
+\ data-room { } { integer integer array } define-primitive
\ data-room make-flushable
-\ code-room { } { integer integer integer integer } <effect> set-primitive-effect
+\ code-room { } { integer integer integer integer } define-primitive
\ code-room make-flushable
-\ os-env { string } { object } <effect> set-primitive-effect
+\ os-env { string } { object } define-primitive
-\ millis { } { integer } <effect> set-primitive-effect
+\ millis { } { integer } define-primitive
\ millis make-flushable
-\ tag { object } { fixnum } <effect> set-primitive-effect
+\ tag { object } { fixnum } define-primitive
\ tag make-foldable
-\ cwd { } { string } <effect> set-primitive-effect
-
-\ cd { string } { } <effect> set-primitive-effect
-
-\ dlopen { string } { dll } <effect> set-primitive-effect
+\ dlopen { string } { dll } define-primitive
-\ dlsym { string object } { c-ptr } <effect> set-primitive-effect
+\ dlsym { string object } { c-ptr } define-primitive
-\ dlclose { dll } { } <effect> set-primitive-effect
+\ dlclose { dll } { } define-primitive
-\ <byte-array> { integer } { byte-array } <effect> set-primitive-effect
+\ <byte-array> { integer } { byte-array } define-primitive
\ <byte-array> make-flushable
-\ <displaced-alien> { integer c-ptr } { c-ptr } <effect> set-primitive-effect
+\ <displaced-alien> { integer c-ptr } { c-ptr } define-primitive
\ <displaced-alien> make-flushable
-\ alien-signed-cell { c-ptr integer } { integer } <effect> set-primitive-effect
+\ alien-signed-cell { c-ptr integer } { integer } define-primitive
\ alien-signed-cell make-flushable
-\ set-alien-signed-cell { integer c-ptr integer } { } <effect> set-primitive-effect
+\ set-alien-signed-cell { integer c-ptr integer } { } define-primitive
-\ alien-unsigned-cell { c-ptr integer } { integer } <effect> set-primitive-effect
+\ alien-unsigned-cell { c-ptr integer } { integer } define-primitive
\ alien-unsigned-cell make-flushable
-\ set-alien-unsigned-cell { integer c-ptr integer } { } <effect> set-primitive-effect
+\ set-alien-unsigned-cell { integer c-ptr integer } { } define-primitive
-\ alien-signed-8 { c-ptr integer } { integer } <effect> set-primitive-effect
+\ alien-signed-8 { c-ptr integer } { integer } define-primitive
\ alien-signed-8 make-flushable
-\ set-alien-signed-8 { integer c-ptr integer } { } <effect> set-primitive-effect
+\ set-alien-signed-8 { integer c-ptr integer } { } define-primitive
-\ alien-unsigned-8 { c-ptr integer } { integer } <effect> set-primitive-effect
+\ alien-unsigned-8 { c-ptr integer } { integer } define-primitive
\ alien-unsigned-8 make-flushable
-\ set-alien-unsigned-8 { integer c-ptr integer } { } <effect> set-primitive-effect
+\ set-alien-unsigned-8 { integer c-ptr integer } { } define-primitive
-\ alien-signed-4 { c-ptr integer } { integer } <effect> set-primitive-effect
+\ alien-signed-4 { c-ptr integer } { integer } define-primitive
\ alien-signed-4 make-flushable
-\ set-alien-signed-4 { integer c-ptr integer } { } <effect> set-primitive-effect
+\ set-alien-signed-4 { integer c-ptr integer } { } define-primitive
-\ alien-unsigned-4 { c-ptr integer } { integer } <effect> set-primitive-effect
+\ alien-unsigned-4 { c-ptr integer } { integer } define-primitive
\ alien-unsigned-4 make-flushable
-\ set-alien-unsigned-4 { integer c-ptr integer } { } <effect> set-primitive-effect
+\ set-alien-unsigned-4 { integer c-ptr integer } { } define-primitive
-\ alien-signed-2 { c-ptr integer } { fixnum } <effect> set-primitive-effect
+\ alien-signed-2 { c-ptr integer } { fixnum } define-primitive
\ alien-signed-2 make-flushable
-\ set-alien-signed-2 { integer c-ptr integer } { } <effect> set-primitive-effect
+\ set-alien-signed-2 { integer c-ptr integer } { } define-primitive
-\ alien-unsigned-2 { c-ptr integer } { fixnum } <effect> set-primitive-effect
+\ alien-unsigned-2 { c-ptr integer } { fixnum } define-primitive
\ alien-unsigned-2 make-flushable
-\ set-alien-unsigned-2 { integer c-ptr integer } { } <effect> set-primitive-effect
+\ set-alien-unsigned-2 { integer c-ptr integer } { } define-primitive
-\ alien-signed-1 { c-ptr integer } { fixnum } <effect> set-primitive-effect
+\ alien-signed-1 { c-ptr integer } { fixnum } define-primitive
\ alien-signed-1 make-flushable
-\ set-alien-signed-1 { integer c-ptr integer } { } <effect> set-primitive-effect
+\ set-alien-signed-1 { integer c-ptr integer } { } define-primitive
-\ alien-unsigned-1 { c-ptr integer } { fixnum } <effect> set-primitive-effect
+\ alien-unsigned-1 { c-ptr integer } { fixnum } define-primitive
\ alien-unsigned-1 make-flushable
-\ set-alien-unsigned-1 { integer c-ptr integer } { } <effect> set-primitive-effect
+\ set-alien-unsigned-1 { integer c-ptr integer } { } define-primitive
-\ alien-float { c-ptr integer } { float } <effect> set-primitive-effect
+\ alien-float { c-ptr integer } { float } define-primitive
\ alien-float make-flushable
-\ set-alien-float { float c-ptr integer } { } <effect> set-primitive-effect
+\ set-alien-float { float c-ptr integer } { } define-primitive
-\ alien-double { c-ptr integer } { float } <effect> set-primitive-effect
+\ alien-double { c-ptr integer } { float } define-primitive
\ alien-double make-flushable
-\ set-alien-double { float c-ptr integer } { } <effect> set-primitive-effect
+\ set-alien-double { float c-ptr integer } { } define-primitive
-\ alien-cell { c-ptr integer } { simple-c-ptr } <effect> set-primitive-effect
+\ alien-cell { c-ptr integer } { simple-c-ptr } define-primitive
\ alien-cell make-flushable
-\ set-alien-cell { c-ptr c-ptr integer } { } <effect> set-primitive-effect
+\ set-alien-cell { c-ptr c-ptr integer } { } define-primitive
-\ alien-address { alien } { integer } <effect> set-primitive-effect
+\ alien-address { alien } { integer } define-primitive
\ alien-address make-flushable
-\ slot { object fixnum } { object } <effect> set-primitive-effect
+\ slot { object fixnum } { object } define-primitive
\ slot make-flushable
-\ set-slot { object object fixnum } { } <effect> set-primitive-effect
+\ set-slot { object object fixnum } { } define-primitive
-\ string-nth { fixnum string } { fixnum } <effect> set-primitive-effect
+\ string-nth { fixnum string } { fixnum } define-primitive
\ string-nth make-flushable
-\ set-string-nth { fixnum fixnum string } { } <effect> set-primitive-effect
+\ set-string-nth { fixnum fixnum string } { } define-primitive
-\ resize-array { integer array } { array } <effect> set-primitive-effect
+\ resize-array { integer array } { array } define-primitive
\ resize-array make-flushable
-\ resize-byte-array { integer byte-array } { byte-array } <effect> set-primitive-effect
+\ resize-byte-array { integer byte-array } { byte-array } define-primitive
\ resize-byte-array make-flushable
-\ resize-string { integer string } { string } <effect> set-primitive-effect
+\ resize-string { integer string } { string } define-primitive
\ resize-string make-flushable
-\ <array> { integer object } { array } <effect> set-primitive-effect
+\ <array> { integer object } { array } define-primitive
\ <array> make-flushable
-\ begin-scan { } { } <effect> set-primitive-effect
+\ begin-scan { } { } define-primitive
-\ next-object { } { object } <effect> set-primitive-effect
+\ next-object { } { object } define-primitive
-\ end-scan { } { } <effect> set-primitive-effect
+\ end-scan { } { } define-primitive
-\ size { object } { fixnum } <effect> set-primitive-effect
+\ size { object } { fixnum } define-primitive
\ size make-flushable
-\ die { } { } <effect> set-primitive-effect
+\ die { } { } define-primitive
-\ fopen { string string } { alien } <effect> set-primitive-effect
+\ fopen { string string } { alien } define-primitive
-\ fgetc { alien } { object } <effect> set-primitive-effect
+\ fgetc { alien } { object } define-primitive
-\ fwrite { string alien } { } <effect> set-primitive-effect
+\ fwrite { string alien } { } define-primitive
-\ fputc { object alien } { } <effect> set-primitive-effect
+\ fputc { object alien } { } define-primitive
-\ fread { integer string } { object } <effect> set-primitive-effect
+\ fread { integer string } { object } define-primitive
-\ fflush { alien } { } <effect> set-primitive-effect
+\ fflush { alien } { } define-primitive
-\ fclose { alien } { } <effect> set-primitive-effect
+\ fclose { alien } { } define-primitive
-\ <wrapper> { object } { wrapper } <effect> set-primitive-effect
+\ <wrapper> { object } { wrapper } define-primitive
\ <wrapper> make-foldable
-\ (clone) { object } { object } <effect> set-primitive-effect
+\ (clone) { object } { object } define-primitive
\ (clone) make-flushable
-\ <string> { integer integer } { string } <effect> set-primitive-effect
+\ <string> { integer integer } { string } define-primitive
\ <string> make-flushable
-\ array>quotation { array } { quotation } <effect> set-primitive-effect
+\ array>quotation { array } { quotation } define-primitive
\ array>quotation make-flushable
-\ quotation-xt { quotation } { integer } <effect> set-primitive-effect
+\ quotation-xt { quotation } { integer } define-primitive
\ quotation-xt make-flushable
-\ <tuple> { tuple-layout } { tuple } <effect> set-primitive-effect
+\ <tuple> { tuple-layout } { tuple } define-primitive
\ <tuple> make-flushable
-\ <tuple-layout> { word fixnum array fixnum } { tuple-layout } <effect> set-primitive-effect
+\ <tuple-layout> { word fixnum array fixnum } { tuple-layout } define-primitive
\ <tuple-layout> make-foldable
-\ datastack { } { array } <effect> set-primitive-effect
+\ datastack { } { array } define-primitive
\ datastack make-flushable
-\ retainstack { } { array } <effect> set-primitive-effect
+\ retainstack { } { array } define-primitive
\ retainstack make-flushable
-\ callstack { } { callstack } <effect> set-primitive-effect
+\ callstack { } { callstack } define-primitive
\ callstack make-flushable
-\ callstack>array { callstack } { array } <effect> set-primitive-effect
+\ callstack>array { callstack } { array } define-primitive
\ callstack>array make-flushable
-\ (sleep) { integer } { } <effect> set-primitive-effect
+\ (sleep) { integer } { } define-primitive
-\ become { array array } { } <effect> set-primitive-effect
+\ become { array array } { } define-primitive
-\ innermost-frame-quot { callstack } { quotation } <effect> set-primitive-effect
+\ innermost-frame-quot { callstack } { quotation } define-primitive
-\ innermost-frame-scan { callstack } { fixnum } <effect> set-primitive-effect
+\ innermost-frame-scan { callstack } { fixnum } define-primitive
-\ set-innermost-frame-quot { quotation callstack } { } <effect> set-primitive-effect
+\ set-innermost-frame-quot { quotation callstack } { } define-primitive
-\ (os-envs) { } { array } <effect> set-primitive-effect
+\ (os-envs) { } { array } define-primitive
-\ set-os-env { string string } { } <effect> set-primitive-effect
+\ set-os-env { string string } { } define-primitive
-\ unset-os-env { string } { } <effect> set-primitive-effect
+\ unset-os-env { string } { } define-primitive
-\ (set-os-envs) { array } { } <effect> set-primitive-effect
+\ (set-os-envs) { array } { } define-primitive
\ do-primitive [ \ do-primitive cannot-infer-effect ] +infer+ set-word-prop
-\ dll-valid? { object } { object } <effect> set-primitive-effect
+\ dll-valid? { object } { object } define-primitive
-\ modify-code-heap { array object } { } <effect> set-primitive-effect
+\ modify-code-heap { array object } { } define-primitive
-\ unimplemented { } { } <effect> set-primitive-effect
+\ unimplemented { } { } define-primitive