minor stack inference fixes
Slava Pestov
parent
54ff898359
commit
7092b10f2f
|
|
@ -81,7 +81,17 @@ public class FactorPlugin extends EditPlugin
|
|||
buffer = buffer.getNext();
|
||||
}
|
||||
} //}}}
|
||||
|
||||
|
||||
//{{{ addNonEmpty() method
|
||||
private static void addNonEmpty(String[] input, List output)
|
||||
{
|
||||
for(int i = 0; i < input.length; i++)
|
||||
{
|
||||
if(input[i].length() != 0)
|
||||
output.add(input[i]);
|
||||
}
|
||||
} //}}}
|
||||
|
||||
//{{{ getExternalInstance() method
|
||||
/**
|
||||
* Returns the object representing a connection to an external Factor instance.
|
||||
|
|
@ -97,15 +107,17 @@ public class FactorPlugin extends EditPlugin
|
|||
|
||||
try
|
||||
{
|
||||
String[] args = jEdit.getProperty("factor.external.args","-jedit")
|
||||
List args = new ArrayList();
|
||||
args.add(jEdit.getProperty("factor.external.program"));
|
||||
args.add(jEdit.getProperty("factor.external.image"));
|
||||
args.add("-no-ansi");
|
||||
args.add("-no-smart-terminal");
|
||||
String[] extraArgs = jEdit.getProperty(
|
||||
"factor.external.args","-jedit")
|
||||
.split(" ");
|
||||
String[] nargs = new String[args.length + 4];
|
||||
nargs[0] = jEdit.getProperty("factor.external.program");
|
||||
nargs[1] = jEdit.getProperty("factor.external.image");
|
||||
nargs[2] = "-no-ansi";
|
||||
nargs[3] = "-no-smart-terminal";
|
||||
System.arraycopy(args,0,nargs,4,args.length);
|
||||
p = Runtime.getRuntime().exec(nargs);
|
||||
addNonEmpty(extraArgs,args);
|
||||
p = Runtime.getRuntime().exec((String[])args.toArray(
|
||||
new String[args.size()]));
|
||||
p.getErrorStream().close();
|
||||
|
||||
in = p.getInputStream();
|
||||
|
|
|
|||
|
|
@ -70,6 +70,33 @@ USE: kernel-internals
|
|||
|
||||
init-error-handler
|
||||
|
||||
! An experiment gone wrong...
|
||||
|
||||
! : usage+ ( key -- )
|
||||
! dup "usages" word-property
|
||||
! [ succ ] [ 1 ] ifte*
|
||||
! "usages" set-word-property ;
|
||||
!
|
||||
! GENERIC: count-usages ( quot -- )
|
||||
! M: object count-usages drop ;
|
||||
! M: word count-usages usage+ ;
|
||||
! M: cons count-usages unswons count-usages count-usages ;
|
||||
!
|
||||
! : tally-usages ( -- )
|
||||
! [ f "usages" set-word-property ] each-word
|
||||
! [ word-parameter count-usages ] each-word ;
|
||||
!
|
||||
! : auto-inline ( count -- )
|
||||
! #! Automatically inline all words called less than a count
|
||||
! #! number of times.
|
||||
! [
|
||||
! 2dup "usages" word-property dup 0 ? >= [
|
||||
! t "inline" set-word-property
|
||||
! ] [
|
||||
! drop
|
||||
! ] ifte
|
||||
! ] each-word drop ;
|
||||
|
||||
! "Counting word usages..." print
|
||||
! tally-usages
|
||||
!
|
||||
|
|
@ -91,6 +118,9 @@ os "win32" = "compile" get and [
|
|||
"Compiling system..." print
|
||||
"compile" get [ compile-all ] when
|
||||
|
||||
"Unless you're working on the compiler, ignore the errors above." print
|
||||
"Not every word compiles, by design." print
|
||||
|
||||
0 [ compiled? [ succ ] when ] each-word
|
||||
unparse write " words compiled" print
|
||||
|
||||
|
|
|
|||
|
|
@ -96,4 +96,8 @@ M: compound (compile) ( word -- )
|
|||
|
||||
: compile-all ( -- )
|
||||
#! Compile all words.
|
||||
[ try-compile ] each-word ;
|
||||
supported-cpu? [
|
||||
[ try-compile ] each-word
|
||||
] [
|
||||
"Unsupported CPU" print
|
||||
] ifte ;
|
||||
|
|
|
|||
|
|
@ -96,7 +96,9 @@ USE: prettyprint
|
|||
dup check-lengths unify-stacks ;
|
||||
|
||||
: unify-effects ( list -- )
|
||||
filter-terminators dup balanced? [
|
||||
filter-terminators
|
||||
[ "No branch has a stack effect" throw ] unless*
|
||||
dup balanced? [
|
||||
dup unify-d-in d-in set
|
||||
dup unify-datastacks meta-d set
|
||||
unify-callstacks meta-r set
|
||||
|
|
@ -143,14 +145,19 @@ SYMBOL: dual-recursive-state
|
|||
] catch ;
|
||||
|
||||
: infer-base-cases ( branchlist -- list )
|
||||
[ terminator-quot? not ] subset
|
||||
dup [ dupd recursive-branch ] map nip
|
||||
[ ] subset ;
|
||||
dup [ dupd recursive-branch ] map [ ] subset nip ;
|
||||
|
||||
: infer-base-case ( branchlist -- )
|
||||
#! Can't do much if there is only one non-terminator branch.
|
||||
#! Either the word is not recursive, or it is recursive
|
||||
#! and the base case throws an error.
|
||||
[
|
||||
infer-base-cases unify-effects
|
||||
effect dual-recursive-state get set-base
|
||||
[ terminator-quot? not ] subset dup length 1 > [
|
||||
infer-base-cases unify-effects
|
||||
effect dual-recursive-state get set-base
|
||||
] [
|
||||
drop
|
||||
] ifte
|
||||
] with-scope ;
|
||||
|
||||
: (infer-branches) ( branchlist -- list )
|
||||
|
|
|
|||
|
|
@ -196,7 +196,16 @@ SYMBOL: sym-test
|
|||
|
||||
[ [ 1 | 1 ] ] [ [ get ] infer old-effect ] unit-test
|
||||
|
||||
! [ [ 1 | 1 ] ] [ [ str>number ] infer old-effect ] unit-test
|
||||
: terminator-branch
|
||||
dup [
|
||||
car
|
||||
] [
|
||||
not-a-number
|
||||
] ifte ;
|
||||
|
||||
[ [ 1 | 1 ] ] [ [ terminator-branch ] infer old-effect ] unit-test
|
||||
|
||||
[ [ 1 | 1 ] ] [ [ str>number ] infer old-effect ] unit-test
|
||||
|
||||
! Type inference
|
||||
|
||||
|
|
|
|||
|
|
@ -102,28 +102,3 @@ USE: math
|
|||
|
||||
: words. ( vocab -- )
|
||||
words . ;
|
||||
|
||||
: usage+ ( key -- )
|
||||
dup "usages" word-property
|
||||
[ succ ] [ 1 ] ifte*
|
||||
"usages" set-word-property ;
|
||||
|
||||
GENERIC: count-usages ( quot -- )
|
||||
M: object count-usages drop ;
|
||||
M: word count-usages usage+ ;
|
||||
M: cons count-usages unswons count-usages count-usages ;
|
||||
|
||||
: tally-usages ( -- )
|
||||
[ f "usages" set-word-property ] each-word
|
||||
[ word-parameter count-usages ] each-word ;
|
||||
|
||||
: auto-inline ( count -- )
|
||||
#! Automatically inline all words called less than a count
|
||||
#! number of times.
|
||||
[
|
||||
2dup "usages" word-property dup 0 ? >= [
|
||||
t "inline" set-word-property
|
||||
] [
|
||||
drop
|
||||
] ifte
|
||||
] each-word drop ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue