]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' of git://factorcode.org/git/factor into tangle
authorAlex Chapman <chapman.alex@gmail.com>
Mon, 14 Apr 2008 15:58:49 +0000 (01:58 +1000)
committerAlex Chapman <chapman.alex@gmail.com>
Mon, 14 Apr 2008 15:58:49 +0000 (01:58 +1000)
Conflicts:

extra/semantic-db/hierarchy/hierarchy.factor
extra/semantic-db/semantic-db.factor

1  2 
extra/semantic-db/semantic-db.factor

index 2ac667a94c8922bb6aa21002aca8cb5895d32513,2de0e1c67e4d3e66872edcc676f16638c1db8347..dad1dd39194567e1095b91575d81e0fc3afc7828
@@@ -15,64 -16,40 +15,64 @@@ node "node
      { "content" "content" TEXT }
  } define-persistent
  
 -: create-node-table ( -- )
 -    node create-table ;
 -
 -: delete-node ( node-id -- )
 -    <id-node> delete-tuple ;
 +: delete-node ( node -- ) delete-tuple ;
 +: create-node ( content -- node ) f swap <node> dup insert-tuple ;
 +: load-node ( id -- node ) f <node> select-tuple ;
  
 -: create-node* ( str -- node-id )
 -    <node> dup insert-tuple id>> ;
 +: node-content ( node -- content )
 +    dup content>> [ nip ] [ select-tuple content>> ] if* ;
  
 -: create-node ( str -- )
 -    create-node* drop ;
 +: node= ( node node -- ? ) [ id>> ] bi@ = ;
  
 -: node-content ( id -- str )
 -    f <node> swap >>id select-tuple content>> ;
 +! TODO: get rid of arc id and write our own sql
 +TUPLE: arc id subject object relation ;
  
 -TUPLE: arc id relation subject object ;
 -
 -: <arc> ( relation subject object -- arc )
 -    arc new swap >>object swap >>subject swap >>relation ;
 +: <arc> ( subject object relation -- arc )
 +    arc construct-empty swap >>relation swap >>object swap >>subject ;
  
  : <id-arc> ( id -- arc )
-     arc construct-empty swap >>id ;
+     arc new swap >>id ;
  
 -: insert-arc ( arc -- )
 -    f <node> dup insert-tuple id>> >>id insert-tuple ;
 +: delete-arc ( arc -- ) delete-tuple ;
 +
 +: create-arc ( subject object relation -- )
 +    [ id>> ] 3apply <arc> insert-tuple ;
 +
 +: nodes>arc ( subject object relation -- arc )
 +    [ [ id>> ] [ f ] if* ] 3apply <arc> ;
 +
 +: select-arcs ( subject object relation -- arcs )
 +    nodes>arc select-tuples ;
 +
 +: has-arc? ( subject object relation -- ? )
 +    select-arcs length 0 > ;
  
 -: delete-arc ( arc-id -- )
 -    dup delete-node <id-arc> delete-tuple ;
 +: select-arc-subjects ( subject object relation -- subjects )
 +    select-arcs [ subject>> f <node> ] map ;
  
 -: create-arc* ( relation subject object -- arc-id )
 -    <arc> dup insert-arc id>> ;
 +: select-arc-subject ( subject object relation -- subject )
 +    select-arcs ?first [ subject>> f <node> ] [ f ] if* ;
  
 -: create-arc ( relation subject object -- )
 -    create-arc* drop ;
 +: select-subjects ( object relation -- subjects )
 +    f -rot select-arc-subjects ;
 +
 +: select-subject ( object relation -- subject )
 +    f -rot select-arc-subject ;
 +
 +: select-arc-objects ( subject object relation -- objects )
 +    select-arcs [ object>> f <node> ] map ;
 +
 +: select-arc-object ( subject object relation -- object )
 +    select-arcs ?first [ object>> f <node> ] [ f ] if* ;
 +
 +: select-objects ( subject relation -- objects )
 +    f swap select-arc-objects ;
 +
 +: select-object ( subject relation -- object )
 +    f swap select-arc-object ;
 +
 +: delete-arcs ( subject object relation -- )
 +    select-arcs [ delete-arc ] each ;
  
  arc "arc"
  {