;;    
;;
;;      Title : D-Parse
;;
;;      Function : An active chart parser with dictionary call
;;
;;      Author :   Alan W Black   November 1984
;;                 Dept of A.I.  University of Edinburgh
;;
;;      Copyright Graeme Ritchie, Alan Black,
;;                Steve Pulman and Graham Russell  1987
;;
;;         ---------------------------------------------
;;         |    Not to be used for military purposes   |
;;         ---------------------------------------------
;;             >>>>>  UNRESTRICTED UNIFICATION <<<<<
;;
;;      Description :
;;        This forms the parser (morphology part) of the analyser.
;;
;;        The algorithm is based mainly on that at the end of Chapter 3 
;;        in Winograd  "Language as a cognitive process".  Also
;;        Thompson and Ritchie in O'Shea and Eisenstadt
;;        The unification stuff is along the lines of the HUG system
;;        (Karttunen SRI paper 1985)
;;
;;        The grammar formalism is based on GPSG (Gazdar and Pullum 1982)
;;        and is held in the global variable D-GRAMMAR.
;;
;;        In addition to the normal chart parser these functions
;;        call the morphographemic analyser (D-Recog)  which 
;;        segments words into morphemes using spelling rules.
;;
;;      1.2   13th February 1985
;;        Made changes to try and cut down the search time in GetRules
;;        Now rules are 'typed' into noun verb preposition adjective and other
;;        each typelist is held as a property of D-GRAMMAR.
;;      1.3   28th February 1985
;;        Change parser to run bottom up, and at the same time made
;;        changes to structure of code (although weakly equivalent)
;;      1.5   29th March 1985
;;        No longer expand feature value variables at compile time but
;;        have them instantiated on the fly during parsing. 
;;      1.13  16th December 1985
;;        Try to tidy this up and increase the speed.
;;      1.15  24th February 1986
;;        Try to correct bugs (restrictions) in the unification
;;        algorithm so that derivations have all variables
;;        instantiated where possible.  Also had a go at speed ups
;;        There were so over generalisations that I have now removed.
;;      1.17  3rd April 1986
;;         Made this part only deal with the chart parsing.  The analysis
;;         of the chart is now done by functions in the file analyse.
;;      2.2  14th October
;;         Changed daughter convention to act on each feature
;;         rather than whole group.
;;      2.4  3rd February 1987
;;         Made feature passing conventions work only on binary branching
;;         rules.
;;
;;      Returns:
;;        The initial vertex of the chart
;;
;;      External references :
;;
;;        included by analyse
;;
;;        D-GRAMMAR       This should contain the GPSG(-ish) for the parse
;;        D-Recog
;;          Function with 1 arguments, status of surface form (as
;;          held in a vertex property STATUS)
;;        D-Tokenize
;;          This function is called by the parser to set up the initial
;;          configurations of the string.
;;
;;      System functions used :
;;        Name     type      Args #  type                 Comment
;;
;;      Restrictions :
;;        Variables may only appear in entries if they are unique
;;        within that entry - sorry.
;;

(declare                       ;; declarations for the compiler
   (special
      D-DTREE
      D-CATVALFEAT
      D-GRAMMAR     ;; the fully expanded grammar
      D-UNARYRULES  ;; grammar rules with only one daughter
      D-VARIABLES   ;; the names of the variables in the grammar
      D-ENDVERTEX   ;; end of chart
      D-WHEAD       ;; a list of Head feature names
      D-WDAUGHTER   ;; a list of Daughter feature names 
      D-FSD         ;; feature specification defaults
      D-DISTINGUISHEDCATEGORY ;; top category for grammar
      D-BASICVARIABLES
      D-AGENDA
      D-ALLEDGES
      D-ALLVERTICES
      D-LOOKUPFORMAT
      D-INITVERTEX
      D-Recog       ;; the dictionary call routine (in file autorun)
      D-Tokenize)   ;; make the word into a string to be parsed
   (localf
      D-Parse                         
      D-InitGlobalsChart
      D-InitChart
      D-BuildWholeWFST
      D-AddVertexLinks                
      D-CheckConventions              
      D-ApplyDefaults                 
      D-WSisterConvention             
      D-WHeadConvention               
      D-WDaughterConvention           
      D-GetDaughterFeatures
      D-Propose                       
      D-CreateEdge                    
      D-CreateVertex                  
      D-Combine                       
      D-CombineEdge                   
      D-ExtendChart                   
      D-NextMorpheme                  
      D-BuildEdge                     
      D-GetRules                      
      D-MakeEmptyEdge                 
      D-FindParseTree
      D-ApplySubstitutions              
      D-FindVarValue
      D-CheckWordProp
   )
)

(include "keywords")
(include "unify")

(defun D-Parse (string)
;;
;;  This is the main calling routine.  The chart runs with a bottom up 
;;  policy.
;;
   (let ( (chart nil)
	  (newedge nil)
	  (tokenisedstring (D-Tokenize string)) )
      (D-InitGlobalsChart)
      (D-InitChart D-INITVERTEX tokenisedstring)
      (D-while D-AGENDA
	 (setq newedge (D-CheckConventions (car D-AGENDA)))
         (cond
	    (newedge        ;; if conventions holds then continue
	       (setq D-AGENDA (cdr D-AGENDA))
	       (D-Combine newedge)   ;; combine newedge with rest of chart
	       (setq chart (cons newedge chart))
	       (D-AddVertexLinks newedge)  ;; add pointers to/from vertices
            )
	    (t
	       (setq D-AGENDA (cdr D-AGENDA)) ; drop edge as it failed
            )
         )
      )
      D-INITVERTEX  ;; return the initial vertex
   )
)

(defun D-InitGlobalsChart ()
;;
;;  Initial ise the global variables for the chart
;;
   (setq D-AGENDA nil)
   (setq D-ALLEDGES nil)
   (setq D-ALLVERTICES nil)
   (setq D-INITVERTEX (D-CreateVertex))
   (setq D-ENDVERTEX (D-NewVertex (D-CreateVertex) 'END))
   ;(setq D-VARIABLES (copy D-BASICVARIABLES))
)

(defun D-InitChart (initvertex string)
;;
;;  Sets up the basic chart.  This sets global variables as required
;;  and also adds the basic edges to the agenda.
;;  If a STRINGSEGMENT option for LOOKUPFORMAT is selected the 
;;  whole string is segmented and added to the agenda
;;  in the simple word analysis case only the first morpheme
;;  is added to the chart and the basic chart is extended as required
;;
;;  The chart can be looked at as a search space where ENDVERTEX is
;;  the goal state.  When STRINGSEGMENT type formats are selected this
;;  search space is eagerly evaluated, while in the simple cases it
;;  is lazily evaluated.
;; 
   (let ()
      (cond
	 ((or (eq D-LOOKUPFORMAT 'D-CATEGORYFORM)
	      (eq D-LOOKUPFORMAT 'D-WORDSTRUCTURE))
            (D-NextMorpheme     ;; get the first morpheme(s) on the agenda
               (D-NewVertex     ;; create first vertex in chart
	           initvertex
	           string       ;; the words to be parsed
	        )
	        string
            )  
            (D-putvertexCLASSES initvertex 't) ;; mark this node as checked
         )
	 (t    ;; have to find whole segmentations 
	    (D-BuildWholeWFST 
	       (D-NewVertex initvertex string))
         )
      )
   )
)

(defun D-BuildWholeWFST (initvertex)
;;
;;  Builds the whole well formed substring table.  This is called
;;  when STRINGSEGMENT options have been selected for the look
;;  up format.  This effectively builds the whole search space
;;  rather than on on demand as it does in the non-STRINGSEGMENT cases.
;;
   (let ( (agenda (ncons initvertex)) )
      (D-repeat
      (
	 (cond
	    ((not (or (D-getvertexCLASSES (car agenda))
	              (eq (D-getvertexSTATUS (car agenda)) 'END)))
             (D-putvertexCLASSES (car agenda) 't)
             (setq agenda   ;; deal with first vertex on agenda
		(append
                   (mapcar      ;; create new edge for each new morpheme
                      #'(lambda (word)
                          (D-BuildEdge word (car agenda))
			  (cond
			     ((eq (cadr word) 'END) D-ENDVERTEX)
			     (t (car D-ALLVERTICES)) ;; the last made vertex
	                  ))
                      (D-Recog (D-getvertexSTATUS (car agenda))))
                   (cdr agenda)))
            )
	    (t     ;; the vertex has been checked or is at END
	       (setq agenda (cdr agenda))
            )
        )
      )
      until (null agenda))
   )
)
 
(defun D-AddVertexLinks (edge)
;;
;;   Add the edge to the list held on each vertex for complete and
;;   incomplete edges going in and out
;;
   (cond
      ((null (D-getedgeREMAINDER edge))      ;; is this edge complete
	 (D-putvertexEDGEOUTC   ;; add to list of complete edges starting
	    (D-getedgeSTART edge)
	    (cons
	       edge
	       (D-getvertexEDGEOUTC
		  (D-getedgeSTART edge))))
      )
      (t                ;; incomplete edges
	 (D-putvertexEDGEINI ;; add to list of complete edges ending
	    (D-getedgeEND edge)
	    (cons
	       edge
	       (D-getvertexEDGEINI 
		  (D-getedgeEND edge))))
      )
   )
)

(defun D-CheckConventions (edge)
;;
;;    this checks the three feature passing conventions for the given
;;    edge.  If the edge is incomplete no checking is done
;;    The conventions only work on BINARY branching rules.
;;    The three passing conventions are
;;    Wsister
;;       This is a check rather than passing features.  Of the two
;;       daughters.  The value (a category value) of the feature STEM
;;       which one and only one will have must be a subset of the label
;;       of the other daughter
;;    Whead
;;       The mother label should be the unification of the current
;;       mother label and the whead features of the right daughter
;;    Wdaughter
;;       For each feature in this class if it is in the right daughter
;;       it is copied up to the mother, if not the left daughter is
;;       checked and if their it is copied up to the mother.
;;
;;    This also instantiates all variables to their lowest form
;;    which may be a literal or a variable.  This is so in later
;;    matches time is saved when finding the value of variables
;;
;;
   (cond
      ((or (D-getedgeREMAINDER edge)     ;; is it incomplete
	   (D-LexicalEdgeP edge))    ;; or a lexical edge
	 edge                    ;; no checking of conventions required
      )
      ((eq 2 (length (D-getedgeRECOG edge)))  ;; binary branching rule
	 (let ((bind (D-WSisterConvention
	                (D-LeftDaughter edge)
			(D-RightDaughter edge)
			(D-getedgeBIND edge))))
            (cond
	       ((null bind) nil)         ;; failed sister convention
	       (t
		  (D-putedgeBIND edge bind)
	          (D-WHeadConvention edge)
	          (D-WDaughterConvention edge)
	          (D-ApplyDefaults edge)   ;; check if unification was valid
		  (cond
		     ((eq 'FAILED (D-getedgeLABEL edge)) nil)
		     (t
			(D-putedgeLABEL;; simplify label removing var chains
			   edge
			   (D-DereferenceVariables
			      (D-getedgeLABEL edge)
			      (D-getedgeBIND edge)
			   )
			)
			edge))))))
      (t                        ;; other lengthed rule
	 (D-ApplyDefaults edge)
	 (D-putedgeLABEL;; simplify label removing var chains
	    edge
	    (D-DereferenceVariables
	       (D-getedgeLABEL edge)
	       (D-getedgeBIND edge)
	    )
	 )
	 edge)
   )
)

(defun D-ApplyDefaults (edge)
;;
;;  checks to see if the last unification was valid.  Returns the
;;  edge if valid, nil otherwise. If valid then adds  the feature
;;  defaults if required.
;;
   (cond
      ((eq 'FAILED (D-getedgeLABEL edge))
	 nil      ;; WDaughter conventioned failed so no need for defaults
      )
      ((null D-FSD)
	 edge
      )
      (t
	 (let ( (label (D-getedgeLABEL edge))
	        (bindings (D-getedgeBIND edge)) )
	    (mapc
	       #'(lambda (fsd)
	          (let ((unified (D-Unify label bindings (list fsd))))
	             (cond
	                ((neq unified 'FAILED) 
			   (setq label (car unified))
			   (setq bindings (cadr unified))))))
               D-FSD)
            (D-putedgeLABEL edge label)
	    (D-putedgeBIND edge bindings))
      )
   )
)

(defun D-WSisterConvention (category1 category2 bindings)
;;
;;  This checks to see if the given two categories follow the 
;;  Wsister conventions and hence can be possibly combined to 
;;  form a triangle
;;  The wsister convention is.  Whichever category has the feature
;;  STEM the other category must be an extension of the value of
;;  STEM
;;
;;  returns nil if fail or t (or non-nil list) if convention ok
;;  new set of bindings for that edge
;;
   (cond
      ((D-HasFeature (DK-STEM) category2)           ;; suffix
	 (D-IsExtensionOf
	    (D-GetFeatureValue (DK-STEM) category2)
	    bindings
	    category1
         )
      )
      ((D-HasFeature (DK-STEM) category1)           ;; prefix 
	 (D-IsExtensionOf
	    (D-GetFeatureValue (DK-STEM) category1)
	    bindings
	    category2
         )
      )
      (t    ;; this is when neither category has an affix feature
	 bindings ;; this would occur with a non affix morpheme combination
      )
   )
)

(defun D-WHeadConvention (edge)
;;
;;   operates the WHead convention.  the LABEL property may be
;;   set to FAILED in the Unification fails
;;   Note that in English the head is always the right daughter
;;   i.e. the suffix or the stem (in the case of a prefix).
;;
   (cond
      ((null D-WHEAD) edge)   ;; no head features
      (t
         (let  ( (unified (D-Unify (D-getedgeLABEL edge)
			     (D-getedgeBIND edge)  ;; rd binds not needed
			     (D-HeadFeatures (D-RightDaughter edge)))) )
	    (cond
	       ((eq unified 'FAILED)
		  (D-putedgeLABEL edge 'FAILED))
	       (t
		  (D-putedgeBIND edge (cadr unified))  ;; new bindings
		  (D-putedgeLABEL edge (car unified))  ;; new unification
	       )))))
)

(defun D-WDaughterConvention (edge)
;;
;;  operates the WDaughter Convention.  Also checks the previous 
;;  operation on the mother label.
;;
;;
   (cond
      ((eq 'FAILED (D-getedgeLABEL edge))
	 nil          ;; WHead convention failed 
      )
      ((null D-WDAUGHTER) edge)   ;; none to deal with
      (t
	 (let ( (unified
		  (D-Unify
		     (D-getedgeLABEL edge)   ;; mother
		     (D-getedgeBIND edge)    ;; bindings
		     (D-GetDaughterFeatures 
			(D-LeftDaughter edge)
			(D-RightDaughter edge)))) )
	    (cond
	       ((eq unified 'FAILED)
		  (D-putedgeLABEL edge 'FAILED))
               (t
	          (D-putedgeBIND edge (cadr unified))  ;; new bindings
                  (D-putedgeLABEL edge (car unified))  ;; new unification
               )
            )
         )
      )
   )
)

(defun D-GetDaughterFeatures (leftdaughter rightdaughter)
;;
;;  Returns category of that is the wduaghter features, i.e. the
;;  values from the right daughter is there or from the left
;;  if there.
;;
   (let ( (rightdfeats (D-WDaughterFeatures rightdaughter)) )
      (cond
	 ((null rightdfeats)   ;; efficiency call
	    (D-WDaughterFeatures leftdaughter)) 
         (t
	    (nconc
	       rightdfeats
	       (mapcan     ;; get those from left daughter
		  #'(lambda (fpair)
		     (cond
			((D-HasFeature (car fpair) rightdfeats)
			   nil)
                        ((D-DaughterFeatureP (car fpair))
			   (ncons fpair))
                        (t nil)))
                  leftdaughter))
         )
      )
   )
)

(defun D-Propose (symbol vertex endvertex)
;;
;;  This function proposes the given symbol/vertex by looking up
;;  the grammar for the new rules from this vertex. Left recursion
;;  check is done in CHeckConventions when the edge is added to 
;;  the chart.
;;  returns list of empty edges for each rule added at this vertex
;;
;;  if endvertex is marked as END (no more continuing) only the unary
;;  rules are checked.  This should save some time
;;
;;
   (cond
      ((eq 'END (D-getvertexSTATUS endvertex))
         (D-GetRules
            symbol      ;; first category in its RHS.
            vertex
            D-UNARYRULES  ;; get appropriate rules
         ))
      (t
         (D-GetRules    ;; Find all rules in the grammar with symbol as its
            symbol      ;; first category in its RHS.
            vertex
            D-GRAMMAR  ;; get appropriate rules
         )
      )
   )
)

(defun D-CreateEdge (Plabel Pstart Pend Premainder Precog 
				   Prulenum bindings)
;;
;;  This returns a new edge with the properties set to the
;;  given parmeters
;;
;;  Automatically puts it on the agenda.
;;
;;  19th December 1985:  change to be a structure rather than 
;;  property lists
;;
   (let ((newedge
            (D-MakeEdge Plabel Pstart Pend Premainder 
		  Precog Prulenum bindings nil)) )
      (setq D-AGENDA (cons newedge D-AGENDA))
      (setq D-ALLEDGES (cons newedge D-ALLEDGES))
      newedge
   )
)

(defun D-CreateVertex ()
;;
;;   returns an empty vertex with a new number at its end
;;   vertices are access via macros declared in subtout
;;
   (let ((newvertex
	       (D-MakeVertex
		  nil         ;; classes
		  nil         ;; incomple edges in
		  nil         ;; complete edges out
		  nil         ;; status
		  nil         ;; list of edges out
		  (gensym 'D) ;; name field possibly used in debugging
               )))
      (setq D-ALLVERTICES (cons newvertex D-ALLVERTICES))
      newvertex
   )
)

(defun D-Combine (newedge)
;;
;;  This combines the new edge with the edges in the chart
;;  returns a list of combined edges to add to the agenda
;;
   (cond
      ((null (D-getedgeREMAINDER newedge))   ;; is edge complete (inactive)
	                    ;; then find all edges in the chart this can
         (mapc
            #'(lambda (incompletedge)  
               (D-CombineEdge newedge incompletedge))
            (D-getvertexEDGEINI             ;; appropriate edges in chart
               (D-getedgeSTART newedge))
         )
         (D-Propose                   ;; If there are not grammar rules
            (D-getedgeLABEL newedge)  ;; yet in the chart for this symbol
            (D-getedgeSTART newedge)  ;; at this vertex then add to Agenda
	    (D-getedgeEND newedge)   
         )
      )
      (t                      ;; newedge is incomplete
	 (D-ExtendChart              ;; continue Outgoing edges and extend
	    newedge                ;; chart if need be
	    (D-getedgeEND newedge)    ;; vertex to extend from 
         )
      )
   )
)

(defun D-CombineEdge (inactiveedge activeedge)
;;
;;  This tries to combine the edges, this returns nil if the 
;;  edges do not combine, if they do this returns the new edge    
;;
;;  if this activeedge cannot be extended by inactiveedge 
;;  then nil is returned
;;
   (cond
      ;; don't check a complete ending edge against an active one that 
      ;; cannot complete with this inactive edge
      ((or (neq 'END (D-getvertexSTATUS (D-getedgeEND inactiveedge)))
	   (null (cdr (D-getedgeREMAINDER activeedge))))
	 (let ( (match
		  (D-Unify
		     (car (D-getedgeREMAINDER activeedge));; required category
		     (D-getedgeBIND activeedge)
		     (D-getedgeLABEL inactiveedge) 
		  )) )
	    (cond
	       ((eq match 'FAILED) nil) ;; failed match
	       (t
		  (D-CreateEdge
		     (D-getedgeLABEL activeedge)    
		     (D-getedgeSTART activeedge)
		     (D-getedgeEND  inactiveedge)
		     (cdr (D-getedgeREMAINDER activeedge))
		     (append                     ;; this is the parse tree
			(D-getedgeRECOG activeedge);; recognised from old edge
			(ncons
			   (list
			      (car match)  ;; the result of the unification
			      inactiveedge)) ;;add name of newly recognised edge
		     )
		     (D-getedgeRULENUM activeedge)  ;; rule number of this edge
		     (cadr match)   ;; the bindings
		  )
	       )
	    )
	 )
      )
      (t nil)     ;; not a suitable edge
   )
)

(defun D-ExtendChart (newedge vertex)
;;
;;   When dealing with incomplete edges and looking for things
;;   to extend newedge, if the dictionary has never been checked
;;   from this point then the next morpheme function is called and the
;;   the new morpheme(s) edges are added to the agenda for returning
;;
;;   At present we only have one morpheme dictionary so
;;   the marker in CLASSES on the vertex is just a flag
;;
;;
   (mapc
      #'(lambda (completedge)   ;; new edge in can combine
           (D-CombineEdge completedge newedge))
      (D-getvertexEDGEOUTC (D-getedgeEND newedge))
   )
   (D-if (null (D-getvertexCLASSES vertex)) ;; check dictionary ?
   then
      (D-putvertexCLASSES vertex 't)
      (D-NextMorpheme    ;; check for new morphemes
	 vertex
         (D-getvertexSTATUS vertex) ;;  remainder of surface string at the 
      )                       ;;  vertex
   )
)

(defun D-NextMorpheme (vertex word)
;;
;;  This function returns a list of new edges, one for each
;;  morpheme found in the morpheme dictionary
;;
   (cond
      ((eq 'END word)   ;; no more to look up
	 nil
      )
      (t             ;; find next morphemes and 
          (mapc      ;; create new edge for each new morpheme
             #'(lambda (word)
                 (D-BuildEdge word vertex))
             (D-Recog word))   ;; call morpheme segmenter
      )
   )
)

(defun D-BuildEdge (word vertex)
;;
;;  The thing returned from the Recog function has a list of
;;  entries that have the same citation form.  An edge needs to be
;;  built for each entry from the given vertex to a new one
;;  returns the new vertex
;;
   (let ( (newvertex nil) )
      (cond
	 ((eq (cadr word) 'END)     ;; if end of chart
	    (setq newvertex D-ENDVERTEX))
         (t                         ;; not end of chart
	    (setq newvertex (D-NewVertex (D-CreateVertex) (cadr word)))))
      (mapc
	 #'(lambda (entry)
              (D-CreateEdge
                 (D-Syntax-Field entry) ;; label: feature list       
                 vertex                 ;; Start Vertex
                 newvertex              ;; End vertex
                 nil                    ;; Remainder - inactive edge
                 nil                    ;; no sub edges as terminal
                 entry                  ;; lexical entry
                 '((t t)))                   ;; no bindings
           )
         (car word)    ;; the list of entries with same citation form
      )
      newvertex    ;; returns the (possible) new vertex
   )
)

(defun D-GetRules (name vertex rules)
;;
;;   This looks up the Name in the given rules and finds all
;;   rules that name is an extension of the first category in its
;;   right hand side.
;;   Returns list of of rules that match.  Note no bindings are
;;   passed back.  This means the unification is done twice but also
;;   mena you do not have to worry about rules being added to the
;;   chart only for particular categories.
;;
;;   Also Lauri's point (in the HUG paper) is taken, that is the
;;   unistantiated constituent of the rule is matched against
;;   the grammar rather than the current instantiation so that
;;   all rules that could match are found this time.
;;
;;   The rule is marked to say if it contains variables so that
;;   D-UniquifyVariables is only expensive if it does contain
;;   variables.
;;   
   (cond
      ((null rules) nil)
      (t
	 (mapc
	    #'(lambda (rname)
	       (cond
		  ((memq rname (D-getvertexRULES vertex)) nil)
		  (t
		     (let ( (rule (D-RNametoRule rname rules)) )
			(cond
			   ((null rule) nil)   ;; not an appropriate rule
			   (t
			      (D-MakeEmptyEdge
				 (D-UniquifyVariables rule)
				    vertex)))))))
	    (D-MatchWithDList name (copy (car D-DTREE)) (cdr D-DTREE))
	 )
      )
   )
)

(defun D-MakeEmptyEdge (rule vertex)
;;
;;   This creates an empty edge for the given rule
;;
;;   This marks the vertex with the rule name to stop the rule
;;   being added again at this vertex.  This is for the
;;   left recursion check
;;   Note that this means that the RULES field in vertex holds 
;;   both chart and agenda edges.  This is what is required.
;;
   (D-putvertexRULES vertex  
      (cons (car rule) (D-getvertexRULES vertex)))
   (D-CreateEdge
      (cadr rule) ;; label name
      vertex      ;; start vertex
      vertex      ;; end vertex
      (cddr rule) ;; remainder  (whole RHS)
      nil         ;; currently recognised
      (car rule)  ;; rule number
      '((t t))    ;; no bindings
   )
)

 
(defun D-FindParseTree (cat edge bindings)
;;
;;   This finds the parse tree of the given edge by recursing down
;;   edges within the recog part of this edge
;;
   (cond
      ((D-LexicalEdgeP edge)  ;; lexical entry (rather than rule)
	 (list
	    ;(D-Syntax-Field (D-getedgeRULENUM edge))
	    cat
	    'ENTRY
	    (D-getedgeRULENUM edge)   ;; the lexical entry
	 ) 
      )
      (t
	 (cons
	    (D-ApplySubstitutions
	       cat                      ;; the current category
	       bindings)
	    (cons
	       (D-getedgeRULENUM edge)  ;; rule used
	       (mapcar
		  #'(lambda (daughter)
		       (D-FindParseTree
			  (D-ApplySubstitutions 
			     (car daughter) bindings) ;; the category
			  (cadr daughter) ;; the sub edge
			  (cons (D-getedgeBIND (cadr daughter)) bindings)))
		  (D-getedgeRECOG edge))))
      )
   )
)

(defun D-ApplySubstitutions (category bindings)
;;
;;  This substitutes all variables in the given category for
;;  values by looking (hierarchically) through the given list
;;  of bindings.  Note that the binds are a list of bindings
;;  from each ancestor in the parse tree
;;
;;
   (mapcar
      #'(lambda (fpair)
      (let ( (realitem (D-FindVarValue (cadr fpair) bindings)) )
	 (cond
            ((and (not (D-VariableP realitem))
		  (D-CatValFeatP (car fpair)))
	       (list
		  (car fpair)
		  (D-ApplySubstitutions realitem bindings)))
            (t (list (car fpair) realitem)))))
      category
   )
)

(defun D-FindVarValue (term bindings)
;;
;;  checks the bindings for a value of term
;;  the bindings is a list of a list of bindings and they are searched
;;  upwards until a literal value is found
;;
;;  if it is an unbound variable return <UNBOUND-VARIABLE> and the 
;;  variable range
;;
   (cond
      ((null bindings)
	 (cond
	    ((D-VariableP term) 
	       (cons
		  (car term)
	          (cons '<UNBOUND-VARIABLE>
		  (D-GetVarRange term))))
	    (t term))   ;; no more to search
      )
      (t
	 (let ( (bind (D-FindType term (car bindings))) )
	    (cond
	       ((eq (car bind) 'LITERAL)
		  (cadr bind)   ;; return the literal value
               )
	       (t       ;; it is a variable at this level so search
		  (D-FindVarValue   ;; search further in the bindings
		     (cadr bind) 
		     (cdr bindings)))))
      )
   )
)

(defun D-CheckWordProp (edge)
;;
;;  checks if the given edge has a label that is an extension
;;  of the DISTINGUISHEDCATEGORY.
;;
;;  returns (edge) if it is nil otherwise
;;  
   (let ( (bind (D-IsExtensionOf
                    D-DISTINGUISHEDCATEGORY
                   (D-getedgeBIND edge)
                   (D-getedgeLABEL edge))) )
      (cond
         ((null bind) nil)  ;; not extension of DC
         (t 
            (D-putedgeBIND edge bind)   ;; save bindings accordingly
            (ncons edge)                ;; valid parse
         )
      )
   )
)

