Memory leak and markup fixes

darcs
slava 2006-06-10 04:53:29 +00:00
parent 60abfc1d58
commit 4ce62a2a13
5 changed files with 30 additions and 21 deletions

View File

@ -20,8 +20,9 @@ USING: hashtables kernel namespaces sequences ;
: (remove-vertex) ( vertex graph -- ) nest remove-hash ;
: remove-vertex ( vertex edges graph -- )
[ dupd call [ nest remove-hash ] each-with ] if-graph ;
inline
[
dupd call [ namespace hash ?remove-hash ] each-with
] if-graph ; inline
: in-edges ( vertex graph -- seq )
?hash dup [ hash-keys ] when ;

View File

@ -139,6 +139,9 @@ IN: hashtables
: remove-hash* ( key hash -- oldvalue )
[ hash ] 2keep remove-hash ;
: ?remove-hash ( key hash -- )
[ remove-hash ] [ drop ] if* ;
: hash-size ( hash -- n )
dup hash-count swap hash-deleted - ; inline

View File

@ -161,10 +161,16 @@ M: generic definer drop \ G: ;
tuck [ class< ] all-with? [ peek ] [ drop f ] if
] if ;
: class-forget-hook ( class flattened -- )
[ typemap get remove-hash ] curry
"forget-hook" set-word-prop ;
: define-class ( class -- )
dup t "class" set-word-prop
dup H{ } clone "class<" set-word-prop
dup flatten-class typemap get set-hash ;
dup flatten-class
2dup class-forget-hook
typemap get set-hash ;
: implementors ( class -- list )
[ "methods" word-prop ?hash* nip ] word-subset-with ;

View File

@ -23,8 +23,11 @@ M: word print-element { } swap execute ;
: ($span) ( content style -- )
last-block off [ print-element ] with-style ;
: ?terpri ( -- )
last-block [ [ terpri ] unless t ] change ;
: ($block) ( quot -- )
last-block [ [ terpri ] unless t ] change
?terpri
call
terpri
last-block on ; inline
@ -140,13 +143,8 @@ M: f >link <link> ;
] ($block) ;
: $link ( article -- )
last-block off first dup word? [
pprint
] [
link-style [
dup article-title swap >link simple-object
] with-style
] if ;
last-block off first link-style
[ dup article-title swap >link simple-object ] with-style ;
: $definition ( content -- )
"Definition" $heading $see ;
@ -158,11 +156,9 @@ M: f >link <link> ;
"See also" $heading $links ;
: $table ( content -- )
[
table-style [
current-style [ print-element ] tabular-output
] with-style
] ($block) ;
?terpri table-style [
current-style [ print-element ] tabular-output
] with-style ;
: $values ( content -- )
"Arguments and values" $heading

View File

@ -40,14 +40,16 @@ GENERIC: set-word-xt
M: word set-word-xt ( xt w -- ) 7 set-integer-slot ;
: uses ( word -- uses )
word-def flatten [ word? ] subset prune ;
word-def flatten
[ word? ] subset
[ word-vocabulary ] subset
prune ;
SYMBOL: crossref
: xref-word ( word -- )
dup word-vocabulary [
[ uses [ word-vocabulary ] subset ]
crossref get add-vertex
[ uses ] crossref get add-vertex
] [
drop
] if ;
@ -89,7 +91,7 @@ M: word unxref-word* drop ;
: <word> ( name vocab -- word ) (word) dup init-word ;
: gensym ( -- word )
[ "G:" % \ gensym counter # ] "" make f <word> ;
"G:" \ gensym counter number>string append f <word> ;
: define-temp ( quot -- word )
gensym [ swap define-compound ] keep ;
@ -144,11 +146,12 @@ SYMBOL: vocabularies
: forget ( word -- )
dup unxref-word
dup "forget-hook" word-prop call
crossref get [ dupd remove-hash ] when*
dup word-name swap word-vocabulary vocab remove-hash ;
: forget-vocab ( vocab -- )
vocabularies get remove-hash xref-words ;
words [ forget ] each ;
: target-word ( word -- word )
dup word-name swap word-vocabulary lookup ;