Paste: vnav

Author: dharmatech
Mode: factor
Date: Tue, 4 Nov 2008 22:55:36
Plain Text | 
USING: kernel lexer parser words namespaces sequences splitting
       classes.tuple
       accessors
       vocabs vocabs.loader
       prettyprint io io.files
       combinators.short-circuit
       store ;

IN: vnav

! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

: directory-path? ( path -- ? ) file-info directory? ;

! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

: maybe-use ( name -- name ) dup find-vocab-root [ dup use+ ] when ;

! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

! Used to switch to sub-vocabularies.
! Should also allow for fully-qualified vocabulary names.

: cd
  in get "." scan 3append
  maybe-use
  set-in ;                                                      parsing

! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

: up ( -- )
  in get "home." head?
    [ in get "." split but-last "." join maybe-use set-in ]
    [ "home" maybe-use set-in ]
  if ;

! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

: val? ( word -- ? ) def>> { [ length 1 = ] [ first word? not ] } 1&& ;

: list-vals ( -- )
  in get words [ val? ] filter [ symbol? not ] filter
  dup empty? not
    [ "vals: " print [ "  " write . ] each ]
    [ drop ]
  if ;

! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

: list-words ( -- )
  in get words [ val? not ] filter [ "predicating" word-prop not ] filter
  dup empty? not
    [ "words: " print [ "  " write . ] each ]
    [ drop ]
  if ;

! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

: list-tuple-classes ( -- )
  in get words [ tuple-class? ] filter
  dup empty? not
    [ "tuple classes: " print [ "  " write . ] each ]
    [ drop ]
  if ;

! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

: ls ( -- )

  "resource:store" in get "." split "/" join append-path
  dup exists?
    [ [ [ directory-path? ] filter ] with-directory-files ]
    [ drop { } ]
  if
  
  dup empty? not
    [
      "subvocabularies: " print
      [ "  " write print ] each
      nl
    ]
    [ drop ]
  if

  list-tuple-classes

  list-words

  list-vals ;

New Annotation

Summary:
Author:
Mode:
Body: