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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2008-04-07 21:05:40 -05:00
parent b6befe6100 b4ad4673b5
commit d7b2612c40
9 changed files with 92 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
core/classes/tuple/tuple-tests.factor
View File

@ -529,3 +529,12 @@ TUPLE: another-forget-accessors-test ;
] unit-test
[ t ] [ \ another-forget-accessors-test class? ] unit-test
! Shadowing test
[ f ] [
t parser-notes? [
[
"IN: classes.tuple.tests TUPLE: shadow-1 a b ; TUPLE: shadow-2 < shadow-1 a b ;" eval
] with-string-writer empty?
] with-variable
] unit-test

6
core/classes/tuple/tuple.factor
View File

@ -55,6 +55,9 @@ PRIVATE>
"slot-names" word-prop
[ dup array? [ second ] when ] map ;
: all-slot-names ( class -- slots )
superclasses [ slot-names ] map concat \ class prefix ;
<PRIVATE
: tuple= ( tuple1 tuple2 -- ? )
@ -119,9 +122,6 @@ PRIVATE>
: define-tuple-layout ( class -- )
dup make-tuple-layout "layout" set-word-prop ;
: all-slot-names ( class -- slots )
superclasses [ slot-names ] map concat \ class prefix ;
: compute-slot-permutation ( class old-slot-names -- permutation )
>r all-slot-names r> [ index ] curry map ;

4
core/combinators/combinators.factor
View File

@ -59,6 +59,10 @@ ERROR: no-case ;
M: sequence hashcode*
[ sequence-hashcode ] recursive-hashcode ;
M: reversed hashcode* [ sequence-hashcode ] recursive-hashcode ;
M: slice hashcode* [ sequence-hashcode ] recursive-hashcode ;
M: hashtable hashcode*
[
dup assoc-size 1 number=

8
core/compiler/compiler.factor
View File

@ -1,10 +1,10 @@
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces arrays sequences io inference.backend
inference.state generator debugger math.parser prettyprint words
compiler.units continuations vocabs assocs alien.compiler dlists
optimizer definitions math compiler.errors threads graphs
generic inference ;
inference.state generator debugger words compiler.units
continuations vocabs assocs alien.compiler dlists optimizer
definitions math compiler.errors threads graphs generic
inference ;
IN: compiler
: ripple-up ( word -- )

3
core/optimizer/optimizer-tests.factor
View File

@ -370,4 +370,7 @@ HINTS: recursive-inline-hang-2 array ;
HINTS: recursive-inline-hang-3 array ;
! Regression
USE: sequences.private
[ ] [ { (3append) } compile ] unit-test

10
core/parser/parser-docs.factor
View File

@ -153,6 +153,8 @@ ARTICLE: "parser-files" "Parsing source files"
{ $subsection parse-file }
{ $subsection bootstrap-file }
"The parser cross-references source files and definitions. This allows it to keep track of removed definitions, and prevent forward references and accidental redefinitions."
$nl
"While the above words are useful for one-off experiments, real programs should be written to use the vocabulary system instead; see " { $link "vocabs.loader" } "."
{ $see-also "source-files" } ;
ARTICLE: "parser-usage" "Reflective parser usage"
@ -161,6 +163,13 @@ ARTICLE: "parser-usage" "Reflective parser usage"
"The parser can also parse from a stream:"
{ $subsection parse-stream } ;
ARTICLE: "top-level-forms" "Top level forms"
"Any code outside of a definition is known as a " { $emphasis "top-level form" } "; top-level forms are run after the entire source file has been parsed, regardless of their position in the file."
$nl
"Top-level forms do not have access to the " { $link in } " and " { $link use } " variables that were set at parse time, nor do they run inside " { $link with-compilation-unit } "; so meta-programming might require extra work in a top-level form compared with a parsing word."
$nl
"Also, top-level forms run in a new dynamic scope, so using " { $link set } " to store values is almost always wrong, since the values will be lost after the top-level form completes. To save values computed by a top-level form, either use " { $link set-global } " or define a new word with the value." ;
ARTICLE: "parser" "The parser"
"This parser is a general facility for reading textual representations of objects and definitions. The parser is implemented in the " { $vocab-link "parser" } " and " { $vocab-link "syntax" } " vocabularies."
$nl
@ -168,6 +177,7 @@ $nl
{ $subsection "vocabulary-search" }
{ $subsection "parser-files" }
{ $subsection "parser-usage" }
{ $subsection "top-level-forms" }
"The parser can be extended."
{ $subsection "parsing-words" }
{ $subsection "parser-lexer" }

29
core/parser/parser.factor
View File

@ -1,12 +1,11 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays definitions generic assocs kernel math
namespaces prettyprint sequences strings vectors words
quotations inspector io.styles io combinators sorting
splitting math.parser effects continuations debugger
io.files io.streams.string vocabs io.encodings.utf8
source-files classes hashtables compiler.errors compiler.units
accessors ;
USING: arrays definitions generic assocs kernel math namespaces
prettyprint sequences strings vectors words quotations inspector
io.styles io combinators sorting splitting math.parser effects
continuations debugger io.files io.streams.string vocabs
io.encodings.utf8 source-files classes classes.tuple hashtables
compiler.errors compiler.units accessors ;
IN: parser
TUPLE: lexer text line line-text line-length column ;
@ -285,13 +284,27 @@ M: no-word-error summary
: CREATE-METHOD ( -- method )
scan-word bootstrap-word scan-word create-method-in ;
: shadowed-slots ( superclass slots -- shadowed )
>r all-slot-names r> seq-intersect ;
: check-slot-shadowing ( class superclass slots -- )
shadowed-slots [
[
"Definition of slot ``" %
%
"'' in class ``" %
word-name %
"'' shadows a superclass slot" %
] "" make note.
] with each ;
: parse-tuple-definition ( -- class superclass slots )
CREATE-CLASS
scan {
{ ";" [ tuple f ] }
{ "<" [ scan-word ";" parse-tokens ] }
[ >r tuple ";" parse-tokens r> prefix ]
} case ;
} case 3dup check-slot-shadowing ;
ERROR: staging-violation word ;

20
core/sequences/sequences-tests.factor
View File

@ -1,6 +1,6 @@
USING: arrays kernel math namespaces sequences kernel.private
sequences.private strings sbufs tools.test vectors bit-arrays
generic ;
generic vocabs.loader ;
IN: sequences.tests
[ V{ 1 2 3 4 } ] [ 1 5 dup <slice> >vector ] unit-test
@ -100,6 +100,16 @@ unit-test
[ [ ] ] [ [ 1 2 3 ] 3 tail ] unit-test
[ [ 3 ] ] [ [ 1 2 3 ] 2 tail ] unit-test
[ "blah" ] [ "blahxx" 2 head* ] unit-test
[ "xx" ] [ "blahxx" 2 tail* ] unit-test
[ t ] [ "xxfoo" 2 head-slice "xxbar" 2 head-slice = ] unit-test
[ t ] [ "xxfoo" 2 head-slice "xxbar" 2 head-slice [ hashcode ] bi@ = ] unit-test
[ t ] [ "xxfoo" 2 head-slice SBUF" barxx" 2 tail-slice* = ] unit-test
[ t ] [ "xxfoo" 2 head-slice SBUF" barxx" 2 tail-slice* [ hashcode ] bi@ = ] unit-test
[ t ] [ [ 1 2 3 ] [ 1 2 3 ] sequence= ] unit-test
[ t ] [ [ 1 2 3 ] { 1 2 3 } sequence= ] unit-test
[ t ] [ { 1 2 3 } [ 1 2 3 ] sequence= ] unit-test
@ -195,6 +205,12 @@ unit-test
! Pathological case
[ "ihbye" ] [ "hi" <reversed> "bye" append ] unit-test
[ t ] [ "hi" <reversed> SBUF" hi" <reversed> = ] unit-test
[ t ] [ "hi" <reversed> SBUF" hi" <reversed> = ] unit-test
[ t ] [ "hi" <reversed> SBUF" hi" <reversed> [ hashcode ] bi@ = ] unit-test
[ -10 "hi" "bye" copy ] must-fail
[ 10 "hi" "bye" copy ] must-fail
@ -244,3 +260,5 @@ unit-test
[ "asdf " ] [ " asdf " [ CHAR: \s = ] left-trim ] unit-test
[ " asdf" ] [ " asdf " [ CHAR: \s = ] right-trim ] unit-test
! Hardcore
[ ] [ "sequences" reload ] unit-test

30
core/sequences/sequences.factor
View File

@ -172,7 +172,9 @@ TUPLE: reversed seq ;
C: <reversed> reversed
M: reversed virtual-seq reversed-seq ;
M: reversed virtual@ reversed-seq [ length swap - 1- ] keep ;
M: reversed length reversed-seq length ;
INSTANCE: reversed virtual-sequence
@ -198,7 +200,9 @@ ERROR: slice-error reason ;
slice construct-boa ; inline
M: slice virtual-seq slice-seq ;
M: slice virtual@ [ slice-from + ] keep slice-seq ;
M: slice length dup slice-to swap slice-from - ;
: head-slice ( seq n -- slice ) (head) <slice> ;
@ -466,6 +470,21 @@ M: sequence <=>
2dup [ length ] bi@ number=
[ mismatch not ] [ 2drop f ] if ; inline
: sequence-hashcode-step ( oldhash newpart -- newhash )
swap [
dup -2 fixnum-shift-fast swap 5 fixnum-shift-fast
fixnum+fast fixnum+fast
] keep fixnum-bitxor ; inline
: sequence-hashcode ( n seq -- x )
0 -rot [
hashcode* >fixnum sequence-hashcode-step
] with each ; inline
M: reversed equal? over reversed? [ sequence= ] [ 2drop f ] if ;
M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
: move ( to from seq -- )
2over number=
[ 3drop ] [ [ nth swap ] keep set-nth ] if ; inline
@ -692,14 +711,3 @@ PRIVATE>
dup [ length ] map infimum
[ <column> dup like ] with map
] unless ;
: sequence-hashcode-step ( oldhash newpart -- newhash )
swap [
dup -2 fixnum-shift-fast swap 5 fixnum-shift-fast
fixnum+fast fixnum+fast
] keep fixnum-bitxor ; inline
: sequence-hashcode ( n seq -- x )
0 -rot [
hashcode* >fixnum sequence-hashcode-step
] with each ; inline