basis/optimizer/pattern-match/pattern-match.factor

   1 ! Copyright (C) 2007 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel sequences namespaces generic
   4 combinators classes classes.algebra
   5 inference inference.dataflow ;
   6 IN: optimizer.pattern-match
   7
   8 ! Funny pattern matching
   9 SYMBOL: @
  10
  11 : match-@ ( value -- ? )
  12     #! All @ must be eq
  13     @ get [ eq? ] [ @ set t ] if* ;
  14
  15 : match-class ( value spec -- ? )
  16     >r node get swap node-class r> class<= ;
  17
  18 : value-match? ( value spec -- ? )
  19     {
  20         { [ dup @ eq? ] [ drop match-@ ] }
  21         { [ dup class? ] [ match-class ] }
  22         { [ over value? not ] [ 2drop f ] }
  23         [ swap value-literal = ]
  24     } cond ;
  25
  26 : node-match? ( node values pattern -- ? )
  27     [
  28         rot node set @ off
  29         [ value-match? ] 2all?
  30     ] with-scope ;
  31
  32 : in-d-match? ( node pattern -- ? )
  33     >r dup node-in-d r> node-match? ;