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
strings vectors words quotations assocs layouts classes tuples
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
! host image.

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -3,15 +3,29 @@
IN: definitions
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 )
M: object where drop f ;
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 ;

View File

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

View File

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

View File

@ -105,4 +105,4 @@ UNION: vocab-spec vocab vocab-link ;
dup vocab-words values forget-all
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
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*
@ -194,7 +189,7 @@ M: word (forget-word)
dup delete-xref
(forget-word) ;
M: word forget forget-word ;
M: word forget* forget-word ;
M: word hashcode*
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 forget link-name remove-article ;
M: link forget* link-name remove-article ;
M: link definition article-content ;
@ -34,4 +34,4 @@ M: word-link synopsis*
link-name dup pprint-word
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 }
}