Merge branch 'master' of git://factorcode.org/git/factor

core/compiler/compiler.factor

@@ -26,7 +26,7 @@ IN: compiler
     >r dupd save-effect r>
     f pick compiler-error
     over compiled-unxref
-    compiled-xref ;
+    over crossref? [ compiled-xref ] [ 2drop ] if ;
 
 : compile-succeeded ( word -- effect dependencies )
     [

core/cpu/x86/32/32.factor

@@ -261,6 +261,10 @@ windows? [
     cell "ulonglong" c-type set-c-type-align
 ] unless
 
+macosx? [
+    cell "double" c-type set-c-type-align
+] when
+
 T{ x86-backend f 4 } compiler-backend set-global
 
 : sse2? "Intrinsic" throw ;

core/effects/effects.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2006, 2007 Slava Pestov.
+! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math namespaces sequences strings words assocs
 combinators ;
@@ -41,17 +41,13 @@ M: integer (stack-picture) drop "object" ;
         ")" %
     ] "" make ;
 
-: stack-effect ( word -- effect/f )
+GENERIC: stack-effect ( word -- effect/f )
-    {
+
-        { [ dup symbol? ] [ drop 0 1 <effect> ] }
+M: symbol stack-effect drop 0 1 <effect> ;
-        { [ dup "parent-generic" word-prop ] [
+
-            "parent-generic" word-prop stack-effect
+M: word stack-effect
-        ] }
+    { "declared-effect" "inferred-effect" }
-        { [ t ] [
+    swap word-props [ at ] curry map [ ] find nip ;
-            { "declared-effect" "inferred-effect" }
-            swap word-props [ at ] curry map [ ] find nip
-        ] }
-    } cond ;
 
 M: effect clone
     [ effect-in clone ] keep effect-out clone <effect> ;

core/generic/generic-docs.factor

@@ -107,10 +107,6 @@ HELP: make-generic
 { $description "Regenerates the definition of a generic word by applying the method combination to the set of defined methods." }
 $low-level-note ;
 
-HELP: init-methods
-{ $values { "word" word } }
-{ $description "Prepare to define a generic word." } ;
-
 HELP: define-generic
 { $values { "word" word } { "combination" "a method combination" } }
 { $description "Defines a generic word. A method combination is an object which responds to the " { $link perform-combination } " generic word." }

core/generic/generic-tests.factor

@@ -176,6 +176,9 @@ M: f tag-and-f 4 ;
 ! define-class hashing issue
 TUPLE: debug-combination ;
 
+M: debug-combination make-default-method
+    2drop [ "Oops" throw ] when ;
+
 M: debug-combination perform-combination
     drop
     order [ dup class-hashes ] { } map>assoc sort-keys

core/generic/generic.factor

@@ -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: words kernel sequences namespaces assocs hashtables
 definitions kernel.private classes classes.private
-quotations arrays vocabs ;
+quotations arrays vocabs effects ;
 IN: generic
 
 ! Method combination protocol
@@ -65,15 +65,20 @@ TUPLE: check-method class generic ;
 : make-method-def ( quot word combination -- quot )
     "combination" word-prop method-prologue swap append ;
 
+PREDICATE: word method-body "method" word-prop >boolean ;
+
+M: method-body stack-effect
+    "method" word-prop method-generic stack-effect ;
+
 : <method-word> ( quot class generic -- word )
     [ make-method-def ] 2keep
-    [ method-word-name f <word> dup ] keep
+    method-word-name f <word>
-    "parent-generic" set-word-prop
     dup rot define ;
 
 : <method> ( quot class generic -- method )
     check-method
-    [ <method-word> ] 3keep f \ method construct-boa ;
+    [ <method-word> ] 3keep f \ method construct-boa
+    dup method-word over "method" set-word-prop ;
 
 : define-method ( quot class generic -- )
     >r bootstrap-word r>
@@ -120,13 +125,22 @@ M: class forget* ( class -- )
 M: assoc update-methods ( assoc -- )
     implementors* [ make-generic ] each ;
 
-: init-methods ( word -- )
-     dup "methods" word-prop
-     H{ } assoc-like
-     "methods" set-word-prop ;
-
 : define-generic ( word combination -- )
-    2dup "combination" set-word-prop
+    over "combination" word-prop over = [
-    dupd define-default-method
+        2drop
-    dup init-methods
+    ] [
-    make-generic ;
+        2dup "combination" set-word-prop
+        over H{ } clone "methods" set-word-prop
+        dupd define-default-method
+        make-generic
+    ] if ;
+
+: subwords ( generic -- seq )
+    dup "methods" word-prop values
+    swap "default-method" word-prop add
+    [ method-word ] map ;
+
+: xref-generics ( -- )
+    all-words
+    [ generic? ] subset
+    [ subwords [ xref ] each ] each ;

core/generic/standard/standard.factor

@@ -10,7 +10,7 @@ TUPLE: standard-combination # ;
 
 M: standard-combination method-prologue
     standard-combination-# object
-    <array> swap add [ declare ] curry ;
+    <array> swap add* [ declare ] curry ;
 
 C: <standard-combination> standard-combination
 

core/inference/backend/backend.factor

@@ -10,8 +10,8 @@ IN: inference.backend
     recursive-state get at ;
 
 : inline? ( word -- ? )
-    dup "parent-generic" word-prop
+    dup "method" word-prop
-    [ inline? ] [ "inline" word-prop ] ?if ;
+    [ method-generic inline? ] [ "inline" word-prop ] ?if ;
 
 : local-recursive-state ( -- assoc )
     recursive-state get dup keys

core/words/words.factor

@@ -116,13 +116,16 @@ SYMBOL: changed-words
     [ no-compilation-unit ] unless*
     set-at ;
 
+: crossref? ( word -- ? )
+    dup word-vocabulary swap "method" word-prop or ;
+
 : define ( word def -- )
     [ ] like
     over unxref
     over redefined
     over set-word-def
     dup changed-word
-    dup word-vocabulary [ dup xref ] when drop ;
+    dup crossref? [ dup xref ] when drop ;
 
 : define-declared ( word def effect -- )
     pick swap "declared-effect" set-word-prop

extra/io/launcher/launcher-docs.factor

@@ -146,8 +146,8 @@ HELP: with-process-stream
 { $values
   { "desc" "a launch descriptor" }
   { "quot" quotation }
-  { "process" process } }
+  { "status" "an exit code" } }
-{ $description "Calls " { $snippet "quot" } " in a dynamic scope where " { $link stdio } " is rebound to a " { $link process-stream } ". When the quotation returns, the " { $link process } " instance is output." } ;
+{ $description "Calls " { $snippet "quot" } " in a dynamic scope where " { $link stdio } " is rebound to a " { $link process-stream } ". After the quotation returns, waits for the process to end and outputs the exit code." } ;
 
 HELP: wait-for-process
 { $values { "process" process } { "status" integer } }

extra/io/launcher/launcher.factor

@@ -98,10 +98,10 @@ TUPLE: process-stream process ;
     { set-delegate set-process-stream-process }
     process-stream construct ;
 
-: with-process-stream ( desc quot -- process )
+: with-process-stream ( desc quot -- status )
     swap <process-stream>
     [ swap with-stream ] keep
-    process-stream-process ; inline
+    process-stream-process wait-for-process ; inline
 
 : notify-exit ( status process -- )
     [ set-process-status ] keep