;;
;;
;;      Title : Subrout 
;;
;;      Function : Subroutines for category and edge access
;;                 and other miscellaneous functions
;;
;;      Author : Alan W Black   April 1985
;;               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   |
;;         ---------------------------------------------
;;
;;      Description :
;;
;;      Parameters :
;;      Returns :
;;      Side Effect :
;;
;;      External references :
;;
;;      System functions used :
;;        Name     type      Args #  type                 Comment
;;
;;      Restrictions :
;;
;;

(declare
   (special
      D-ENTRYFILEID
      D-INCLUDESTACK
      D-INCLUDEFILES
      D-CurrentExpress
      D-fileid
      D-CATVALFEAT
      D-WDAUGHTER
      D-WHEAD
      D-FEATURES
      D-VARIABLES
      D-ALIASES
      D-LOADEDPARTS
      D-LASTSYMBOL
      D-GLOBALENVIRONMENT
      D-BASICVARIABLES
      D-DISTINGUISHEDCATEGORY
      D-LCATEGORIES
      D-NONINFLECTS
      D-FSD
      D-SIMPLELEXICON
      D-GRAMMAR
      D-MORPHOLOGYONLY
      D-TRANSITIONSLIST
      D-UNUSUALFEASIBLES
      D-SURFTOLEXSETS
      D-SURFACEALPHABET
      D-LEXICALALPHABET
      D-AUTOSYMBOLS
      D-VARIABLENUMBERS
      D-DTREE
      D-CATEGORYDEFINITIONS
      D-CANMAKE
   )
   (localf
      D-AddOrigin
      D-PopInclude                    
      D-PushInclude                   
      D-NewVertex                     
      D-Subset                        
      D-ReadLexicalEntry
      D-errmsg                        
      D-IntersectVar
      D-union                         
      D-intersection                  
      D-ldifference                   
      D-RemoveDuplicates              
      D-MarkUnLoad                    
      D-MarkLoaded                    
      D-IsPattVariable
      D-PattBinding
      D-RemoveFeature
      D-RemoveAlias
      D-SaveGlobalEnvironment
      D-RestoreGlobalEnvironment
      D-PList
      D-RNametoRule
   )
)

(defmacro D-GetFeature (feat cat)
;;
;;  returns nil if category does not contain the feature.  Non-nil
;;  other wise
;;  This is the same has D-HasFeature but the different name 
;;  is used to distinguish its usage
;;
   `(assq 
      ,feat               ;; feature name
      ,cat)               ;; category
)

(defmacro D-HasFeature (feat cat)
;;
;;  returns nil if category does not contain the feature.  Non-nil
;;  other wise
;;
   `(assq 
      ,feat               ;; feature name
      ,cat)               ;; category
)

(defmacro D-GetFeatureValue (feat cat)
;;
;;   returns the value of the given feature in the category
;;
   `(cadr 
      (assq 
	 ,feat       ;; feature name
	 ,cat))      ;; category
)

(defmacro D-MakePairToken (pair)
;;
;;  This is a marco that expands expands to create a token
;;  out of the pair.  This is the concatenation of the characters
;;  witha D on the front.  The is required to get round the
;;  bug in the liszt compiler regarding escape characters
;;
   `(concatl (cons 'D ,pair))
)

;;
;;   An edge is a 6-tuple made up of
;;   ( LABEL         a category
;;     START         the start vertex
;;     END           the end vertex
;;     REMAINDER     list of remaining required categories
;;     RECOG         list of categories recognised so far
;;     RULENUM       number fo rule used for this edge (-1 if terminal)
;;     BIND          any bindings required for daughters
;;     NAME          name of edge for printing purposes
;;   )
;;

(defmacro D-MakeEdge (label start end remainder recog rulenum bindings name)
;;
;;  Simply returns a list structure
;;
   `(list ,label ,start ,end 
	  ,remainder ,recog ,rulenum
	  ,bindings ,name)
)

(defmacro D-putedgeLABEL (edge newlabel)
;;
;;   set the LABEL of an edge
;;   use: (D-putedgeRULENUM edge value)
;;
   `(rplaca ,edge ,newlabel)
)

(defmacro D-putedgeSTART (edge start)
;;
;;   set the START vertex of an edge
;;
   `(rplaca (cdr ,edge) ,start)
)

(defmacro D-putedgeEND (edge end)
;;
;;   set the END vertex of an edge
;;
   `(rplaca (cddr ,edge) ,end)
)

(defmacro D-putedgeREMAINDER (edge remain)
;;
;;   set the REMAINDER of an edge
;;
   `(rplaca (cdddr ,edge) ,remain)
)

(defmacro D-putedgeRECOG (edge recog)
;;
;;   set the RECOG of an edge
;;
   `(rplaca (cdddr (cdr ,edge)) ,recog) 
)

(defmacro D-putedgeRULENUM (edge rulenum)
;;
;;   set the RECOG of an edge
;;
   `(rplaca (cdddr (cddr ,edge)) ,rulenum)
)

(defmacro D-putedgeBIND (edge bind)
;;
;;   set the BIND of an edge
;;
   `(rplaca (cdddr (cdddr ,edge)) ,bind)
)

(defmacro D-putedgeNAME (edge name)
;;
;;   set the NAME of an edge
;;
   `(rplaca (cdddr (cdddr (cdr ,edge))) ,name) 
)

(defmacro D-getedgeLABEL (edge)
;;
;;  get the LABEL of an edge
;;
   `(car ,edge)
)

(defmacro D-getedgeSTART (edge)
;;
;;  get the START of an edge
;;
   `(cadr ,edge)
)

(defmacro D-getedgeEND (edge)
;;
;;  get the END of an edge
;;
   `(caddr ,edge)
)

(defmacro D-getedgeREMAINDER (edge)
;;
;;  get the REMAINDER of an edge
;;
   `(caddr (cdr ,edge))
)

(defmacro D-getedgeRECOG (edge)
;;
;;  get the RECOG of an edge
;;
   `(caddr (cddr ,edge))
)

(defmacro D-getedgeRULENUM (edge)
;;
;;  get the RULENUM of an edge
;;
   `(caddr (cdddr ,edge))
)

(defmacro D-getedgeBIND (edge)
;;
;;  get the NAME of an edge
;;
   `(caddr (cdddr (cdr ,edge)))
)

(defmacro D-getedgeNAME (edge)
;;
;;  get the NAME of an edge
;;
   `(caddr (cdddr (cddr ,edge)))
)

;;
;;   A vertex is a quintuple with fields of the form
;;   ( CLASSES    list of which morpheme dictionaries have been searched
;;     EDGEINI    list of incomplete edges into the vertex
;;     EDGEOUTC   list of complete edges out of the vertex
;;     STATUS     the remaining surface string and automata configuration
;;     RULES      list of rulenames that have been proposed at this vertex
;;     NAME       atomic name
;;   )
;;

(defmacro D-MakeVertex (classes edgeini edgeoutc status rules name)
;;
;;  returns a simple list structure
;;
   `(list
      ,classes ,edgeini ,edgeoutc ,status ,rules ,name)
)

(defmacro D-putvertexCLASSES (vertex classes)
;;
;;  change a vertexs classes list
;;   use: (D-putvertexCLASSES vertex classes)
;;
   `(rplaca ,vertex ,classes)
)

(defmacro D-putvertexEDGEINI (vertex edgeini)
;;
;;  change a vertex's incomplete edges in field
;;
   `(rplaca (cdr ,vertex) ,edgeini)
)

(defmacro D-putvertexEDGEOUTC (vertex edgeoutc)
;;
;;  change a vertex's complete edges out field
;;
   `(rplaca (cddr ,vertex) ,edgeoutc)
)

(defmacro D-putvertexSTATUS (vertex status)
;;
;;  change a vertex's STATUS field
;;
   `(rplaca (cdddr ,vertex) ,status)
)

(defmacro D-putvertexRULES (vertex status)
;;
;;  change a vertex's RULES field
;;
   `(rplaca (cdddr (cdr ,vertex)) ,status)
)

(defmacro D-putvertexNAME (vertex name)
;;
;;  change a vertex's NAME field
;;
   `(rplaca (cdddr (cddr ,vertex)) ,name)
)

(defmacro D-getvertexCLASSES (vertex)
;;
;;   gets the value of the CLASSES field in a vertex
;;
   `(car ,vertex)
)

(defmacro D-getvertexEDGEINI (vertex)
;;
;;   gets the value of the incomplete incoming edges field in a vertex
;;
   `(cadr ,vertex)
)

(defmacro D-getvertexEDGEOUTC (vertex)
;;
;;   gets the value of the complete outgoing edges field in a vertex
;;
   `(caddr ,vertex)
)

(defmacro D-getvertexSTATUS (vertex)
;;
;;   gets the value of the status field in a vertex
;;
   `(caddr (cdr ,vertex))
)

(defmacro D-getvertexRULES (vertex)
;;
;;   gets the value of the rules field in a vertex
;;
   `(caddr (cddr ,vertex))
)

(defmacro D-getvertexNAME (vertex)
;;
;;   gets the value of the rules field in a vertex
;;
   `(caddr (cdddr ,vertex))
)


(defmacro D-GetGRuleName (rule)
;;
;;  returns the name of a full grammar rule
;;
   `(cadr ,rule)
)

(defmacro D-GetGRuleCategories (rule)
;;
;;   returns the mother and daughters of a full rule
;;
   `(cddr ,rule)
)

(defmacro D-GetGRuleMother (rule)
;;
;;   returns the mother category of a full rule
;;
   `(caddr ,rule)
)

(defmacro D-GetGRuleFirstDaughter (rule)
;;
;;   returns the first daughter category of a full rule
;;
   `(caddr (cdr ,rule))
)

(defmacro D-GetGRuleVarFlag (rule)
;;
;;   returns the has variables flag of a full grammar rule
;;
   `(car ,rule)
)

(defmacro D-LeftDaughter (edge)
;;
;;   Returns the label of the leftmost daughter of the edge
;;
   ;`(D-getedgeLABEL (car (D-getedgeRECOG ,edge)))
   `(car (car (D-getedgeRECOG ,edge)))
)

(defmacro D-RightDaughter (edge)
;;
;;   this returns the label of the second daughter of an edge    
;;
   ;`(D-getedgeLABEL (cadr (D-getedgeRECOG ,edge)))
   `(car (car (last (D-getedgeRECOG ,edge))))
)

(defmacro D-LexicalEdgeP (edge)
;;
;;  returns true if the given edge is a lexical edge
;;  (that is if the rule number is a list (lexical entry))
;;
   `(listp (D-getedgeRULENUM ,edge))
)

(defmacro D-VariableP (var)
;;
;;  returns non-nil if var is a variable
;;      nil otherwise
;;
   ;`(assq ,var D-VARIABLES)
   `(and (listp ,var) (numberp (car ,var)))
)

(defmacro D-DeclaredVariableP (var)
   `(assq ,var D-VARIABLES)
)

(defmacro D-FvrP (fvr)
;;
;;  returns non-nil if fvr is a feature variable range
;;      nil otherwise
;;  D-FVR's value is a disembodied property list
;;
   `(assq ,fvr  D-FVRS)
)

(defmacro D-FeatureP (feat)
;;
;;  returns non-nil if feat is a feature name
;;      nil otherwise
;;  D-FEATURES's value is a disembodied property list
;;
   `(and (atom ,feat)
        (assq ,feat D-FEATURES))
)

(defmacro D-AliasP (ali)
;;
;;  returns non-nil if ali is an alias
;;      nil otherwise
;;  D-ALIASES's value is a disembodied property list
;;
   `(and (atom ,ali)
        (assq ,ali D-ALIASES))
)

(defmacro D-CatValFeatP (feature)
;;
;;  returns non-nil if feature is a category valued feature
;;      nil otherwise
;;
   `(memq ,feature D-CATVALFEAT)
)

(defmacro D-HeadFeatureP (featurename)
;;
;;   returns non-nil if this name is a head feature
;;
   `(memq ,featurename D-WHEAD)
)

(defmacro D-DaughterFeatureP (featurename)
;;
;;   returns non-nil if this name is a daughter feature
;;
   `(memq ,featurename D-WDAUGHTER)
)

(defmacro D-GetDeclVarRange (var)
;;
;;  returns the range of the variable (nil if not a variable)
;;  note value of D-VARIABLES is an a-list.  Note var MUST be 
;;  known variable
;;
   `(cadr (assq ,var D-VARIABLES))
)

(defmacro D-GetVarRange (var)
   `(cdr ,var))

(defmacro D-GetFeatRange (feature)
;;
;;  returns the range of the feature (nil if not a feature)
;;  note value of D-FEATURES is an alist.  feature must be a
;;  real one
;;
   `(cadr (assq ,feature D-FEATURES))
)

(defmacro D-GetFvrRange (fvr)
;;
;;  returns the range of the fvr (nil if not an fvr)
;;  D-FVRS's value is an alist
;;
   `(cadr (assq ,fvr D-FVRS))
)

(defmacro D-GetAlias (ali)
;;
;;  returns the value of the alias
;;      nil otherwise
;;  D-ALIASES's value is an alist
;;
   `(cadr (assq ,ali D-ALIASES))
)

(defmacro D-FeatureValueP (fname fvalue)
;;
;;   returns non-nil if value is a valid value of the given feature name
;;   nil otherwise
;;   D-FEATURES's value is an alist
;;
   `(memq  
      ,fvalue
      (cadr (assq ,fname D-FEATURES))
   )
)

(defmacro D-LexHead (lexicon)
;;
;;  gets the head character from a lexicon
;;
   `(car ,lexicon)
)

(defmacro D-LexSubs (lexicon)
;;
;;  gets the list of sub lexicons from a lexicon
;;
   `(cdr ,lexicon)
)

(defmacro D-PossibleLexChars (schar)
;;
;;   returns the possible lexical correspondances to the given
;;   surface character.  Not it is assumed that it is given a valid
;;   surface character.
;;
   `(cdr (assq ,schar D-SURFTOLEXSETS))
)

(defmacro D-SplitIntoChars (word)
;;
;;  takes the given atom and returns the a list of characters 
;;  that represent the it.  This removes quotes from the string
;;
   `(aexplodec ,word)
)

(defmacro D-LicenceP (state)
;;
;;   This returns true if the state is a licence state
;;   nill otherwise.  this is done by returning the licence flag
;;   of the state
;;
   `(cadar ,state)
)

(defmacro D-TerminalP (state)
;;
;;   This returns the Terminal flag of a state
;;
   `(caar ,state)
)

(defmacro D-FinalP (state)
;;
;;   This returns the final flag of a state
;;
   `(caddr (car ,state))
)

(defmacro D-StateName (state)
;;
;;   This returns the state name
;;
   `(caddr (cdar ,state))
)

(defun D-GetOrigins (state)
;;
;;   this returns a list of the names of the spelling rules that
;;   created the given state
;;
;;   This is a function (rather than a macro) so it can be applied
;;
   (caddr (cddar state))
)

(defun D-AddOrigin (name state)
;;
;;  adds teh name to the list of origins of the given state
;;  destructively
;;  returns the state
;;
   (rplacd
      (D-GetOrigins state)
      (ncons name)))

(defmacro D-MakeNewVariable (newrange)
;;
;;   Adds a new variable to the variable list
;;
   ;`(let ( (newvar (gensym 'D)) )
      ;(setq D-VARIABLES (cons (list newvar newrange) D-VARIABLES))
      ;newvar
   ;)
   `(cons
      (setq D-VARIABLENUMBERS (+ 1 D-VARIABLENUMBERS))
      ,newrange)
)

(defun D-PopInclude ()
;;
;;  checks to see if the reader is really at the end of the files
;;  or just at the end of some include file
;;
   ;(print D-INCLUDESTACK)
   (cond
      ((null D-INCLUDESTACK)   ;; any old files to finish looking at
         'EOF 
      )
      (t
	 (close D-fileid)
         (setq D-fileid (car D-INCLUDESTACK))
         (setq D-INCLUDESTACK (cdr D-INCLUDESTACK))
         (setq D-INCLUDEFILES (cdr D-INCLUDEFILES))
	 (setq D-LASTSYMBOL nil)
	 (princ "done") (terpri)
      )
   )
)

(defun D-PushInclude (filename)
;;
;;  pushs current file id onto D-INCLUDESTACK and opens
;;  the new file
;;
   (setq D-INCLUDESTACK
      (cons D-fileid D-INCLUDESTACK))
   (setq D-INCLUDEFILES
      (cons filename D-INCLUDEFILES))
   ;(print D-INCLUDESTACK)
   (setq D-fileid (infile filename)) ;; open new file
   (princ (concat "Including " filename " : ")) (terpri)
)

(defun D-NewVertex (vertex status)
;;
;;  This creates a new vertex with the given status, and
;;  an empty class list
;;
;;
   (D-putvertexSTATUS vertex status)
   vertex      ;; return name
)

(defun D-Subset (set1 set2)
;;
;;  set theory subset, returns true if all members of set1
;;  are members of set2
;;
   (not 
      (member nil
	 (mapcar
	    (function (lambda (element)
	       (member element set2)
            ))
	    set1
         )
      )
   )
)

(defun D-ReadLexicalEntry (entrypos)
;;
;;  Position the entry data file pointer to entrypos and read
;;  in entry returning it
;;  file read must be open (<name>.en.ma) 
;;
   ;(print D-ENTRYFILEID) (terpri) (print entrypos) (terpri)
   (cond
      ((numberp (cdr entrypos))
         (filepos D-ENTRYFILEID (cdr entrypos))   ;; position file
         (read D-ENTRYFILEID)   ;; read and return entry
      )
      (t
	 (cdr entrypos)   ;; not saved in file
      )
   )
   ;(filepos D-ENTRYFILEID (cdr entrypos))
   ;(read D-ENTRYFILEID)
)

(defun D-errmsg (mesg prob)
;;
;;   This function displays an error message 
;;
   (princ "ERROR >>> ")
   (princ mesg)
   (princ " ")
   (princ prob)   ;; the offending part
   (terpri)
)
 
(defmacro D-CitationForm  (lexentry)
;;
;;  returns the citation form of a lexical entry
;;
   `(car ,lexentry)
)

(defmacro D-PhonologicalForm (lexentry)
;;
;;  returns the phonological form of a lexical entry
;;
   `(cadr ,lexentry)
)

(defmacro D-Syntax-Field (lexentry)
;;
;;  returns the syntax field (a category) of a lexical entry
;;
   `(caddr ,lexentry)
)

(defmacro D-Semantic-Field (lexentry)
;;
;;   returns the semantic field of a lexical entry
;;
   `(car (cdddr ,lexentry))
)

(defmacro D-User-Field (lexentry)
;;
;;  returns the user field of a lexical entry
;;
   `(cadr (cdddr ,lexentry))
)

(defun D-IntersectVar (range1 range2)
;;
;;   Finds the new range of two variables.  This is defined as the
;;   intersection of their ranges.  If the they are equal then there
;;   is no change.  The equal check covers the case when they are unlimited
;;   and range over categories.  In this case ranges1 and range2 will
;;   be 'category.
;;   I assume that it is never the case that one is category ranged
;;   and the other atomic ranged.  This is becasue I assume they are from
;;   the same feature, which except in weird condiditons will be of the same
;;   type.
   (cond
      ((equal range1 range2)
	 range1
      )
      (t    ;; otherwise find the set intersection
	 (D-intersection range1 range2))
   )
)

;;
;;  set intersection union and difference
;;  all from LISP  PWH & BKPH p 323-324
;;


(defun D-union (X Y)
   (cond
      ((null X) Y)
      ((member (car X) Y) (D-union (cdr X) Y))
      (t (cons (car X) (D-union (cdr X) Y)))))

(defun D-intersection (x y)
   (cond  ((null x) nil)
	  ((member (car x) y)
	   (cons (car x) (D-intersection (cdr x) y)))
          (t (D-intersection (cdr x) y))))

(defun D-ldifference (in out)
   (cond ((null in) nil)
	 ((member (car in) out) (D-ldifference (cdr in) out))
	 (t (cons (car in) (D-ldifference (cdr in) out)))))


(defun D-RemoveDuplicates (lst)
;;
;;  removes duplicates from a list
;;
   (cond
      ((null lst)
	 nil
      )
      ((member (car lst) (cdr lst))     ;; is a duplicate so drop it
	 (D-RemoveDuplicates (cdr lst))
      )
      (t
	 (cons
	    (car lst)
	    (D-RemoveDuplicates (cdr lst))
         )
      )
   )
)

(defun D-MarkUnLoad (type)
;;
;; This removes the type from the D-LOADEDPARTS global to say it
;; is no longer loaded.  This covers errors caused in reloading or
;; recompiling subparts.  (only partly though)
;;
;; can cope if type not already loaded
;;
   (let  ((part (assq type D-LOADEDPARTS)))
      (setq D-LOADEDPARTS (remove part D-LOADEDPARTS))
   )
)

(defun D-MarkLoaded (type)
;;
;;  Adds the given type to the list of loaded files if not already
;;  there, only if the grammar spelling rules and lexicon are
;;  loaded are look ups allowed
;;
    (cond
       ((assq type D-LOADEDPARTS)
	  D-LOADEDPARTS ;; already loaded 
       )
       (t
	  (setq D-LOADEDPARTS
	     (cons type D-LOADEDPARTS))
       )
    )
)

(defun D-IsPattVariable (thing)
;;
;;  returns true if thing is atom and start with an _
;;
   (and (atom thing)
	(eq (car (explode thing)) '_))
)

(defun D-PattBinding (variable bindings)
;;
;;  returns the current binding of the variable, 'D-UNBOUND if no
;;  binding.  Yes this means you cannot match with 'D-UNBOUND
;;  used in parser and makelexicon (lruleconv)
;;
   (let  ( (bind (assq variable bindings)) )
      (cond
	 ((null bind) 'D-UNBOUND)
	 (t (cadr bind)))
   )
)

(defun D-RemoveFeature (name category)
;;
;;  removes the given feature from the category, throws
;;  nil is category does not have that feature
;;
   (cond
      ((null category)
	 (throw nil)
      )
      ((eq (caar category) name)
	 (cdr category)
      )
      (t
	 (cons
	    (car category)
	    (D-RemoveFeature 
	       name
	       (cdr category))
         )
      )
   )
)

(defun D-RemoveAlias (name aliases)
;;
;;  removes the occurence of the pair with car name from the given
;;  a-list
;;
   (cond
      ((null aliases) nil)
      ((eq name (caar aliases)) (cdr aliases))
      (t (cons (car aliases) (D-RemoveAlias name (cdr aliases))))
   )
)

(defun D-SaveGlobalEnvironment ()
;;
;;  This function saves all the global variables that can be
;;  affected by a compilation.  They can then be restored
;;  by the function D-RestoreGlobalEnvironment.  This I suppose
;;  is a arguement against LISP as what I need is a self-contained
;;  module in which I can have global variables that are global
;;  only within that module.  LISP seems to offer local or completely
;;  global and the in between part is very dependant on the actual
;;  lisp dialect you are using.  Originally closures were used
;;  to do this but they don't port too well.
;;
;;  Calling this means that compilation will not affect any currently
;;  loaded parts of the dictionary.
;;
;;  Note this is not designed to be recursive.  It may only be called
;;  to depth one.
;;
   (let ()
      (setq D-GLOBALENVIRONMENT
	 (list
             D-FEATURES D-BASICVARIABLES D-DISTINGUISHEDCATEGORY
	     D-ALIASES D-CATVALFEAT D-FSD D-SIMPLELEXICON
	     D-VARIABLES D-GRAMMAR D-MORPHOLOGYONLY
	     D-WHEAD D-WDAUGHTER D-SURFACEALPHABET D-LEXICALALPHABET
	     D-LCATEGORIES D-NONINFLECTS D-AUTOSYMBOLS
	     D-DTREE D-CATEGORYDEFINITIONS D-CANMAKE
             D-TRANSITIONSLIST D-UNUSUALFEASIBLES D-SURFTOLEXSETS))
   )
)

(defun D-RestoreGlobalEnvironment ()
;;
;;  restores the global variables back to what they were before the
;;  last call to D-SaveGlobalEnvironment.  
;;
;;  This is used after a compilation process has been run.  This
;;  allows the compilation process to used global variables and 
;;  not affect the environemnt.
;;
   (mapcar
      #'(lambda (name value)
	 (set name value))
      '(D-FEATURES D-BASICVARIABLES D-DISTINGUISHEDCATEGORY
        D-ALIASES D-CATVALFEAT D-FSD D-SIMPLELEXICON
        D-VARIABLES D-GRAMMAR D-MORPHOLOGYONLY
        D-WHEAD D-WDAUGHTER D-SURFACEALPHABET D-LEXICALALPHABET
	D-LCATEGORIES D-NONINFLECTS D-AUTOSYMBOLS
	D-DTREE D-CATEGORYDEFINITIONS D-CANMAKE
        D-TRANSITIONSLIST D-UNUSUALFEASIBLES D-SURFTOLEXSETS)
      D-GLOBALENVIRONMENT)
)

(defun D-OrderChars (a b)
;;
;;  returns t if a is "less" than b.  0 is greater than everything
;;
   (alphalessp a b)
   ;(cond
      ;((zerop a) t)
      ;((zerop b) nil)
      ;(t (alphalessp a b))
   ;)
)

(defmacro D-NumeralToNumber (numeral)
;;
;;  returns the number associated with the given "numeral"
;;
   `(- ,numeral 48))

(defun D-PList (atomlist)
;;
;;  Prints the given list without parenthesis.  It is assumed that 
;;  this is a simple list
;;
   (mapcar
      #'(lambda (thing)
	 (princ " ") (princ thing))
      atomlist)
)

(defmacro D-BlankVariable ()
;;
;;  Define the variable that is used for the feature value of
;;  features added by the Lcategory rules
;;
   `(concat '@ (gensym 'D))
)

(defun D-RNametoRule (rname rules)
;;
   (cond
      ((null rules) nil)
      ((eq rname (D-GetGRuleName (car rules)))
	 (car rules))
      (t
	 (D-RNametoRule rname (cdr rules)))
   )
)

