steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

stack-checker.row-polymorphism: fixes bootstrap. i dont know why cond and 0|| are breaking things yet..

locals-and-roots
Doug Coleman 2016-05-16 15:45:02 -07:00
parent bcdedab579
commit 6c7a537d46
1 changed files with 17 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
core/stack-checker/row-polymorphism/row-polymorphism.factor
View File

@ -34,7 +34,10 @@ IN: stack-checker.row-polymorphism
[ vars (check-variable) ] keep ; inline
:: unify-variables ( in-diff in-ok? in-var out-diff out-ok? out-var vars -- ? )
{ [ in-ok? ] [ out-ok? ] [ in-diff out-diff = ] } 0&& dup [
in-ok?
out-ok? and
in-diff out-diff = and
dup [
in-var [ in-diff swap vars adjust-variable ] when*
out-var [ out-diff swap vars adjust-variable ] when*
] when ;
@ -42,19 +45,19 @@ IN: stack-checker.row-polymorphism
! A bit of a hack. If the declared effect is one-sided monomorphic and the actual effect is a
! shallow subtype of the root effect, adjust it here
:: (balance-actual-depth) ( declared actual -- depth/f )
{
{ [ {
[ declared in-var>> ]
[ declared out-var>> not ]
[ actual out>> length declared out>> length < ]
} 0&& ] [ declared out>> length actual out>> length - ] }
{ [ {
[ declared in-var>> not ]
[ declared out-var>> ]
[ actual in>> length declared in>> length < ]
} 0&& ] [ declared in>> length actual in>> length - ] }
[ f ]
} cond ;
declared in-var>>
declared out-var>> not and
actual out>> length declared out>> length < and [
declared out>> length actual out>> length -
] [
declared in-var>> not
declared out-var>> and
actual in>> length declared in>> length < and [
declared in>> length actual in>> length -
] [
f
] if
] if ;
: (balance-by) ( effect n -- effect' )
"x" <array> swap