Notify definition-observers when words are forgotten

db4
Slava Pestov 2008-01-09 17:51:55 -04:00
parent 487abce510
commit ed29e2e5aa
13 changed files with 46 additions and 22 deletions

View File

@ -5,7 +5,7 @@ USING: alien arrays byte-arrays generic hashtables
hashtables.private io kernel math namespaces parser sequences hashtables.private io kernel math namespaces parser sequences
strings vectors words quotations assocs layouts classes tuples strings vectors words quotations assocs layouts classes tuples
kernel.private vocabs vocabs.loader source-files definitions kernel.private vocabs vocabs.loader source-files definitions
slots classes.union words.private ; slots classes.union words.private compiler.units ;
! Some very tricky code creating a bootstrap embryo in the ! Some very tricky code creating a bootstrap embryo in the
! host image. ! host image.

View File

@ -80,5 +80,5 @@ IN: bootstrap.stage2
"output-image" get resource-path save-image-and-exit "output-image" get resource-path save-image-and-exit
] if ] if
] [ ] [
error-hook get call "listener" vocab-main execute error. :c "listener" vocab-main execute
] recover ] recover

View File

@ -68,7 +68,7 @@ M: mixin-instance definer drop \ INSTANCE: f ;
M: mixin-instance definition drop f ; M: mixin-instance definition drop f ;
M: mixin-instance forget M: mixin-instance forget*
dup mixin-instance-class dup mixin-instance-class
swap mixin-instance-mixin dup mixin-class? swap mixin-instance-mixin dup mixin-class?
[ remove-mixin-instance ] [ 2drop ] if ; [ remove-mixin-instance ] [ 2drop ] if ;

View File

@ -56,16 +56,17 @@ GENERIC: definitions-changed ( assoc obj -- )
definition-observers get definition-observers get
[ definitions-changed ] curry* each ; [ definitions-changed ] curry* each ;
: changed-vocabs ( -- assoc ) : changed-vocabs ( assoc -- vocabs )
changed-words get [ drop word? ] assoc-subset
[ drop word-vocabulary dup [ vocab ] when dup ] assoc-map ; [ drop word-vocabulary dup [ vocab ] when dup ] assoc-map ;
: changed-definitions ( -- assoc ) : changed-definitions ( -- assoc )
H{ } clone H{ } clone
dup forgotten-definitions get update
dup new-definitions get first update dup new-definitions get first update
dup new-definitions get second update dup new-definitions get second update
dup changed-words get update dup changed-words get update
dup changed-vocabs update ; dup dup changed-vocabs update ;
: finish-compilation-unit ( -- ) : finish-compilation-unit ( -- )
changed-words get keys recompile-hook get call changed-words get keys recompile-hook get call
@ -74,6 +75,7 @@ GENERIC: definitions-changed ( assoc obj -- )
: with-compilation-unit ( quot -- ) : with-compilation-unit ( quot -- )
[ [
H{ } clone changed-words set H{ } clone changed-words set
H{ } clone forgotten-definitions set
<definitions> new-definitions set <definitions> new-definitions set
<definitions> old-definitions set <definitions> old-definitions set
[ finish-compilation-unit ] [ finish-compilation-unit ]

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image.private kernel namespaces system USING: bootstrap.image.private kernel namespaces system
cpu.x86.assembler layouts compiler.units math generator.fixup cpu.x86.assembler layouts compiler.units math generator.fixup
compiler.constants ; compiler.constants vocabs ;
IN: bootstrap.x86 IN: bootstrap.x86
big-endian off big-endian off

View File

@ -230,5 +230,5 @@ M: undefined summary
M: no-compilation-unit error. M: no-compilation-unit error.
"Attempting to define " write "Attempting to define " write
no-compilation-unit-word pprint no-compilation-unit-definition pprint
" outside of a compilation unit" print ; " outside of a compilation unit" print ;

View File

@ -3,15 +3,29 @@
IN: definitions IN: definitions
USING: kernel sequences namespaces assocs graphs ; USING: kernel sequences namespaces assocs graphs ;
TUPLE: no-compilation-unit definition ;
: no-compilation-unit ( definition -- * )
\ no-compilation-unit construct-boa throw ;
GENERIC: where ( defspec -- loc ) GENERIC: where ( defspec -- loc )
M: object where drop f ; M: object where drop f ;
GENERIC: set-where ( loc defspec -- ) GENERIC: set-where ( loc defspec -- )
GENERIC: forget ( defspec -- ) GENERIC: forget* ( defspec -- )
M: object forget drop ; M: object forget* drop ;
SYMBOL: forgotten-definitions
: forgotten-definition ( defspec -- )
dup forgotten-definitions get
[ no-compilation-unit ] unless*
set-at ;
: forget ( defspec -- ) dup forgotten-definition forget* ;
: forget-all ( definitions -- ) [ forget ] each ; : forget-all ( definitions -- ) [ forget ] each ;

View File

@ -85,7 +85,7 @@ M: method-spec definer drop \ M: \ ; ;
M: method-spec definition first2 method method-def ; M: method-spec definition first2 method method-def ;
M: method-spec forget first2 [ delete-at ] with-methods ; M: method-spec forget* first2 [ delete-at ] with-methods ;
: implementors* ( classes -- words ) : implementors* ( classes -- words )
all-words [ all-words [
@ -99,7 +99,7 @@ M: method-spec forget first2 [ delete-at ] with-methods ;
: forget-methods ( class -- ) : forget-methods ( class -- )
[ implementors ] keep [ swap 2array ] curry map forget-all ; [ implementors ] keep [ swap 2array ] curry map forget-all ;
M: class forget ( class -- ) M: class forget* ( class -- )
dup forget-methods dup forget-methods
dup uncache-class dup uncache-class
forget-word ; forget-word ;

View File

@ -73,7 +73,7 @@ uses definitions ;
M: pathname where pathname-string 1 2array ; M: pathname where pathname-string 1 2array ;
M: pathname forget M: pathname forget*
pathname-string pathname-string
dup source-file dup source-file
dup unxref-source dup unxref-source

View File

@ -105,4 +105,4 @@ UNION: vocab-spec vocab vocab-link ;
dup vocab-words values forget-all dup vocab-words values forget-all
vocab-name dictionary get delete-at ; vocab-name dictionary get delete-at ;
M: vocab-spec forget forget-vocab ; M: vocab-spec forget* forget-vocab ;

View File

@ -92,11 +92,6 @@ M: word redefined* ( word -- )
SYMBOL: changed-words SYMBOL: changed-words
TUPLE: no-compilation-unit word ;
: no-compilation-unit ( word -- * )
\ no-compilation-unit construct-boa throw ;
: changed-word ( word -- ) : changed-word ( word -- )
dup changed-words get dup changed-words get
[ no-compilation-unit ] unless* [ no-compilation-unit ] unless*
@ -194,7 +189,7 @@ M: word (forget-word)
dup delete-xref dup delete-xref
(forget-word) ; (forget-word) ;
M: word forget forget-word ; M: word forget* forget-word ;
M: word hashcode* M: word hashcode*
nip 1 slot { fixnum } declare ; nip 1 slot { fixnum } declare ;

View File

@ -12,7 +12,7 @@ M: link where link-name article article-loc ;
M: link set-where link-name article set-article-loc ; M: link set-where link-name article set-article-loc ;
M: link forget link-name remove-article ; M: link forget* link-name remove-article ;
M: link definition article-content ; M: link definition article-content ;
@ -34,4 +34,4 @@ M: word-link synopsis*
link-name dup pprint-word link-name dup pprint-word
stack-effect. ; stack-effect. ;
M: word-link forget link-name remove-word-help ; M: word-link forget* link-name remove-word-help ;

13
extra/sudoku/deploy.factor Executable file
View File

@ -0,0 +1,13 @@
USING: tools.deploy.config ;
H{
{ deploy-reflection 2 }
{ deploy-word-props? f }
{ deploy-compiler? t }
{ deploy-math? f }
{ deploy-c-types? f }
{ deploy-io 2 }
{ deploy-ui? f }
{ deploy-name "Sudoku" }
{ "stop-after-last-window?" t }
{ deploy-word-defs? f }
}