basis/values/values.factor

   1 ! Copyright (C) 2008, 2009 Daniel Ehrenberg, Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel parser words sequences quotations
   4 combinators.short-circuit definitions ;
   5 IN: values
   6
   7 ! Mutating literals in word definitions is not really allowed,
   8 ! and the deploy tool takes advantage of this fact to perform
   9 ! some aggressive stripping and compression. However, this
  10 ! breaks a naive implementation of values. We need to do two
  11 ! things:
  12 ! 1) Store the value in a subclass of identity-tuple, so that
  13 ! two quotations from different value words are never equal.
  14 ! This avoids bogus merging of values.
  15 ! 2) Set the "no-def-strip" word-prop, so that the shaker leaves
  16 ! the def>> slot alone, allowing us to introspect it. Otherwise,
  17 ! it will get set to [ ] and we would lose access to the
  18 ! value-holder.
  19
  20 <PRIVATE
  21
  22 TUPLE: value-holder < identity-tuple obj ;
  23
  24 PRIVATE>
  25
  26 PREDICATE: value-word < word
  27     def>> {
  28         [ length 2 = ]
  29         [ first value-holder? ]
  30         [ second \ obj>> = ]
  31     } 1&& ;
  32
  33 : VALUE:
  34     CREATE-WORD
  35     dup t "no-def-strip" set-word-prop
  36     T{ value-holder } clone [ obj>> ] curry
  37     (( -- value )) define-declared ; parsing
  38
  39 M: value-word definer drop \ VALUE: f ;
  40
  41 M: value-word definition drop f ;
  42
  43 : set-value ( value word -- )
  44     def>> first (>>obj) ;
  45
  46 : to:
  47     scan-word literalize parsed
  48     \ set-value parsed ; parsing
  49
  50 : get-value ( word -- value )
  51     def>> first obj>> ;
  52
  53 : change-value ( word quot -- )
  54     [ [ get-value ] dip call ] [ drop ] 2bi set-value ; inline