]> gitweb.factorcode.org Git - factor.git/commitdiff
compiler: more use of hash-sets.
authorJohn Benediktsson <mrjbq7@gmail.com>
Sun, 10 Mar 2013 23:12:40 +0000 (16:12 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Sun, 10 Mar 2013 23:13:31 +0000 (16:13 -0700)
basis/compiler/compiler.factor
basis/compiler/crossref/crossref.factor
core/compiler/units/units.factor
core/definitions/definitions.factor
core/generic/generic.factor
core/parser/parser.factor
core/words/words.factor

index 2a9ec48e0ec793b499c93b875c30c9efe4998947..7d0678218375ac27e5519a1018ae4e8239a7b4a2 100644 (file)
@@ -4,6 +4,7 @@ USING: accessors kernel namespaces arrays sequences io words fry
 continuations vocabs assocs definitions math graphs generic
 generic.single combinators macros make source-files.errors
 combinators.short-circuit classes.algebra vocabs.loader
+sets
 
 stack-checker stack-checker.dependencies stack-checker.inlining
 stack-checker.errors
@@ -149,10 +150,10 @@ SINGLETON: optimizing-compiler
 M: optimizing-compiler update-call-sites ( class generic -- words )
     #! Words containing call sites with inferred type 'class'
     #! which inlined a method on 'generic'
-    generic-call-sites-of swap '[
-        nip _ 2dup [ valid-classoid? ] both?
+    generic-call-sites-of keys swap '[
+        _ 2dup [ valid-classoid? ] both?
         [ classes-intersect? ] [ 2drop f ] if
-    ] assoc-filter keys ;
+    ] filter ;
 
 M: optimizing-compiler recompile ( words -- alist )
     H{ } clone compiled [
@@ -164,10 +165,16 @@ M: optimizing-compiler recompile ( words -- alist )
 
 M: optimizing-compiler to-recompile ( -- words )
     [
-        changed-effects get new-words get assoc-diff outdated-effect-usages %
-        changed-definitions get new-words get assoc-diff outdated-definition-usages %
-        maybe-changed get new-words get assoc-diff outdated-conditional-usages %
-        changed-definitions get [ drop word? ] assoc-filter 1array %
+        changed-effects get new-words get diff
+        outdated-effect-usages %
+
+        changed-definitions get new-words get diff
+        outdated-definition-usages %
+
+        maybe-changed get new-words get diff
+        outdated-conditional-usages %
+
+        changed-definitions get members [ word? ] filter dup zip ,
     ] { } make assoc-combine keys ;
 
 M: optimizing-compiler process-forgotten-words
index cdb7d52718fd20f89574a9d8489bce3578b4e39e..b44083222f6931b37230dcfc82acf1b27912c82d 100644 (file)
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs classes.algebra compiler.units definitions
 graphs grouping kernel namespaces sequences words fry
-stack-checker.dependencies combinators ;
+stack-checker.dependencies combinators sets ;
 IN: compiler.crossref
 
 SYMBOL: compiled-crossref
@@ -22,24 +22,21 @@ generic-call-site-crossref [ H{ } clone ] initialize
 : conditional-dependencies-of ( word -- assoc )
     effect-dependencies-of [ nip conditional-dependency dependency>= ] assoc-filter ;
 
-: outdated-definition-usages ( assoc -- assocs )
-    [ drop word? ] assoc-filter
-    [ drop definition-dependencies-of ] { } assoc>map ;
+: outdated-definition-usages ( set -- assocs )
+    members [ word? ] filter [ definition-dependencies-of ] map ;
 
-: outdated-effect-usages ( assoc -- assocs )
-    [ drop word? ] assoc-filter
-    [ drop effect-dependencies-of ] { } assoc>map ;
+: outdated-effect-usages ( set -- assocs )
+    members [ word? ] filter [ effect-dependencies-of ] map ;
 
 : dependencies-satisfied? ( word cache -- ? )
     [ "dependency-checks" word-prop ] dip
     '[ _ [ satisfied? ] cache ] all? ;
 
-: outdated-conditional-usages ( assoc -- assocs )
-    H{ } clone '[
-        drop
+: outdated-conditional-usages ( set -- assocs )
+    members H{ } clone '[
         conditional-dependencies-of
         [ drop _ dependencies-satisfied? not ] assoc-filter
-    ] { } assoc>map ;
+    ] map ;
 
 : generic-call-sites-of ( word -- assoc )
     generic-call-site-crossref get at ;
index 7623ca3ad518822e2493bcbb1489f5f4e6c6dea8..72ca0f54e6ec3bbb39e0520821a0f7cf9318d428 100644 (file)
@@ -71,7 +71,7 @@ M: f update-call-sites
     2drop { } ;
 
 M: f to-recompile
-    changed-definitions get [ drop word? ] assoc-filter keys ;
+    changed-definitions get members [ word? ] filter ;
 
 M: f recompile
     [ dup def>> ] { } map>assoc ;
@@ -121,25 +121,24 @@ M: object always-bump-effect-counter? drop f ;
 
 : updated-definitions ( -- set )
     HS{ } clone
-    forgotten-definitions get keys over adjoin-all
+    forgotten-definitions get union!
     new-definitions get first keys over adjoin-all
     new-definitions get second keys over adjoin-all
-    changed-definitions get keys over adjoin-all
-    maybe-changed get keys over adjoin-all
+    changed-definitions get union!
+    maybe-changed get union!
     dup changed-vocabs over adjoin-all ;
 
 : process-forgotten-definitions ( -- )
-    forgotten-definitions get keys
+    forgotten-definitions get members
     [ [ word? ] filter process-forgotten-words ]
     [ [ delete-definition-errors ] each ]
     bi ;
 
 : bump-effect-counter? ( -- ? )
-    changed-effects get
-    maybe-changed get
-    changed-definitions get [ drop always-bump-effect-counter? ] assoc-filter
-    3array assoc-combine
-    new-words get [ nip key? not ] curry assoc-any? ;
+    changed-effects get members
+    maybe-changed get members
+    changed-definitions get members [ always-bump-effect-counter? ] filter
+    3array combine new-words get [ in? not ] curry any? ;
 
 : bump-effect-counter ( -- )
     bump-effect-counter? [
@@ -152,10 +151,10 @@ M: object always-bump-effect-counter? drop f ;
     [ drop ] [ notify-definition-observers notify-error-observers ] if ;
 
 : update-existing? ( defs -- ? )
-    new-words get [ key? not ] curry any? ;
+    new-words get [ in? not ] curry any? ;
 
 : reset-pics? ( -- ? )
-    outdated-generics get assoc-empty? not ;
+    outdated-generics get null? not ;
 
 : finish-compilation-unit ( -- )
     [ ] [
@@ -172,7 +171,7 @@ M: object always-bump-effect-counter? drop f ;
 TUPLE: nesting-observer new-words ;
 
 M: nesting-observer definitions-changed
-    [ members ] dip new-words>> [ delete-at ] curry each ;
+    [ members ] dip new-words>> [ delete ] curry each ;
 
 : add-nesting-observer ( -- )
     new-words get nesting-observer boa
@@ -185,12 +184,12 @@ PRIVATE>
 
 : with-nested-compilation-unit ( quot -- )
     [
-        H{ } clone changed-definitions set
-        H{ } clone maybe-changed set
-        H{ } clone changed-effects set
-        H{ } clone outdated-generics set
+        HS{ } clone changed-definitions set
+        HS{ } clone maybe-changed set
+        HS{ } clone changed-effects set
+        HS{ } clone outdated-generics set
         H{ } clone outdated-tuples set
-        H{ } clone new-words set
+        HS{ } clone new-words set
         add-nesting-observer
         [
             remove-nesting-observer
@@ -202,6 +201,6 @@ PRIVATE>
     [
         <definitions> new-definitions set
         <definitions> old-definitions set
-        H{ } clone forgotten-definitions set
+        HS{ } clone forgotten-definitions set
         with-nested-compilation-unit
     ] with-scope ; inline
index 14870e92aadf9c7d229472d38189280bd465e98e..f76dcf590a769e3180bebeb34271ab3d4463f0b2 100644 (file)
@@ -1,24 +1,24 @@
 ! Copyright (C) 2006, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs kernel namespaces sequences ;
+USING: accessors assocs kernel namespaces sequences sets ;
 IN: definitions
 
 MIXIN: definition
 
 ERROR: no-compilation-unit definition ;
 
-: set-in-unit ( value key assoc -- )
-    [ set-at ] [ no-compilation-unit ] if* ;
+: add-to-unit ( key set -- )
+    [ adjoin ] [ no-compilation-unit ] if* ;
 
 SYMBOL: changed-definitions
 
 : changed-definition ( defspec -- )
-    dup changed-definitions get set-in-unit ;
+    changed-definitions get add-to-unit ;
 
 SYMBOL: maybe-changed
 
 : changed-conditionally ( class -- )
-    dup maybe-changed get set-in-unit ;
+    maybe-changed get add-to-unit ;
 
 SYMBOL: changed-effects
 
@@ -27,10 +27,10 @@ SYMBOL: outdated-generics
 SYMBOL: new-words
 
 : new-word ( word -- )
-    dup new-words get set-in-unit ;
+    new-words get add-to-unit ;
 
 : new-word? ( word -- ? )
-    new-words get key? ;
+    new-words get in? ;
 
 GENERIC: where ( defspec -- loc )
 
@@ -43,7 +43,7 @@ GENERIC: forget* ( defspec -- )
 SYMBOL: forgotten-definitions
 
 : forgotten-definition ( defspec -- )
-    dup forgotten-definitions get set-in-unit ;
+    forgotten-definitions get add-to-unit ;
 
 : forget ( defspec -- ) [ forgotten-definition ] [ forget* ] bi ;
 
index 72e17fbe8ac2c989ab48ef042da7b85adbc81419..23c8643692713df1b956016ab11a249b199ffda5 100644 (file)
@@ -4,6 +4,7 @@ USING: accessors arrays assocs classes classes.algebra
 classes.algebra.private classes.maybe classes.private
 combinators definitions kernel make namespaces sequences sets
 words ;
+FROM: sets => members ;
 IN: generic
 
 ! Method combination protocol
@@ -96,10 +97,11 @@ ERROR: check-method-error class generic ;
     ] unless ; inline
 
 : remake-generic ( generic -- )
-    dup outdated-generics get set-in-unit ;
+    outdated-generics get add-to-unit ;
 
 : remake-generics ( -- )
-    outdated-generics get keys [ generic? ] filter [ make-generic ] each ;
+    outdated-generics get members [ generic? ] filter
+    [ make-generic ] each ;
 
 GENERIC: update-generic ( class generic -- )
 
index 912406733536918b2983162009de31c5586e653a..8eb7498d50d8a4e1e68d68009b9b84487b77a204 100644 (file)
@@ -3,8 +3,8 @@
 USING: accessors arrays assocs classes combinators
 compiler.units continuations definitions effects io
 io.encodings.utf8 io.files kernel lexer math.parser namespaces
-parser.notes quotations sequences slots source-files vectors
-vocabs vocabs.parser words words.symbol ;
+parser.notes quotations sequences sets slots source-files
+vectors vocabs vocabs.parser words words.symbol ;
 IN: parser
 
 : location ( -- loc )
@@ -90,7 +90,7 @@ ERROR: staging-violation word ;
     pop-parsing-word ; inline
 
 : execute-parsing ( accum word -- accum )
-    dup changed-definitions get key? [ staging-violation ] when
+    dup changed-definitions get in? [ staging-violation ] when
     (execute-parsing) ;
 
 : scan-object ( -- object )
index aaeb35659115fd5afd2bff7835eb92adfa693452..8b3f60e8f151d8a3ee8fb375d26aa495e94bfa19 100644 (file)
@@ -93,7 +93,7 @@ M: word parent-word drop f ;
     over changed-definition [ ] like >>def drop ;
 
 : changed-effect ( word -- )
-    [ dup changed-effects get set-in-unit ]
+    [ changed-effects get add-to-unit ]
     [ dup primitive? [ drop ] [ changed-definition ] if ] bi ;
 
 : set-stack-effect ( effect word -- )