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

stack-checker: stop early with compiler error. easier for debbuging.

locals-and-roots
Doug Coleman 2016-05-17 11:25:29 -07:00
parent 6e2bd6f149
commit cee44902fb
2 changed files with 21 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
basis/bootstrap/compiler/compiler.factor
View File

@ -5,7 +5,7 @@ classes.tuple.private compiler.units hashtables
hashtables.private io kernel libc math math.parser memory hashtables.private io kernel libc math math.parser memory
namespaces namespaces.private quotations quotations.private namespaces namespaces.private quotations quotations.private
sbufs sequences sequences.private splitting system vectors sbufs sequences sequences.private splitting system vectors
vocabs vocabs.loader words ; vocabs vocabs.loader words stack-checker.row-polymorphism ;
FROM: compiler => enable-optimizer ; FROM: compiler => enable-optimizer ;
IN: bootstrap.compiler IN: bootstrap.compiler
@ -63,6 +63,11 @@ gc
"." write flush "." write flush
{
unify-variables
(balance-actual-depth)
} compile-unoptimized
{ {
bitand bitor bitxor bitnot bitand bitor bitxor bitnot
} compile-unoptimized } compile-unoptimized

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

@ -33,11 +33,9 @@ IN: stack-checker.row-polymorphism
actual declared [ slot call length ] bi@ declared var-slot call actual declared [ slot call length ] bi@ declared var-slot call
[ vars (check-variable) ] keep ; inline [ vars (check-variable) ] keep ; inline
:: unify-variables ( in-diff in-ok? in-var out-diff out-ok? out-var vars -- ? ) :: unify-variables ( in-diff in-ok? in-var out-diff out-ok? out-var vars -- ? )
in-ok? { [ in-ok? ] [ out-ok? ] [ in-diff out-diff = ] } 0 n&& dup [
out-ok? and
in-diff out-diff = and
dup [
in-var [ in-diff swap vars adjust-variable ] when* in-var [ in-diff swap vars adjust-variable ] when*
out-var [ out-diff swap vars adjust-variable ] when* out-var [ out-diff swap vars adjust-variable ] when*
] when ; ] when ;
@ -45,19 +43,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 ! 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 ! shallow subtype of the root effect, adjust it here
:: (balance-actual-depth) ( declared actual -- depth/f ) :: (balance-actual-depth) ( declared actual -- depth/f )
declared in-var>> {
declared out-var>> not and { [ {
actual out>> length declared out>> length < and [ [ declared in-var>> ]
declared out>> length actual out>> length - [ declared out-var>> not ]
] [ [ actual out>> length declared out>> length < ]
declared in-var>> not } 0 n&& ] [ declared out>> length actual out>> length - ] }
declared out-var>> and { [ {
actual in>> length declared in>> length < and [ [ declared in-var>> not ]
declared in>> length actual in>> length - [ declared out-var>> ]
] [ [ actual in>> length declared in>> length < ]
f } 0 n&& ] [ declared in>> length actual in>> length - ] }
] if [ f ]
] if ; } cond ;
: (balance-by) ( effect n -- effect' ) : (balance-by) ( effect n -- effect' )
"x" <array> swap "x" <array> swap