]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' into new_ui
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Mon, 2 Mar 2009 02:13:05 +0000 (20:13 -0600)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Mon, 2 Mar 2009 02:13:05 +0000 (20:13 -0600)
1  2 
core/classes/tuple/tuple.factor
core/effects/effects.factor

index 69a8f3347e055a2f3cea506a02dab2800d3f9761,f5dbe6242ab954c4f023278871f984b737e5ac39..b13bc1bfa256ae5d6accb74c37bce36bf70ad281
@@@ -251,9 -251,9 +251,9 @@@ M: tuple-class update-clas
      3bi ;
  
  : tuple-class-unchanged? ( class superclass slots -- ? )
 -    [ over ] dip
      [ [ superclass ] [ bootstrap-word ] bi* = ]
 -    [ [ "slots" word-prop ] dip = ] 2bi* and ;
 +    [ [ "slots" word-prop ] dip = ]
 +    bi-curry* bi and ;
  
  : valid-superclass? ( class -- ? )
      [ tuple-class? ] [ tuple eq? ] bi or ;
@@@ -278,7 -278,7 +278,7 @@@ M: tuple-class (define-tuple-class
      [ 3drop ] [ redefine-tuple-class ] if ;
  
  : thrower-effect ( slots -- effect )
-     [ dup array? [ first ] when ] map f <effect> t >>terminated? ;
+     [ dup array? [ first ] when ] map { "*" } <effect> ;
  
  : define-error-class ( class superclass slots -- )
      [ define-tuple-class ]
index a3cf8065acac9421cd27ca6cd84a0cfe222690eb,77afa496cc35b88a045288cfd606e9123dd9e183..d21132aebb7b9e37c7dcb5f84f535792fba000dd
@@@ -1,17 -1,17 +1,17 @@@
 -! Copyright (C) 2006, 2008 Slava Pestov.
 +! Copyright (C) 2006, 2009 Slava Pestov.
  ! See http://factorcode.org/license.txt for BSD license.
  USING: kernel math math.parser namespaces make sequences strings
  words assocs combinators accessors arrays ;
  IN: effects
  
- TUPLE: effect in out terminated? ;
+ TUPLE: effect { in read-only } { out read-only } { terminated? read-only } ;
  
  : <effect> ( in out -- effect )
      dup { "*" } sequence= [ drop { } t ] [ f ] if
      effect boa ;
  
  : effect-height ( effect -- n )
-     [ out>> length ] [ in>> length ] bi - ;
+     [ out>> length ] [ in>> length ] bi - ; inline
  
  : effect<= ( eff1 eff2 -- ? )
      {
          { [ 2dup [ in>> length ] bi@ > ] [ f ] }
          { [ 2dup [ effect-height ] bi@ = not ] [ f ] }
          [ t ]
-     } cond 2nip ;
+     } cond 2nip ; inline
  
  GENERIC: effect>string ( obj -- str )
  M: string effect>string ;
 +M: object effect>string drop "object" ;
  M: word effect>string name>> ;
  M: integer effect>string number>string ;
  M: pair effect>string first2 [ effect>string ] bi@ ": " glue ;
@@@ -58,8 -57,11 +58,8 @@@ M: effect clon
  : split-shuffle ( stack shuffle -- stack1 stack2 )
      in>> length cut* ;
  
 -: load-shuffle ( stack shuffle -- )
 -    in>> [ set ] 2each ;
 -
 -: shuffled-values ( shuffle -- values )
 -    out>> [ get ] map ;
 +: shuffle-mapping ( effect -- mapping )
 +    [ out>> ] [ in>> ] bi [ index ] curry map ;
  
  : shuffle ( stack shuffle -- newstack )
 -    [ [ load-shuffle ] keep shuffled-values ] with-scope ;
 +    shuffle-mapping swap nths ;