[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: annotations


If I have understood correctly, you would like to store centaur
paths in tree annotations, but this poses problems when you try
to save the tree containing these annotations.

Storing paths in tree annotations is a dangerous adventure. First of
all, path leaves contain physical pointers to vtp objects. These
pointers cannot be maintained in permanent storage. Secondly, a path
corresponds to a given tree. If the tree evolves (is modified), the
path must be updated. Thirdly, if not careful, we may lose the
information that path P pointed to a subtree below root R if we
store P on disk without storing R.

In spite of these issues, Francois Rouaix and I have a solution to
your request. In fact, it is a general solution that should allow
one to store in a polish file any lelisp object that may be printed
and read symmetrically (i.e., "print" of the object followed by "read"
of the object returns a copy of the object). Circular objects should
be avoided!

We have written a few functions for the specific case of centaur
paths. We assume that the association between a path and the tree
it points within is managed by the user. This association is thus not
stored on disk.

***This code is not guaranteed!!! If it works consistently, please
   let us know!


************************THE INTERFACE************************

In the following functions, a file name is a string.

   (#:tree:pathdecor:write <tree> <filename>)

      This function saves a polish form of <tree> in <filename>.po. 
      Any <tree> node may be annotated for the decor #:lispdecor:<formalism>,
      where <formalism> is the formalism of the <tree>. The value of
      this annotation must be a centaur path. Before saving a path,
      the physical pointers in the leaves of the path are removed. NB:
      This means that it may not be (immediatley) reused in the
      current session! To reuse the path, see #:tree:pathdecor:set-paths.

   (#:tree:pathdecor:read <filename> <directoryname>)

      This function reads a polish form of <tree> from <filename>.po
      found in <directoryname>. The resulting tree may be
      annotated for the decor #:lispdecor:<formalism>. The value of
      such an annotation is a centaur path. The leaves of these
      paths do not point to any object. Returns the read tree.

  
   (#:tree:pathdecor:read-and-connect <filename> <directoryname>
<destination-tree>)
 
      Same as #:tree:pathdecor:read, but links the paths in the
      annotations of the read tree to <destination-tree> subtrees.
      NB: If the paths don't correspond to the <destination-tree> 
      shape, an error will occur.

   (#:tree:pathdecor:clean-paths <tree>)

      Removes all the physical pointers of paths stored as annotations in
      <tree>.
   
   (#:tree:pathdecor:set-paths <tree> <destination-tree>)

      Sets all the physical pointers of paths stored as annotations in
      <tree> to the appropriate positions in <destination-tree>. NB:
      If the paths don't correspond to the <destination-tree> 
      shape, an error will occur.
   
************************THE MODULE************************

We have created a compiled module for this code that is
located in the directory contrib/annotations (either the
application hierarchy or the user hierarchy). This module
contains four files: Buildfile, module.LM, include.ll, and
annotations.ll.

To compile the module, type "ctmake" in the contrib/annotations
directory. 

To load the module:

? (loadmodule 'contrib/annotations)
= contrib/annotations

AFTER WHICH YOU MUST CALL THE FUNCTION:

? (#:contrib/annotations:initialize)
= ()
             

To see an example of how the thing works, try:

     (#:tree:pathdecor:test <filename>)

where <filename> contains a program written in a known language. It
is better if this program is short!


************************THE CODE************************


************************ Buildfile
#You must replace <centaur-root-directory> with
#a relative or absolute path to the directory
#containing the current distribution of centaur.
ROOTDIR=<centaur-root-directory> 
USERDIR=../../
MODNAME=contrib/annotations
CMPLC="centaur -top"
allcmplc:
	$(ROOTDIR)bin/mkcmplc $(ROOTDIR) $(USERDIR) $(CMPLC) $(MODNAME) 


************************ module.LM
defmodule contrib/annotations
files ("contrib/annotations/annotations")
export ( 
	#:contrib/annotations:initialize
	;;Specific for path annotation values
	#:path:remove-tree-pointers
	#:path:set-tree-pointers

	#:tree:pathdecor:write
	#:tree:pathdecor:read
	#:tree:pathdecor:read-and-connect
	#:tree:pathdecor:clean-paths
	#:tree:pathdecor:set-paths
	#:tree:pathdecor:test

	#:lispdecor:create-or-return
	#:lispdecor:polish:write
	#:lispdecor:ecrire
	#:lispdecor:polish:read
	)

************************ include.ll
(defabbrev lispdecor lispdecor)

************************ annotations.ll
(defvar {lispdecor} 'lispdecor)

(de #:contrib/annotations:initialize ()
    ;;The inipolishparams function must be called to set 
    ;;polish variables. Just do it.
    (unless (memq 'lispdecor polish-types)
	    (inipolishparams {lispdecor} () () 
			     '#:lispdecor:polish:read 
			     '#:lispdecor:polish:write 
			     1 0 1)
	    )
    ()
    )

(de #:lispdecor:create-or-return (formalism-name)
    ;;Creates a lispdecor for formalism.
    ;;Stores it in the global variable #:lispdecor:<formalism-name>
    ;;formalism-name should be a symbol!
    (lets ((formalism ({name}:formalism formalism-name)))
	  (set (symbol 'lispdecor formalism-name)
	       (lock
		(lambda (tag val)
		  (cond 
		   ((eq tag 'not_found)
		    (let ((decor ({tree}:new_decor 'lispdecor {lispdecor} formalism)))
			 ({decor}:control decor 'sauver t)
			 ({decor}:control decor 'copier t)
			 ({decor}:control decor 'ecrire t)
			 decor
			 )
		    )
		   ((null tag) val)
		   (t (evexit tag val))
		   ))
		({name}:decor 'lispdecor {tree} formalism)
		))
	  ))


#|
The polish read mechanism bufferizes read lines
in a global variable "polish-line". Since we don't want (can't)
manipulate this buffer easily, we end it with an initial (print). 
The polish read mechanism always reads lines of 80 characters, however. 
Thus, if a line terminates before 80 because of our print, 
the read mechanism adds remaining spaces. These spaces make the reader
mechanism think the tree has ended, thus an error is provoked. We
solve this problem by setting the polish-line buffer to () after having
read our object.

We write by ending the current line (which will later be completed
by the vtp with blank spaces), and printing our object.
If we don't end the line after the object, when we reread it, we
set the polish-line to (), thus provoking the reader to fill
the polish-line buffer. The buffer begins with the correct characters
(those following our object), but, the line is shorter than 80 characters!
Spaces are added by the reader, and the mechanism once again believes that
the whole tree has been read. Wrong! So, we add a newline after our object,
sending the following correct characters to the beginning of the next line.
Since the line is 80 characters long, no spaces will be added by the reader,
so all is well. However, the newline we add with the extra print must be
removed during the read.
|#

(de #:lispdecor:polish:write (value)
    (let ((#:system:print-for-read t))
	 (print)
	 (print value)
	 )
    )

;;To see the decor with the function ecrirep
(de #:lispdecor:ecrire (obj args)
    (print obj)
    )

(de #:lispdecor:polish:read ()
    (prog1
     (read) ;;The object
     ;;Don't forget to eat the newline!!!
     (readcn)
     ;;Remove remaining blank spaces in polish-line buffer.
     (setq polish-line ())
     )
    )

;;;;;;;;;;;;;;;;;;Path manipulation functions

(de {path}:remove-tree-pointers (path)
    ({path}:for-all-leaf 
       path
       (lambda (leaf type) ({leaf}:val leaf ()))
       )
    path
    )

(de {path}:set-tree-pointers (path root)
    ({path}:follow-all-leaf path root 0 
      (lambda (leaf-path type subtree)
              ({leaf}:val ({list-started}:started leaf-path) subtree)
              ;;Return the continuation point:
              ({list-started}:list leaf-path)
              )
      )
    path
   ) 	
  
;;;;;;;;;;;;;;;;;;Annotated tree manipulation.
(defvar #:tree:pathdecor:decor)
(defvar #:tree:pathdecor:destination-tree)

(de #:tree:pathdecor:write (tree filename)
    (#:tree:pathdecor:clean-paths tree)
    ({tree}:save filename tree)
    )

(de #:tree:pathdecor:read (filename dirname)
    ({tree}:restore filename dirname)
    )

(de #:tree:pathdecor:read-and-connect (dirname filename dest-tree)
    (let ((source-tree (#:tree:pathdecor:read dirname filename)))
	 ({tree}:pathdecor:set-paths source-tree dest-tree)
	 )
    )

(de #:tree:pathdecor:clean-paths (tree)
    (when tree
	  (let ((#:tree:pathdecor:decor 
		 (symeval (symbol 'lispdecor
				  ({formalism}:name ({tree}:formalism tree))))
		 ))
	       (#:tree:pathdecor:clean-paths-aux tree)
	       )
	  )
    )

(de #:tree:pathdecor:clean-paths-aux (tree)
    ;;First, remove pointers of all stored paths.
    (when ({decor}:annotep #:tree:pathdecor:decor tree)
	  (let ((path ({decor}:annotvalue #:tree:pathdecor:decor tree)))
	       ({path}:remove-tree-pointers path)
	       )
	  ({tree}:for_all_sons tree '#:tree:pathdecor:clean-paths-aux)
	  )
    )


;;dest-tree is always the root of the tree in which the paths point.
;;Since for_all_sons doesn't take any optional arguments,
;;I store dest-tree in a global variable.

(de #:tree:pathdecor:set-paths (tree dest-tree)
    (let ((#:tree:pathdecor:destination-tree dest-tree)
	  (#:tree:pathdecor:decor 
	   (symeval (symbol 'lispdecor
			    ({formalism}:name ({tree}:formalism tree)))))
	  )
	 (#:tree:pathdecor:set-paths-aux tree)
	 )
    )

(de #:tree:pathdecor:set-paths-aux (tree)
    (when tree
	  ;;First, remove pointers of all stored paths.
	  (when ({decor}:annotep #:tree:pathdecor:decor tree)
		(let ((path ({decor}:annotvalue #:tree:pathdecor:decor tree)))
		     ({path}:set-tree-pointers path #:tree:pathdecor:destination-tree)
		     )
		({tree}:for_all_sons tree '#:tree:pathdecor:set-paths-aux)
		)
	  )
    )

(de #:tree:pathdecor:test (filename)
    (lets ((source-tree
	    (car (#:inter:parse-file filename)))
	   (formalism-name ({formalism}:name ({tree}:formalism source-tree)))
	   (path ({tree}:path ({tree}:down source-tree 1)))
	   )
	  ;;Show tree
	  (print "Source tree:")
	  (ecrirep source-tree)
	  ;;Create a 'path annotation object at the root
	  ({decor}:annotation (#:lispdecor:create-or-return formalism-name)
			      source-tree 
			      path 
			      {lispdecor})
	  (ecrirep source-tree)
	  ;;save tree
	  (#:tree:pathdecor:write source-tree "/tmp/foobargee")
	  ;;restore tree
	  (print "Restored source tree:")
	  (ecrirep (#:tree:pathdecor:read "foobargee" "/tmp"))
	  )
    )