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-01-09 12:56:10 -04:00
parent 0e37ec3968 3b311d3cb7
commit 0cab0bab24
38 changed files with 380 additions and 291 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
core/bootstrap/compiler/compiler.factor
View File

@ -5,7 +5,7 @@ namespaces parser kernel kernel.private classes classes.private
arrays hashtables vectors tuples sbufs inference.dataflow
hashtables.private sequences.private math tuples.private
growable namespaces.private assocs words generator command-line
vocabs io prettyprint libc definitions ;
vocabs io prettyprint libc compiler.units ;
IN: bootstrap.compiler
! Don't bring this in when deploying, since it will store a

5
core/bootstrap/image/image.factor
View File

@ -459,5 +459,8 @@ PRIVATE>
: make-images ( -- )
{
"x86.32" "x86.64" "linux-ppc" "macosx-ppc" "arm"
"x86.32"
! "x86.64"
"linux-ppc" "macosx-ppc"
! "arm"
} [ make-image ] each ;

3
core/bootstrap/primitives.factor
View File

@ -34,6 +34,7 @@ call
"bit-arrays"
"byte-arrays"
"classes.private"
"compiler.units"
"continuations.private"
"float-arrays"
"generator"
@ -521,7 +522,7 @@ builtins get num-tags get tail f union-class define-class
{ "tag" "kernel.private" }
{ "cwd" "io.files" }
{ "cd" "io.files" }
{ "modify-code-heap" "words.private" }
{ "modify-code-heap" "compiler.units" }
{ "dlopen" "alien" }
{ "dlsym" "alien" }
{ "dlclose" "alien" }

2
core/bootstrap/stage2.factor
View File

@ -4,7 +4,7 @@ USING: init command-line namespaces words debugger io
kernel.private math memory continuations kernel io.files
io.backend system parser vocabs sequences prettyprint
vocabs.loader combinators splitting source-files strings
definitions assocs compiler.errors ;
definitions assocs compiler.errors compiler.units ;
IN: bootstrap.stage2
! Wrap everything in a catch which starts a listener so

2
core/classes/classes.factor
View File

@ -255,6 +255,8 @@ PRIVATE>
>r dup word-props r> union over set-word-props
t "class" set-word-prop ;
GENERIC: update-methods ( class -- )
: define-class ( word members superclass metaclass -- )
#! If it was already a class, update methods after.
define-class-props

3
core/classes/mixin/mixin-docs.factor
View File

@ -1,4 +1,5 @@
USING: help.markup help.syntax help words definitions classes ;
USING: help.markup help.syntax help words compiler.units
classes ;
IN: classes.mixin
ARTICLE: "mixins" "Mixin classes"

2
core/classes/predicate/predicate-docs.factor
View File

@ -1,6 +1,6 @@
USING: generic help.markup help.syntax kernel kernel.private
namespaces sequences words arrays layouts help effects math
layouts classes.private classes definitions ;
layouts classes.private classes compiler.units ;
IN: classes.predicate
ARTICLE: "predicates" "Predicate classes"

2
core/classes/union/union-docs.factor
View File

@ -1,6 +1,6 @@
USING: generic help.markup help.syntax kernel kernel.private
namespaces sequences words arrays layouts help effects math
layouts classes.private classes definitions ;
layouts classes.private classes compiler.units ;
IN: classes.union
ARTICLE: "unions" "Union classes"

7
core/compiler/compiler.factor
View File

@ -2,7 +2,7 @@
! 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
words.private continuations vocabs assocs alien.compiler dlists
compiler.units continuations vocabs assocs alien.compiler dlists
optimizer definitions math compiler.errors threads graphs
generic ;
IN: compiler
@ -49,7 +49,10 @@ compiled-crossref global [ H{ } assoc-like ] change-at
"compiled-effect" set-word-prop ;
: finish-compile ( word effect dependencies -- )
>r dupd save-effect r> over compiled-unxref compiled-xref ;
>r dupd save-effect r>
f pick compiler-error
over compiled-unxref
compiled-xref ;
: compile-succeeded ( word -- effect dependencies )
[

70
core/compiler/units/units-docs.factor Normal file
View File

@ -0,0 +1,70 @@
USING: help.markup help.syntax words math source-files
parser quotations definitions ;
IN: compiler.units
ARTICLE: "compilation-units" "Compilation units"
"A " { $emphasis "compilation unit" } " scopes a group of related definitions. They are compiled and entered into the system in one atomic operation."
$nl
"Words defined in a compilation unit may not be called until the compilation unit is finished. The parser detects this case for parsing words and throws a " { $link staging-violation } "; calling any other word from within its own compilation unit throws an " { $link undefined } " error."
$nl
"The parser groups all definitions in a source file into one compilation unit, and parsing words do not need to concern themselves with compilation units. However, if definitions are being created at run time, a compilation unit must be created explicitly:"
{ $subsection with-compilation-unit }
"Words called to associate a definition with a source file location:"
{ $subsection remember-definition }
{ $subsection remember-class }
"Forward reference checking (see " { $link "definition-checking" } "):"
{ $subsection forward-reference? }
"A hook to be called at the end of the compilation unit. If the optimizing compiler is loaded, this compiles new words with the " { $link "compiler" } ":"
{ $subsection recompile-hook }
"Low-level compiler interface exported by the Factor VM:"
{ $subsection modify-code-heap } ;
ABOUT: "compilation-units"
HELP: redefine-error
{ $values { "definition" "a definition specifier" } }
{ $description "Throws a " { $link redefine-error } "." }
{ $error-description "Indicates that a single source file contains two definitions for the same artifact, one of which shadows the other. This is an error since it indicates a likely mistake, such as two words accidentally named the same by the developer; the error is restartable." } ;
HELP: remember-definition
{ $values { "definition" "a definition specifier" } { "loc" "a " { $snippet "{ path line# }" } " pair" } }
{ $description "Saves the location of a definition and associates this definition with the current source file."
$nl
"This is the book-keeping required to detect " { $link redefine-error } " and " { $link forward-error } "." } ;
HELP: old-definitions
{ $var-description "Stores an assoc where the keys form the set of definitions which were defined by " { $link file } " the most recent time it was loaded." } ;
HELP: new-definitions
{ $var-description "Stores an assoc where the keys form the set of definitions which were defined so far by the current parsing of " { $link file } "." } ;
HELP: forward-error
{ $values { "word" word } }
{ $description "Throws a " { $link forward-error } "." }
{ $description "Indicates a word is being referenced prior to the location of its most recent definition. This can only happen if a source file is loaded, and subsequently edited such that two dependent definitions are reversed." } ;
HELP: with-compilation-unit
{ $values { "quot" quotation } }
{ $description "Calls a quotation in a new compilation unit. The quotation can define new words and classes, as well as forget words. When the quotation returns, any changed words are recompiled, and changes are applied atomically." }
{ $notes "Compilation units may be nested."
$nl
"The parser wraps every source file in a compilation unit, so parsing words may define new words without having to perform extra work; to define new words at any other time, you must wrap your defining code with this combinator."
$nl
"Since compilation is relatively expensive, you should try to batch up as many definitions into one compilation unit as possible." } ;
HELP: recompile-hook
{ $var-description "Quotation with stack effect " { $snippet "( words -- )" } ", called at the end of " { $link with-compilation-unit } "." } ;
HELP: no-compilation-unit
{ $values { "word" word } }
{ $description "Throws a " { $link no-compilation-unit } " error." }
{ $error-description "Thrown when an attempt is made to define a word outside of a " { $link with-compilation-unit } " combinator." } ;
HELP: modify-code-heap ( alist -- )
{ $values { "alist" "an alist" } }
{ $description "Stores compiled code definitions in the code heap. The alist maps words to the following:"
{ $list
{ { $link f } " - in this case, the word is compiled with the non-optimizing compiler part of the VM." }
{ { $snippet "{ code labels rel words literals }" } " - in this case, a code heap block is allocated with the given data." }
} }
{ $notes "This word is called at the end of " { $link with-compilation-unit } "." } ;

85
core/compiler/units/units.factor Normal file
View File

@ -0,0 +1,85 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel continuations assocs namespaces sequences words
vocabs definitions hashtables ;
IN: compiler.units
SYMBOL: old-definitions
SYMBOL: new-definitions
TUPLE: redefine-error def ;
: redefine-error ( definition -- )
\ redefine-error construct-boa
{ { "Continue" t } } throw-restarts drop ;
: add-once ( key assoc -- )
2dup key? [ over redefine-error ] when dupd set-at ;
: (remember-definition) ( definition loc assoc -- )
>r over set-where r> add-once ;
: remember-definition ( definition loc -- )
new-definitions get first (remember-definition) ;
: remember-class ( class loc -- )
over new-definitions get first key? [ dup redefine-error ] when
new-definitions get second (remember-definition) ;
TUPLE: forward-error word ;
: forward-error ( word -- )
\ forward-error construct-boa throw ;
: forward-reference? ( word -- ? )
dup old-definitions get assoc-stack
[ new-definitions get assoc-stack not ]
[ drop f ] if ;
SYMBOL: recompile-hook
: <definitions> ( -- pair ) { H{ } H{ } } [ clone ] map ;
SYMBOL: definition-observers
definition-observers global [ V{ } like ] change-at
GENERIC: definitions-changed ( assoc obj -- )
: add-definition-observer ( obj -- )
definition-observers get push ;
: remove-definition-observer ( obj -- )
definition-observers get delete ;
: notify-definition-observers ( assoc -- )
definition-observers get
[ definitions-changed ] curry* each ;
: changed-vocabs ( -- assoc )
changed-words get
[ drop word-vocabulary dup [ vocab ] when dup ] assoc-map ;
: changed-definitions ( -- assoc )
H{ } clone
dup new-definitions get first update
dup new-definitions get second update
dup changed-words get update
dup changed-vocabs update ;
: finish-compilation-unit ( -- )
changed-definitions notify-definition-observers
changed-words get keys recompile-hook get call ;
: with-compilation-unit ( quot -- )
[
H{ } clone changed-words set
<definitions> new-definitions set
<definitions> old-definitions set
[ finish-compilation-unit ]
[ ] cleanup
] with-scope ; inline
recompile-hook global
[ [ [ f ] { } map>assoc modify-code-heap ] or ]
change-at

4
core/cpu/arm/bootstrap.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image.private kernel namespaces system
cpu.arm.assembler math layouts words vocabs ;
cpu.arm.assembler math layouts words compiler.units ;
IN: bootstrap.arm
! We generate ARM3 code
@ -116,4 +116,4 @@ big-endian off
[ LR BX ] { } make jit-return set
"bootstrap.arm" forget-vocab
[ "bootstrap.arm" forget-vocab ] with-compilation-unit

218
core/cpu/ppc/bootstrap.factor
View File

@ -1,109 +1,109 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image.private kernel namespaces system
cpu.ppc.assembler generator.fixup compiler.constants math
layouts words vocabs ;
IN: bootstrap.ppc
4 \ cell set
big-endian on
4 jit-code-format set
: ds-reg 14 ;
: quot-reg 3 ;
: temp-reg 6 ;
: aux-reg 11 ;
: factor-area-size 4 bootstrap-cells ;
: stack-frame
factor-area-size c-area-size + 4 bootstrap-cells align ;
: next-save stack-frame bootstrap-cell - ;
: xt-save stack-frame 2 bootstrap-cells - ;
[
! Load word
0 temp-reg LOAD32
temp-reg dup 0 LWZ
! Bump profiling counter
aux-reg temp-reg profile-count-offset LWZ
aux-reg dup 1 tag-fixnum ADDI
aux-reg temp-reg profile-count-offset STW
! Load word->code
aux-reg temp-reg word-code-offset LWZ
! Compute word XT
aux-reg dup compiled-header-size ADDI
! Jump to XT
aux-reg MTCTR
BCTR
] rc-absolute-ppc-2/2 rt-literal 1 jit-profiling jit-define
[
0 temp-reg LOAD32 ! load XT
0 MFLR ! load return address
1 1 stack-frame neg ADDI ! create stack frame
temp-reg 1 xt-save STW ! save XT
stack-frame temp-reg LI ! load frame size
temp-reg 1 next-save STW ! save frame size
0 1 lr-save stack-frame + STW ! save return address
] rc-absolute-ppc-2/2 rt-label 1 jit-prolog jit-define
[
0 temp-reg LOAD32 ! load literal
temp-reg dup 0 LWZ ! indirection
temp-reg ds-reg 4 STWU ! push literal
] rc-absolute-ppc-2/2 rt-literal 1 jit-push-literal jit-define
[
0 temp-reg LOAD32 ! load primitive address
4 1 MR ! pass stack pointer to primitive
temp-reg MTCTR ! jump to primitive
BCTR
] rc-absolute-ppc-2/2 rt-primitive 1 jit-primitive jit-define
[
0 BL
] rc-relative-ppc-3 rt-xt 0 jit-word-call jit-define
[
0 B
] rc-relative-ppc-3 rt-xt 0 jit-word-jump jit-define
: jit-call-quot ( -- )
temp-reg quot-reg quot-xt@ LWZ ! load quotation-xt
temp-reg MTCTR ! jump to quotation-xt
BCTR ;
[
0 quot-reg LOAD32 ! point quot-reg at false branch
temp-reg ds-reg 0 LWZ ! load boolean
0 temp-reg \ f tag-number CMPI ! compare it with f
2 BNE ! skip next insn if its not f
quot-reg dup 4 ADDI ! point quot-reg at true branch
quot-reg dup 0 LWZ ! load the branch
ds-reg dup 4 SUBI ! pop boolean
jit-call-quot
] rc-absolute-ppc-2/2 rt-literal 1 jit-if-jump jit-define
[
0 quot-reg LOAD32 ! load dispatch array
quot-reg dup 0 LWZ ! indirection
temp-reg ds-reg 0 LWZ ! load index
temp-reg dup 1 SRAWI ! turn it into an array offset
quot-reg dup temp-reg ADD ! compute quotation location
quot-reg dup array-start LWZ ! load quotation
ds-reg dup 4 SUBI ! pop index
jit-call-quot
] rc-absolute-ppc-2/2 rt-literal 1 jit-dispatch jit-define
[
0 1 lr-save stack-frame + LWZ ! load return address
1 1 stack-frame ADDI ! pop stack frame
0 MTLR ! get ready to return
] f f f jit-epilog jit-define
[ BLR ] f f f jit-return jit-define
"bootstrap.ppc" forget-vocab
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image.private kernel namespaces system
cpu.ppc.assembler generator.fixup compiler.constants math
layouts words vocabs ;
IN: bootstrap.ppc
4 \ cell set
big-endian on
4 jit-code-format set
: ds-reg 14 ;
: quot-reg 3 ;
: temp-reg 6 ;
: aux-reg 11 ;
: factor-area-size 4 bootstrap-cells ;
: stack-frame
factor-area-size c-area-size + 4 bootstrap-cells align ;
: next-save stack-frame bootstrap-cell - ;
: xt-save stack-frame 2 bootstrap-cells - ;
[
! Load word
0 temp-reg LOAD32
temp-reg dup 0 LWZ
! Bump profiling counter
aux-reg temp-reg profile-count-offset LWZ
aux-reg dup 1 tag-fixnum ADDI
aux-reg temp-reg profile-count-offset STW
! Load word->code
aux-reg temp-reg word-code-offset LWZ
! Compute word XT
aux-reg dup compiled-header-size ADDI
! Jump to XT
aux-reg MTCTR
BCTR
] rc-absolute-ppc-2/2 rt-literal 1 jit-profiling jit-define
[
0 temp-reg LOAD32 ! load XT
0 MFLR ! load return address
1 1 stack-frame neg ADDI ! create stack frame
temp-reg 1 xt-save STW ! save XT
stack-frame temp-reg LI ! load frame size
temp-reg 1 next-save STW ! save frame size
0 1 lr-save stack-frame + STW ! save return address
] rc-absolute-ppc-2/2 rt-label 1 jit-prolog jit-define
[
0 temp-reg LOAD32 ! load literal
temp-reg dup 0 LWZ ! indirection
temp-reg ds-reg 4 STWU ! push literal
] rc-absolute-ppc-2/2 rt-literal 1 jit-push-literal jit-define
[
0 temp-reg LOAD32 ! load primitive address
4 1 MR ! pass stack pointer to primitive
temp-reg MTCTR ! jump to primitive
BCTR
] rc-absolute-ppc-2/2 rt-primitive 1 jit-primitive jit-define
[
0 BL
] rc-relative-ppc-3 rt-xt 0 jit-word-call jit-define
[
0 B
] rc-relative-ppc-3 rt-xt 0 jit-word-jump jit-define
: jit-call-quot ( -- )
temp-reg quot-reg quot-xt@ LWZ ! load quotation-xt
temp-reg MTCTR ! jump to quotation-xt
BCTR ;
[
0 quot-reg LOAD32 ! point quot-reg at false branch
temp-reg ds-reg 0 LWZ ! load boolean
0 temp-reg \ f tag-number CMPI ! compare it with f
2 BNE ! skip next insn if its not f
quot-reg dup 4 ADDI ! point quot-reg at true branch
quot-reg dup 0 LWZ ! load the branch
ds-reg dup 4 SUBI ! pop boolean
jit-call-quot
] rc-absolute-ppc-2/2 rt-literal 1 jit-if-jump jit-define
[
0 quot-reg LOAD32 ! load dispatch array
quot-reg dup 0 LWZ ! indirection
temp-reg ds-reg 0 LWZ ! load index
temp-reg dup 1 SRAWI ! turn it into an array offset
quot-reg dup temp-reg ADD ! compute quotation location
quot-reg dup array-start LWZ ! load quotation
ds-reg dup 4 SUBI ! pop index
jit-call-quot
] rc-absolute-ppc-2/2 rt-literal 1 jit-dispatch jit-define
[
0 1 lr-save stack-frame + LWZ ! load return address
1 1 stack-frame ADDI ! pop stack frame
0 MTLR ! get ready to return
] f f f jit-epilog jit-define
[ BLR ] f f f jit-return jit-define
[ "bootstrap.ppc" forget-vocab ] with-compilation-unit

4
core/cpu/x86/bootstrap.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image.private kernel namespaces system
cpu.x86.assembler layouts vocabs math generator.fixup
cpu.x86.assembler layouts compiler.units math generator.fixup
compiler.constants ;
IN: bootstrap.x86
@ -75,4 +75,4 @@ big-endian off
[ 0 RET ] f f f jit-return jit-define
"bootstrap.x86" forget-vocab
[ "bootstrap.x86" forget-vocab ] with-compilation-unit

8
core/debugger/debugger.factor
View File

@ -4,7 +4,7 @@ USING: arrays definitions generic hashtables inspector io kernel
math namespaces prettyprint sequences assocs sequences.private
strings io.styles vectors words system splitting math.parser
tuples continuations continuations.private combinators
generic.math io.streams.duplex classes
generic.math io.streams.duplex classes compiler.units
generic.standard ;
IN: debugger
@ -228,5 +228,7 @@ M: forward-error error.
M: undefined summary
drop "Calling a deferred word before it has been defined" ;
M: no-compilation-unit summary
drop "Defining a word outside of a compilation unit" ;
M: no-compilation-unit error.
"Attempting to define " write
no-compilation-unit-word pprint
" outside of a compilation unit" print ;

56
core/definitions/definitions-docs.factor
View File

@ -1,5 +1,5 @@
USING: help.markup help.syntax words math source-files
parser quotations ;
parser quotations compiler.units ;
IN: definitions
ARTICLE: "definition-protocol" "Definition protocol"
@ -59,21 +59,6 @@ $nl
"The parser also catches duplicate definitions. If an artifact is defined twice in the same source file, the earlier definition will never be accessible, and this is almost always a mistake, perhaps due to a bad choice of word names, or a copy and paste error. The parser raises an error in this case."
{ $subsection redefine-error } ;
ARTICLE: "compilation-units" "Compilation units"
"A " { $emphasis "compilation unit" } " scopes a group of related definitions. They are compiled and entered into the system in one atomic operation."
$nl
"Words defined in a compilation unit may not be called until the compilation unit is finished. The parser detects this case for parsing words and throws a " { $link staging-violation } "; calling any other word from within its own compilation unit throws an " { $link undefined } " error."
$nl
"The parser groups all definitions in a source file into one compilation unit, and parsing words do not need to concern themselves with compilation units. However, if definitions are being created at run time, a compilation unit must be created explicitly:"
{ $subsection with-compilation-unit }
"Words called to associate a definition with a source file location:"
{ $subsection remember-definition }
{ $subsection remember-class }
"Forward reference checking (see " { $link "definition-checking" } "):"
{ $subsection forward-reference? }
"A hook to be called at the end of the compilation unit. If the optimizing compiler is loaded, this compiles new words with the " { $link "compiler" } ":"
{ $subsection recompile-hook } ;
ARTICLE: "definitions" "Definitions"
"A " { $emphasis "definition" } " is an artifact read from a source file. This includes words, methods, and help articles. Words for working with definitions are found in the " { $vocab-link "definitions" } " vocabulary. Implementations of the definition protocol include pathnames, words, methods, and help articles."
{ $subsection "definition-protocol" }
@ -140,42 +125,3 @@ HELP: delete-xref
{ $description "Remove the vertex which represents the definition from the " { $link crossref } " graph." }
{ $notes "This word is called before a word is forgotten." }
{ $see-also forget } ;
HELP: redefine-error
{ $values { "definition" "a definition specifier" } }
{ $description "Throws a " { $link redefine-error } "." }
{ $error-description "Indicates that a single source file contains two definitions for the same artifact, one of which shadows the other. This is an error since it indicates a likely mistake, such as two words accidentally named the same by the developer; the error is restartable." } ;
HELP: remember-definition
{ $values { "definition" "a definition specifier" } { "loc" "a " { $snippet "{ path line# }" } " pair" } }
{ $description "Saves the location of a definition and associates this definition with the current source file."
$nl
"This is the book-keeping required to detect " { $link redefine-error } " and " { $link forward-error } "." } ;
HELP: old-definitions
{ $var-description "Stores an assoc where the keys form the set of definitions which were defined by " { $link file } " the most recent time it was loaded." } ;
HELP: new-definitions
{ $var-description "Stores an assoc where the keys form the set of definitions which were defined so far by the current parsing of " { $link file } "." } ;
HELP: forward-error
{ $values { "word" word } }
{ $description "Throws a " { $link forward-error } "." }
{ $description "Indicates a word is being referenced prior to the location of its most recent definition. This can only happen if a source file is loaded, and subsequently edited such that two dependent definitions are reversed." } ;
HELP: with-compilation-unit
{ $values { "quot" quotation } }
{ $description "Calls a quotation in a new compilation unit. The quotation can define new words and classes, as well as forget words. When the quotation returns, any changed words are recompiled, and changes are applied atomically." }
{ $notes "Compilation units may be nested."
$nl
"The parser wraps every source file in a compilation unit, so parsing words may define new words without having to perform extra work; to define new words at any other time, you must wrap your defining code with this combinator."
$nl
"Since compilation is relatively expensive, you should try to batch up as many definitions into one compilation unit as possible." } ;
HELP: recompile-hook
{ $var-description "Quotation with stack effect " { $snippet "( words -- )" } ", called at the end of " { $link with-compilation-unit } "." } ;
HELP: no-compilation-unit
{ $values { "word" word } }
{ $description "Throws a " { $link no-compilation-unit } " error." }
{ $error-description "Thrown when an attempt is made to define a word outside of a " { $link with-compilation-unit } " combinator." } ;

62
core/definitions/definitions.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2006, 2007 Slava Pestov.
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: definitions
USING: kernel sequences namespaces assocs graphs continuations ;
USING: kernel sequences namespaces assocs graphs ;
GENERIC: where ( defspec -- loc )
@ -43,61 +43,3 @@ M: object redefined* drop ;
: delete-xref ( defspec -- )
dup unxref crossref get delete-at ;
GENERIC: update-methods ( class -- )
SYMBOL: changed-words
SYMBOL: old-definitions
SYMBOL: new-definitions
TUPLE: redefine-error def ;
: redefine-error ( definition -- )
\ redefine-error construct-boa
{ { "Continue" t } } throw-restarts drop ;
: add-once ( key assoc -- )
2dup key? [ over redefine-error ] when dupd set-at ;
: (remember-definition) ( definition loc assoc -- )
>r over set-where r> add-once ;
: remember-definition ( definition loc -- )
new-definitions get first (remember-definition) ;
: remember-class ( class loc -- )
over new-definitions get first key? [ dup redefine-error ] when
new-definitions get second (remember-definition) ;
TUPLE: forward-error word ;
: forward-error ( word -- )
\ forward-error construct-boa throw ;
: forward-reference? ( word -- ? )
dup old-definitions get assoc-stack
[ new-definitions get assoc-stack not ]
[ drop f ] if ;
SYMBOL: recompile-hook
: <definitions> ( -- pair ) { H{ } H{ } } [ clone ] map ;
TUPLE: no-compilation-unit word ;
: no-compilation-unit ( word -- * )
\ no-compilation-unit construct-boa throw ;
: changed-word ( word -- )
dup changed-words get
[ no-compilation-unit ] unless*
set-at ;
: with-compilation-unit ( quot -- )
[
H{ } clone changed-words set
<definitions> new-definitions set
<definitions> old-definitions set
[ changed-words get keys recompile-hook get call ]
[ ] cleanup
] with-scope ; inline

11
core/listener/listener-tests.factor
View File

@ -1,5 +1,6 @@
USING: io io.streams.string io.streams.duplex listener
tools.test parser math namespaces continuations vocabs kernel ;
tools.test parser math namespaces continuations vocabs kernel
compiler.units ;
IN: temporary
: hello "Hi" print ; parsing
@ -28,7 +29,9 @@ IN: temporary
] with-file-vocabs
[ ] [
"vocabs.loader.test.c" forget-vocab
[
"vocabs.loader.test.c" forget-vocab
] with-compilation-unit
] unit-test
[
@ -36,7 +39,9 @@ IN: temporary
] unit-test-fails
[ ] [
"vocabs.loader.test.c" forget-vocab
[
"vocabs.loader.test.c" forget-vocab
] with-compilation-unit
] unit-test
[ ] [

2
core/listener/listener.factor
View File

@ -3,7 +3,7 @@
USING: arrays hashtables io kernel math memory namespaces
parser sequences strings io.styles io.streams.lines
io.streams.duplex vectors words generic system combinators
tuples continuations debugger definitions ;
tuples continuations debugger definitions compiler.units ;
IN: listener
SYMBOL: quit-flag

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

@ -1,7 +1,7 @@
USING: help.markup help.syntax kernel sequences words
math strings vectors quotations generic effects classes
vocabs.loader definitions io vocabs source-files
quotations namespaces ;
quotations namespaces compiler.units ;
IN: parser
ARTICLE: "vocabulary-search-shadow" "Shadowing word names"

2
core/parser/parser.factor
View File

@ -5,7 +5,7 @@ namespaces prettyprint sequences strings vectors words
quotations inspector io.styles io combinators sorting
splitting math.parser effects continuations debugger
io.files io.streams.string io.streams.lines vocabs
source-files classes hashtables compiler.errors ;
source-files classes hashtables compiler.errors compiler.units ;
IN: parser
TUPLE: lexer text line column ;

2
core/source-files/source-files-docs.factor
View File

@ -1,5 +1,5 @@
USING: help.markup help.syntax vocabs.loader io.files strings
definitions quotations ;
definitions quotations compiler.units ;
IN: source-files
ARTICLE: "source-files" "Source files"

2
core/source-files/source-files.factor
View File

@ -5,7 +5,7 @@ namespaces prettyprint sequences strings vectors words
quotations inspector io.styles io combinators sorting
splitting math.parser effects continuations debugger
io.files io.crc32 io.streams.string io.streams.lines vocabs
hashtables graphs ;
hashtables graphs compiler.units ;
IN: source-files
SYMBOL: source-files

3
core/syntax/syntax.factor
View File

@ -4,7 +4,8 @@ USING: alien arrays bit-arrays byte-arrays definitions generic
hashtables kernel math namespaces parser sequences strings sbufs
vectors words quotations io assocs splitting tuples
generic.standard generic.math classes io.files vocabs
float-arrays classes.union classes.mixin classes.predicate ;
float-arrays classes.union classes.mixin classes.predicate
compiler.units ;
IN: bootstrap.syntax
! These words are defined as a top-level form, instead of with

2
core/tuples/tuples-docs.factor
View File

@ -1,6 +1,6 @@
USING: generic help.markup help.syntax kernel
tuples.private classes slots quotations words arrays
generic.standard sequences definitions ;
generic.standard sequences definitions compiler.units ;
IN: tuples
ARTICLE: "tuple-constructors" "Constructors and slots"

22
core/vocabs/loader/loader-tests.factor
View File

@ -7,7 +7,9 @@ debugger ;
! This vocab should not exist, but just in case...
[ ] [
"vocabs.loader.test" forget-vocab
[
"vocabs.loader.test" forget-vocab
] with-compilation-unit
] unit-test
[ T{ vocab-link f "vocabs.loader.test" } ]
@ -17,7 +19,7 @@ debugger ;
[ "kernel" f >vocab-link "kernel" vocab = ] unit-test
! This vocab should not exist, but just in case...
[ ] [ "core" forget-vocab ] unit-test
[ ] [ [ "core" forget-vocab ] with-compilation-unit ] unit-test
2 [
[ T{ no-vocab f "core" } ]
@ -50,7 +52,7 @@ IN: temporary
"resource:core/vocabs/loader/test/a/a.factor" forget-source
"vocabs.loader.test.a" forget-vocab
[ "vocabs.loader.test.a" forget-vocab ] with-compilation-unit
0 "count-me" set-global
@ -81,7 +83,9 @@ IN: temporary
0 "count-me" set-global
[ ] [
"vocabs.loader.test.b" forget-vocab
[
"vocabs.loader.test.b" forget-vocab
] with-compilation-unit
] unit-test
[ ] [
@ -125,8 +129,12 @@ IN: temporary
] unit-test
: forget-junk
{ "2" "a" "b" "d" "e" "f" }
[ "vocabs.loader.test." swap append forget-vocab ] each ;
[
{ "2" "a" "b" "d" "e" "f" }
[
"vocabs.loader.test." swap append forget-vocab
] each
] with-compilation-unit ;
forget-junk
@ -134,6 +142,6 @@ forget-junk
"IN: xabbabbja" eval "xabbabbja" vocab-files
] unit-test
"xabbabbja" forget-vocab
[ "xabbabbja" forget-vocab ] with-compilation-unit
forget-junk

5
core/vocabs/vocabs-docs.factor
View File

@ -1,4 +1,4 @@
USING: help.markup help.syntax strings words ;
USING: help.markup help.syntax strings words compiler.units ;
IN: vocabs
ARTICLE: "vocabularies" "Vocabularies"
@ -76,7 +76,8 @@ HELP: all-words
HELP: forget-vocab
{ $values { "vocab" string } }
{ $description "Removes a vocabulary. All words in the vocabulary become uninterned." } ;
{ $description "Removes a vocabulary. All words in the vocabulary become uninterned." }
{ $notes "This word must be called from inside " { $link with-compilation-unit } "." } ;
HELP: load-vocab-hook
{ $var-description "a quotation with stack effect " { $snippet "( name -- vocab )" } " which loads a vocabulary. This quotation is called by " { $link load-vocab } ". The default value should not need to be changed; this functinality is implemented via a hook stored in a variable to break a circular dependency which would otherwise exist from " { $vocab-link "vocabs" } " to " { $vocab-link "vocabs.loader" } " to " { $vocab-link "parser" } " back to " { $vocab-link "vocabs" } "." } ;

7
core/vocabs/vocabs.factor
View File

@ -12,6 +12,8 @@ words
main help
source-loaded? docs-loaded? ;
M: vocab equal? 2drop f ;
: <vocab> ( name -- vocab )
H{ } clone t
{ set-vocab-name set-vocab-words set-vocab-source-loaded? }
@ -91,9 +93,8 @@ M: vocab-link vocab-name vocab-link-name ;
UNION: vocab-spec vocab vocab-link ;
M: vocab-spec forget
: forget-vocab ( vocab -- )
dup vocab-words values forget-all
vocab-name dictionary get delete-at ;
: forget-vocab ( vocab -- )
[ f >vocab-link forget ] with-compilation-unit ;
M: vocab-spec forget forget-vocab ;

15
core/words/words-docs.factor
View File

@ -1,6 +1,6 @@
USING: definitions help.markup help.syntax kernel
kernel.private parser words.private vocabs classes quotations
strings effects ;
strings effects compiler.units ;
IN: words
ARTICLE: "interned-words" "Looking up and creating words"
@ -165,9 +165,7 @@ ARTICLE: "word.private" "Word implementation details"
{ $subsection word-def }
{ $subsection set-word-def }
"An " { $emphasis "XT" } " (execution token) is the machine code address of a word:"
{ $subsection word-xt }
"Low-level compiler interface exported by the Factor VM:"
{ $subsection modify-code-heap } ;
{ $subsection word-xt } ;
ARTICLE: "words" "Words"
"Words are the Factor equivalent of functions or procedures; a word is essentially a named quotation."
@ -402,12 +400,3 @@ HELP: define-inline
{ $values { "word" word } { "quot" quotation } }
{ $description "Defines a word and makes it " { $link POSTPONE: inline } "." }
{ $side-effects "word" } ;
HELP: modify-code-heap ( alist -- )
{ $values { "alist" "an alist" } }
{ $description "Stores compiled code definitions in the code heap. The alist maps words to the following:"
{ $list
{ { $link f } " - in this case, the word is compiled with the non-optimizing compiler part of the VM." }
{ { $snippet "{ code labels rel words literals }" } " - in this case, a code heap block is allocated with the given data." }
} }
{ $notes "This word is called at the end of " { $link with-compilation-unit } "." } ;

16
core/words/words.factor
View File

@ -90,6 +90,18 @@ M: word uses ( word -- seq )
M: word redefined* ( word -- )
{ "inferred-effect" "base-case" "no-effect" } reset-props ;
SYMBOL: changed-words
TUPLE: no-compilation-unit word ;
: no-compilation-unit ( word -- * )
\ no-compilation-unit construct-boa throw ;
: changed-word ( word -- )
dup changed-words get
[ no-compilation-unit ] unless*
set-at ;
: define ( word def -- )
[ ] like
over unxref
@ -192,7 +204,3 @@ M: word literalize <wrapper> ;
: ?word-name dup word? [ word-name ] when ;
: xref-words ( -- ) all-words [ xref ] each ;
recompile-hook global
[ [ [ f ] { } map>assoc modify-code-heap ] or ]
change-at

2
extra/cocoa/cocoa.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: compiler io kernel cocoa.runtime cocoa.subclassing
cocoa.messages cocoa.types sequences words vocabs parser
core-foundation namespaces assocs hashtables definitions ;
core-foundation namespaces assocs hashtables compiler.units ;
IN: cocoa
: (remember-send) ( selector variable -- )

4
extra/cocoa/subclassing/subclassing.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2006, 2007 Slava Pestov
! Copyright (C) 2006, 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types arrays assocs combinators compiler
hashtables kernel libc math namespaces parser sequences words
cocoa.messages cocoa.runtime definitions ;
cocoa.messages cocoa.runtime compiler.units ;
IN: cocoa.subclassing
: init-method ( method alien -- )

2
extra/help/syntax/syntax.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel parser sequences words help help.topics
namespaces vocabs definitions ;
namespaces vocabs definitions compiler.units ;
IN: help.syntax
: HELP:

5
extra/models/models.factor
View File

@ -70,6 +70,9 @@ GENERIC: update-model ( model -- )
M: model update-model drop ;
: notify-connections ( model -- )
dup model-connections [ model-changed ] curry* each ;
: set-model ( value model -- )
dup model-locked? [
2drop
@ -77,7 +80,7 @@ M: model update-model drop ;
dup [
[ set-model-value ] keep
[ update-model ] keep
dup model-connections [ model-changed ] curry* each
notify-connections
] with-locked-model
] if ;

2
extra/tools/annotations/annotations.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel words parser io inspector quotations sequences
prettyprint continuations effects definitions ;
prettyprint continuations effects definitions compiler.units ;
IN: tools.annotations
: reset ( word -- )

4
extra/tools/deploy/macosx/macosx.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: io io.files io.launcher kernel namespaces sequences
system tools.deploy.backend tools.deploy.config assocs
hashtables prettyprint io.unix.backend cocoa cocoa.plists
hashtables prettyprint io.unix.backend cocoa
cocoa.application cocoa.classes qualified ;
QUALIFIED: unix
IN: tools.deploy.macosx
@ -43,7 +43,7 @@ IN: tools.deploy.macosx
dup "CFBundleExecutable" set
"org.factor." swap append "CFBundleIdentifier" set
] H{ } make-assoc print-plist ;
] H{ } make-assoc drop ; ! print-plist ;
: create-app-plist ( vocab bundle-name -- )
dup "Contents/Info.plist" path+ <file-writer>

24
extra/ui/tools/browser/browser.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2006, 2007 Slava Pestov.
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: debugger ui.tools.workspace help help.topics kernel
models ui.commands ui.gadgets ui.gadgets.panes
ui.gadgets.scrollers ui.gadgets.tracks ui.gestures
ui.gadgets.buttons ;
ui.gadgets.buttons compiler.units assocs words ;
IN: ui.tools.browser
TUPLE: browser-gadget pane history ;
@ -17,7 +17,7 @@ TUPLE: browser-gadget pane history ;
[ [ dup help ] try drop ] <pane-control> ;
: init-history ( browser-gadget -- )
"handbook" <history>
"handbook" >link <history>
swap set-browser-gadget-history ;
: <browser-gadget> ( -- gadget )
@ -33,6 +33,24 @@ M: browser-gadget call-tool* show-help ;
M: browser-gadget tool-scroller
browser-gadget-pane find-scroller ;
M: browser-gadget graft*
dup add-definition-observer
delegate graft* ;
M: browser-gadget ungraft*
dup delegate ungraft*
remove-definition-observer ;
: showing-definition? ( defspec assoc -- ? )
2dup key? >r
>r dup word-link? [ link-name ] when r> key?
r> or ;
M: browser-gadget definitions-changed ( assoc browser -- )
browser-gadget-history
dup model-value rot showing-definition?
[ notify-connections ] [ drop ] if ;
: help-action ( browser-gadget -- link )
browser-gadget-history model-value >link ;

2
extra/ui/tools/operations/operations.factor
View File

@ -8,7 +8,7 @@ namespaces parser prettyprint quotations tools.annotations
editors tools.profiler tools.test tools.time tools.interpreter
ui.commands ui.gadgets.editors ui.gestures ui.operations
ui.tools.deploy vocabs vocabs.loader words sequences
tools.browser classes ;
tools.browser classes compiler.units ;
IN: ui.tools.operations
V{ } clone operations set-global