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

inference errors printed; type violations are flagged; plugin fixes

cvs
Slava Pestov 2005-02-23 04:07:47 +00:00
parent eb86c229e0
commit 6b9133bf30
20 changed files with 170 additions and 202 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
TODO.FACTOR.txt
View File

@ -7,10 +7,8 @@
- type inference fails with some assembler words;
displaced, register and other predicates need to inherit from list
not cons, and need stronger branch partial eval
- print warning on null class
- optimize away dispatch
- code gc
- #jump-f #jump-f-label
- don't hardcode so many colors
- ffi unicode strings: null char security hole
- utf16 string boxing
@ -19,6 +17,7 @@
+ compiler/ffi:
- #jump-f #jump-f-label
- declarations
- value type structs
- out parameters

6
examples/mandel.factor
View File

@ -89,10 +89,10 @@ SYMBOL: center
] with-pixels ; compiled
: mandel ( -- )
640 480 0 SDL_HWSURFACE [
1280 1024 0 SDL_HWSURFACE [
[
0.8 zoom-fact set
-0.65 center set
3.7 zoom-fact set
-0.45 center set
100 nb-iter set
init-mandel
[ render ] time

2
factor/DefaultVocabularyLookup.java
View File

@ -193,7 +193,7 @@ public class DefaultVocabularyLookup implements VocabularyLookup
{
// save to same workspace as vocabulary,
// or no workspace if vocabulary is builtins
FactorWord word = new FactorWord(vocabulary,name);
FactorWord word = new FactorWord(this,vocabulary,name);
v.put(name,word);
return word;
}

2
factor/ExternalFactor.java
View File

@ -201,7 +201,7 @@ public class ExternalFactor extends DefaultVocabularyLookup
String name = (String)info.next().car;
FactorWord w = super.searchVocabulary(new Cons(vocabulary,null),name);
if(w == null)
w = new FactorWord(vocabulary,name);
w = new FactorWord(this,vocabulary,name);
w.stackEffect = (String)info.next().next().car;
return w;
} //}}}

2
factor/FactorArtifact.java
View File

@ -67,4 +67,6 @@ public abstract class FactorArtifact
public abstract String getShortString();
public abstract String getLongString();
public void forget() {}
}

2
factor/FactorReader.java
View File

@ -46,7 +46,7 @@ public class FactorReader
/**
* Top level of parse tree.
*/
private FactorWord toplevel = new FactorWord(null,"#<EOF>");
private FactorWord toplevel = new FactorWord(null,null,"#<EOF>");
private boolean alwaysDocComments;
private Cons use;

19
factor/FactorWord.java
View File

@ -43,14 +43,18 @@ public class FactorWord extends FactorArtifact implements FactorExternalizable
*/
public FactorParsingDefinition parsing;
private VocabularyLookup lookup;
/**
* For browsing, the parsing word that was used to define this word.
*/
private FactorWord definer;
//{{{ FactorWord constructor
public FactorWord(String vocabulary, String name)
public FactorWord(VocabularyLookup lookup,
String vocabulary, String name)
{
this.lookup = lookup;
this.vocabulary = vocabulary;
this.name = name;
} //}}}
@ -65,7 +69,7 @@ public class FactorWord extends FactorArtifact implements FactorExternalizable
public FactorWord getDefiner()
{
if(definer == null)
return new FactorWord(null,"DEFER:");
return new FactorWord(lookup,null,"DEFER:");
else
return definer;
} //}}}
@ -87,4 +91,15 @@ public class FactorWord extends FactorArtifact implements FactorExternalizable
{
return FactorWordRenderer.getWordHTMLString(this,false);
} //}}}
//{{{ forget() method
public void forget()
{
/* Not allowed to forget parsing words, since that confuses our
parser */
if(parsing != null)
return;
lookup.forget(this);
} //}}}
}

20
factor/jedit/FactorSideKickParser.java
View File

@ -98,9 +98,9 @@ public class FactorSideKickParser extends SideKickParser
public SideKickParsedData parse(Buffer buffer,
DefaultErrorSource errorSource)
{
Object words = buffer.getProperty(ARTIFACTS_PROPERTY);
if(words instanceof Cons)
forgetWords((Cons)words);
Object artifacts = buffer.getProperty(ARTIFACTS_PROPERTY);
if(artifacts instanceof Cons)
forgetArtifacts((Cons)artifacts);
FactorParsedData d = new FactorParsedData(
this,buffer.getPath());
@ -157,17 +157,13 @@ public class FactorSideKickParser extends SideKickParser
return d;
} //}}}
//{{{ forgetWords() method
private void forgetWords(Cons words)
//{{{ forgetArtifacts() method
private void forgetArtifacts(Cons artifacts)
{
while(words != null)
while(artifacts != null)
{
FactorWord word = (FactorWord)words.car;
// We're not allowed to forget parsing words.
if(word.parsing != null)
return;
FactorPlugin.getExternalInstance().forget(word);
words = words.next();
((FactorArtifact)artifacts.car).forget();
artifacts = artifacts.next();
}
} //}}}

13
library/assoc.factor
View File

@ -11,14 +11,21 @@ IN: lists USING: kernel ;
dup list? [ [ cons? ] all? ] [ drop f ] ifte ;
: assoc* ( key alist -- [[ key value ]] )
#! Looks up the key in an alist. Push the key/value pair.
#! Most of the time you want to use assoc not assoc*.
#! Look up a key/value pair.
[ car = ] some-with? dup [ car ] when ;
: assoc ( key alist -- value )
#! Looks up the key in an alist.
#! Look up a value.
assoc* dup [ cdr ] when ;
: assq* ( key alist -- [[ key value ]] )
#! Looks up a key/value pair using identity comparison.
[ car eq? ] some-with? dup [ car ] when ;
: assq ( key alist -- value )
#! Looks up a key/value pair using identity comparison.
assq* dup [ cdr ] when ;
: remove-assoc ( key alist -- alist )
#! Remove all key/value pairs with this key.
[ car = not ] subset-with ;

1
library/bootstrap/boot-stage2.factor
View File

@ -94,6 +94,7 @@ IN: alien : add-library 3drop ;
"/library/tools/profiler.factor"
"/library/tools/interpreter.factor"
"/library/inference/conditions.factor"
"/library/inference/dataflow.factor"
"/library/inference/inference.factor"
"/library/inference/branches.factor"

41
library/compiler/generator.factor
View File

@ -1,41 +1,8 @@
! :folding=indent:collapseFolds=1:
! $Id$
!
! Copyright (C) 2004 Slava Pestov.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: compiler
USE: assembler
USE: inference
USE: errors
USE: kernel
USE: lists
USE: math
USE: namespaces
USE: strings
USE: words
USE: vectors
USING: assembler inference errors kernel lists math namespaces
strings words vectors ;
! To support saving compiled code to disk, generator words
! append relocation instructions to this vector.

46
library/compiler/linearizer.factor
View File

@ -1,41 +1,8 @@
! :folding=indent:collapseFolds=1:
! $Id$
!
! Copyright (C) 2004 Slava Pestov.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: compiler
USE: inference
USE: kernel
USE: lists
USE: math
USE: namespaces
USE: words
USE: strings
USE: errors
USE: prettyprint
USE: kernel-internals
USING: inference kernel lists math namespaces words strings
errors prettyprint kernel-internals ;
! The linear IR is close to assembly language. It also resembles
! Forth code in some sense. It exists so that pattern matching
@ -49,6 +16,9 @@ SYMBOL: #push-indirect
SYMBOL: #replace-immediate
SYMBOL: #replace-indirect
SYMBOL: #jump-t ( branch if top of stack is true )
SYMBOL: #jump-t-label ( branch if top of stack is true )
SYMBOL: #jump-f ( branch if top of stack is false )
SYMBOL: #jump-f-label ( branch if top of stack is false )
SYMBOL: #jump ( tail-call )
SYMBOL: #jump-label ( tail-call )
SYMBOL: #return-to ( push addr on C stack )
@ -133,7 +103,7 @@ SYMBOL: #end-dispatch
#! The parameter is a list of two lists, each one a dataflow
#! IR.
2unlist <label> [
#jump-t swons ,
#jump-t-label swons ,
(linearize) ( false branch )
<label> dup #jump-label swons ,
] keep label, ( branch target of BRANCH-T )

39
library/compiler/simplifier.factor
View File

@ -1,39 +1,8 @@
! :folding=indent:collapseFolds=1:
! $Id$
!
! Copyright (C) 2004, 2005 Slava Pestov.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
! See http://factor.sf.net/license.txt for BSD license.
IN: compiler
USE: kernel
USE: lists
USE: namespaces
USE: words
USE: inference
USE: strings
USE: strings
USE: prettyprint
USING: kernel lists namespaces words inference strings
prettyprint ;
! The linear IR being simplified is stored in this variable.
SYMBOL: simplifying
@ -144,7 +113,7 @@ SYMBOL: simplifying
: double-jump ( linear op1 op2 -- linear ? )
#! A jump to a jump is just a jump. If the next logical node
#! is a jump of type op1, replace the jump at the car of the
#! list with a just of type op2.
#! list with a jump of type op2.
swap pick next-logical? [
over next-logical car cdr cons swap cdr cons t
] [

26
library/compiler/x86/generator.factor
View File

@ -40,12 +40,34 @@ math memory namespaces words ;
compile-jump-label
] "generator" set-word-property
#jump-t [
: compile-jump-t ( word -- )
POP-DS
! condition is now in EAX
EAX f address CMP
! jump w/ address added later
0 JNE fixup compiled-offset defer-xt
0 JNE fixup compiled-offset defer-xt ;
#jump-t-label [
compile-jump-t
] "generator" set-word-property
#jump-t [
dup compile-jump-t t rel-word
] "generator" set-word-property
: compile-jump-f ( word -- )
POP-DS
! condition is now in EAX
EAX f address CMP
! jump w/ address added later
0 JE fixup compiled-offset defer-xt ;
#jump-f-label [
compile-jump-f
] "generator" set-word-property
#jump-f [
dup compile-jump-f t rel-word
] "generator" set-word-property
#return-to [

8
library/inference/branches.factor
View File

@ -50,7 +50,7 @@ strings vectors words hashtables prettyprint ;
dup balanced? [
unzip unify-stacks >r unify-stacks r>
] [
"Unbalanced branches" throw
"Unbalanced branches" inference-error
] ifte ;
: datastack-effect ( list -- )
@ -79,7 +79,7 @@ SYMBOL: cloned
: deep-clone ( obj -- obj )
#! Clone an object if it hasn't already been cloned in this
#! with-deep-clone scope.
dup cloned get assoc [
dup cloned get assq [
clone [ dup cloned [ acons ] change ] keep
] ?unless ;
@ -146,10 +146,10 @@ SYMBOL: cloned
#! parameter is a vector.
(infer-branches) dup unify-effects unify-dataflow ;
: (with-block) ( label quot -- node )
: (with-block) ( [[ label quot ]] quot -- node )
#! Call a quotation in a new namespace, and transfer
#! inference state from the outer scope.
swap >r [
swap car >r [
dataflow-graph off
call
d-in get meta-d get meta-r get get-dataflow

36
library/inference/conditions.factor Normal file
View File

@ -0,0 +1,36 @@
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: inference
USING: errors interpreter kernel lists namespaces prettyprint
stdio ;
DEFER: recursive-state
: inference-condition ( msg symbol -- )
[
, , recursive-state get , meta-d get , meta-r get ,
] make-list ;
: inference-error ( msg -- )
\ inference-error inference-condition throw ;
: inference-warning ( msg -- )
\ inference-warning inference-condition error. ;
: inference-condition. ( cond msg -- )
write
cdr unswons error.
"Recursive state:" print
car [.] ;
! "Meta data stack:" print
! unswons {.}
! "Meta return stack:" print
! car {.} ;
PREDICATE: cons inference-error car \ inference-error = ;
M: inference-error error. ( error -- )
"Inference error: " inference-condition. ;
PREDICATE: cons inference-warning car \ inference-warning = ;
M: inference-warning error. ( error -- )
"Inference warning: " inference-condition. ;

61
library/inference/inference.factor
View File

@ -1,43 +1,8 @@
! :folding=indent:collapseFolds=1:
! $Id$
!
! Copyright (C) 2004, 2005 Slava Pestov.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
! See http://factor.sf.net/license.txt for BSD license.
IN: inference
USE: errors
USE: interpreter
USE: kernel
USE: lists
USE: math
USE: namespaces
USE: strings
USE: vectors
USE: words
USE: hashtables
USE: generic
USE: prettyprint
USING: generic interpreter kernel lists math namespaces strings
unparser vectors words ;
: max-recursion 0 ;
@ -77,8 +42,20 @@ C: computed ( class -- value )
M: computed value= ( literal value -- ? )
2drop f ;
: failing-class-and
2dup class-and dup null = [
drop [
word-name , " and " , word-name ,
" do not intersect" ,
] make-string inference-error
] [
2nip
] ifte ;
M: computed value-class-and ( class value -- )
[ value-class class-and ] keep set-value-class ;
[
value-class failing-class-and
] keep set-value-class ;
TUPLE: literal value delegate ;
@ -98,6 +75,10 @@ M: literal value-class-and ( class value -- )
M: literal set-value-class ( class value -- )
2drop ;
M: computed literal-value ( value -- )
"A literal value was expected where a computed value was"
" found: " rot unparse cat3 inference-error ;
: (ensure-types) ( typelist n stack -- )
pick [
3dup >r >r car r> r> vector-nth value-class-and
@ -191,7 +172,7 @@ DEFER: apply-word
: check-return ( -- )
#! Raise an error if word leaves values on return stack.
meta-r get vector-length 0 = [
"Word leaves elements on return stack" throw
"Word leaves elements on return stack" inference-error
] unless ;
: values-node ( op -- )

29
library/inference/words.factor
View File

@ -41,9 +41,9 @@ strings vectors words hashtables parser prettyprint ;
] ifte* ;
: no-effect ( word -- )
"Unknown stack effect: " swap word-name cat2 throw ;
"Unknown stack effect: " swap word-name cat2 inference-error ;
: with-block ( word label quot -- node )
: with-block ( word [[ label quot ]] quot -- node )
#! Execute a quotation with the word on the stack, and add
#! its dataflow contribution to a new block node in the IR.
over [
@ -60,7 +60,9 @@ strings vectors words hashtables parser prettyprint ;
#! Infer the stack effect of a compound word in the current
#! inferencer instance. If the word in question is recursive
#! we infer its stack effect inside a new block.
gensym [ word-parameter infer-quot effect ] with-block ;
gensym over word-parameter cons [
word-parameter infer-quot effect
] with-block ;
: infer-compound ( word -- )
#! Infer a word's stack effect in a separate inferencer
@ -83,6 +85,10 @@ strings vectors words hashtables parser prettyprint ;
GENERIC: (apply-word)
M: object (apply-word) ( word -- )
#! A primitive with an unknown stack effect.
no-effect ;
M: compound (apply-word) ( word -- )
#! Infer a compound word's stack effect.
dup "no-effect" word-property [
@ -110,9 +116,9 @@ M: symbol (apply-word) ( word -- )
rethrow
] catch ;
: base-case ( word label -- )
: base-case ( word [ label quot ] -- )
[
over inline-compound [
car over inline-compound [
drop
[ #call-label ] [ #call ] ?ifte
node-op set
@ -121,9 +127,9 @@ M: symbol (apply-word) ( word -- )
] with-recursion ;
: no-base-case ( word -- )
word-name " does not have a base case." cat2 throw ;
word-name " does not have a base case." cat2 inference-error ;
: recursive-word ( word label -- )
: recursive-word ( word [ label quot ] -- )
#! Handle a recursive call, by either applying a previously
#! inferred base case, or raising an error. If the recursive
#! call is to a local block, emit a label call node.
@ -152,11 +158,10 @@ M: symbol (apply-word) ( word -- )
: infer-call ( -- )
[ general-list ] ensure-d
dataflow-drop,
gensym dup [
drop pop-d dup
value-recursion recursive-state set
literal-value
dup infer-quot
pop-d gensym dup pick literal-value cons [
drop
dup value-recursion recursive-state set
literal-value dup infer-quot
] with-block drop handle-terminator ;
\ call [ infer-call ] "infer" set-word-property

14
library/test/memory.factor
View File

@ -1,14 +1,12 @@
IN: scratchpad
USE: kernel
USE: math
USE: memory
USE: generic
USE: lists
USING: generic kernel lists math memory words ;
num-types [
[
builtin-type instances [
class drop
] each
builtin-type [
"predicate" word-property instances [
class drop
] each
] when*
] keep
] repeat

2
library/test/tuple.factor
View File

@ -47,7 +47,7 @@ C: quuux-tuple-2
100 200 <point>
! Use eval to sequence parsing explicitly
"TUPLE: point y x ;" eval
"TUPLE: point x y z ;" eval
point-x
] unit-test