USING: arrays generic inference kernel math
namespaces sequences vectors words ;
+! TUPLE: phantom-stack height elements ;
+!
+! GENERIC: <loc> ( n stack -- loc )
+!
+! TUPLE: phantom-datastack ;
+!
+! C: phantom-datastack [ >r <phantom-stack> r> ] set-delegate ;
+!
+! M: phantom-datastack <loc> drop <ds-loc> ;
+!
+! TUPLE: phantom-callstack ;
+!
+! C: phantom-callstack [ >r <phantom-stack> r> ] set-delegate ;
+!
+! M: phantom-callstack <loc> drop <cs-loc> ;
+
SYMBOL: d-height
SYMBOL: r-height
: load-literal ( obj vreg -- )
over immediate? [ %immediate ] [ %indirect ] if , ;
-: literal>stack ( value loc -- )
- swap value-literal fixnum-imm? over immediate? and
- [ T{ vreg f 0 } load-literal T{ vreg f 0 } ] unless
- swap %replace , ; inline
-
G: vreg>stack ( value loc -- ) 1 standard-combination ;
M: f vreg>stack ( value loc -- ) 2drop ;
>r <vreg> dup r> %peek , nip ;
M: value stack>vreg ( value vreg loc -- operand )
- drop >r value-literal r> dup value eq?
- [ drop ] [ <vreg> [ load-literal ] keep ] if ;
+ drop dup value eq? [
+ drop
+ ] [
+ >r value-literal r> <vreg> [ load-literal ] keep
+ ] if ;
SYMBOL: vreg-allocator
[ first3 over [ stack>vreg ] [ 3drop f ] if ] map ;
: phantom-vregs ( phantom template -- )
- [ second ] map [ set ] 2each ;
+ >r [ dup value? [ value-literal ] when ] map r>
+ [ second ] map
+ [ set ] 2each ;
: stack>vregs ( stack template quot -- )
>r dup [ first ] map swapd alloc-regs
(stack>vregs) swap phantom-vregs ; inline
: compatible-vreg?
- swap dup value? [ 2drop t ] [ vreg-n = ] if ;
+ swap dup value? [ 2drop f ] [ vreg-n = ] if ;
: compatible-values? ( value template -- ? )
{
- { [ dup any-reg eq? ] [ 2drop t ] }
+ { [ dup any-reg eq? ] [ drop vreg? ] }
{ [ dup integer? ] [ compatible-vreg? ] }
{ [ dup value eq? ] [ drop value? ] }
+ { [ dup not ] [ 2drop t ] }
} cond ;
: template-match? ( phantom template -- ? )
2dup [ length ] 2apply = [
- f [ first compatible-values? and ] 2reduce
+ t [ first compatible-values? and ] 2reduce
] [
2drop f
] if ;
USING: arrays generic hashtables interpreter kernel lists math
namespaces parser sequences words ;
-! Recursive state. An alist, mapping words to labels.
-SYMBOL: recursive-state
-
-: <computed> \ <computed> counter ;
-
-TUPLE: value uid literal recursion ;
-
-C: value ( obj -- value )
- <computed> over set-value-uid
- recursive-state get over set-value-recursion
- [ set-value-literal ] keep ;
-
-M: value hashcode value-uid ;
-
-M: value = eq? ;
-
-M: integer value-uid ;
-
-M: integer value-recursion drop f ;
-
! The dataflow IR is the first of the two intermediate
! representations used by Factor. It annotates concatenative
! code with stack flow information and types.
+! Copyright (C) 2005, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
IN: inference
USING: hashtables kernel math namespaces sequences ;
+! Recursive state. An alist, mapping words to labels.
+SYMBOL: recursive-state
+
+: <computed> \ <computed> counter ;
+
+TUPLE: value uid literal recursion ;
+
+C: value ( obj -- value )
+ <computed> over set-value-uid
+ recursive-state get over set-value-recursion
+ [ set-value-literal ] keep ;
+
+M: value hashcode value-uid ;
+
+M: value = eq? ;
+
+M: integer value-uid ;
+
+M: integer value-recursion drop f ;
+
TUPLE: shuffle in-d in-r out-d out-r ;
: load-shuffle ( d r shuffle -- )