45 lines
1.4 KiB
Factor
45 lines
1.4 KiB
Factor
|
! Copyright (C) 2008 Doug Coleman.
|
||
|
|
! See http://factorcode.org/license.txt for BSD license.
|
||
|
|
USING: accessors arrays assocs fry hashtables kernel sequences
|
||
|
|
vectors ;
|
||
|
|
IN: regexp2.transition-tables
|
||
|
|
|
||
|
|
: insert-at ( value key hash -- )
|
||
|
|
2dup at* [
|
||
|
|
2nip push
|
||
|
|
] [
|
||
|
|
drop >r >r dup vector? [ 1vector ] unless r> r> set-at
|
||
|
|
] if ;
|
||
|
|
|
||
|
|
: ?insert-at ( value key hash/f -- hash )
|
||
|
|
[ H{ } clone ] unless* [ insert-at ] keep ;
|
||
|
|
|
||
|
|
TUPLE: transition from to obj ;
|
||
|
|
TUPLE: literal-transition < transition ;
|
||
|
|
TUPLE: class-transition < transition ;
|
||
|
|
TUPLE: default-transition < transition ;
|
||
|
|
|
||
|
|
TUPLE: literal obj ;
|
||
|
|
TUPLE: class obj ;
|
||
|
|
TUPLE: default ;
|
||
|
|
: <literal-transition> ( from to obj -- transition ) literal-transition boa ;
|
||
|
|
: <class-transition> ( from to obj -- transition ) class-transition boa ;
|
||
|
|
: <default-transition> ( from to -- transition ) t default-transition boa ;
|
||
|
|
|
||
|
|
TUPLE: transition-table transitions
|
||
|
|
literals classes defaults
|
||
|
|
start-state final-states ;
|
||
|
|
|
||
|
|
: <transition-table> ( -- transition-table )
|
||
|
|
transition-table new
|
||
|
|
H{ } clone >>transitions
|
||
|
|
H{ } clone >>final-states ;
|
||
|
|
|
||
|
|
: set-transition ( transition hash -- )
|
||
|
|
>r [ to>> ] [ obj>> ] [ from>> ] tri r>
|
||
|
|
2dup at* [ 2nip insert-at ]
|
||
|
|
[ drop >r >r H{ } clone [ insert-at ] keep r> r> set-at ] if ;
|
||
|
|
|
||
|
|
: add-transition ( transition transition-table -- )
|
||
|
|
transitions>> set-transition ;
|