/*

ADAPTED FROM SHELL UTILITY FILE fs_gram.frl

Goal (grammar +(<grammar_rule1> ... <grammar_rulen>))
translates the list of grammar rules into clauses which
are added to the database.  The names of the grammar rules
are recorded in a dictionary of fact clauses of the form
((gdict <name>)), one clause for each name, and predicate
"gdict" is also added to the database.

Goal (translate +<filename>) prompts the user for the name
of an output file, say <outfile>, and then invokes the
goal (translate +<filename> +<outfile>).

Goal (translate +<filename> +<outfile>) translates any
grammar rules found in file <filename> and writes the
translated clauses to file <outfile>.  The corresponding
dictionary predicate "gdict" is only written when <outfile>
is "stdout".  None of the grammar rules are added to the
database, and any other translated grammar rules and
"gdict" dictionary which are in the database are left
unaffected. Note also that any normal Fril syntax rules
in <filename> are added to the database just as though the
file had been reloaded, rather than being written to
<outfile>.

Goal (savegram +<stream>) executes bip "listfile" on each
of the translated grammar rules currently in the database
as indicated by "gdict", saving to <stream>.  "gdict" is
only displayed when <stream> is "stdout".

Goal (phrase +(<sentence> <arg1> ... <argn>) +<list>)
executes the goal (<sentence> <arg1> ... <argn> <list> ())
which parses the list of "words" <list> according to the
"grammar" <sentence>.  "phrase" provides a primitive
mechanism for the interpretation of translated Fril
definite clause grammar rules.	"phrase" is resatisfiable
only to the extent that <sentence> is resatisfiable.

USERs: translate/1, translate/2, savegram/1, grammar/1,
       phrase/1, gdict/1

EXPORTs: none

INTERNALs: translate1/1, translate2/2, savegram1/1,
	   grammar1/2, stack_dict/2, gram_record/1,
	   gram_translate/2, gram_translate1/3,
	   gram_lhs/4, gram_rhs/4, gram_rhs1/4,
	   gram_disj/4, gram_conj/3, gram_flatten/2,
	   gram_flatten1/3

TEMPORARYs: "$gram_out_file"/1, "$gdict1"/1

IMPORTs: none

******************************************************* */

((addfrl_extension X X)			/* filename of type 'fred.' */
	(name L X)
	(append _ (46) L)
	(!))
((addfrl_extension X X)			/* filename of type 'fred.xxx' */
	(negg filename X _ _ '')
	(!))
((addfrl_extension X Y)			/* filename 'fred' where fred.frl exists */
	(filename X P R '')
	(filename Y P R frl)
	(exists Y)
	(!))
((addfrl_extension X X)			/* filename 'fred' where fred exists */
	(exists X)
	(!))
((addfrl_extension X Y)
	(filename X P R '')
	(filename Y P R frl))

((translate F F2)
  (addfrl_extension F F1)
  (orr ((negg con F1))
       ((negg exists F1))
	   ((negg con F2)))
  (!)
  (translate1 F1))
((translate F1 F2)
  (translate2 F1 F2))

((translate F)
  (addfrl_extension F F1)
  (translate1 F1))

((translate1 F1)
  (negg con F1)
  (!)
  (pp 'First argument must be instantiated to a constant')
  (pp '  - this should be the name of a file of grammar rules')
  (fail))
((translate1 F1)
  (negg exists F1)
  (!)
  (p File F1 does not exist)
  (pp)
  (fail))
((translate1 F1)
  (p Enter name of output file ': ')
  (r F2)
  (if (negg con F2) ((pp 'Illegal file name - try again')
		     (translate F1))
		    ((translate2 F1 F2))))

((translate2 F stdout)
  (!)
  (translate3 F stdout)
  (pp)
  (pp 'Translation completed - listing of grammar dictionary "gdict" :')
  (list gdict)
  (stack_gdict gdict "$gdict1")
  (kill "$gram_out_file"))
((translate2 F1 F2)
  (addfrl_extension F2 F3)
  (if (exists F3)
      ((p Output file already F3 already exists)(pp)
	   (p Append to file (a) or overwrite file (o) ': ')
	   (flush stdin)
	   (getb stdin X)
	   (if (eq X 111) ((p Overwriting F3)(pp)(create F3))
	                  ((p Appending to F3)(pp)(create_a F3)) ))
      ((create F3)) )
  (translate3 F1 F3)
  (close F3)
  (pp)
  (pp 'Translation completed')
  (stack_gdict gdict "$gdict1")
  (kill "$gram_out_file"))

((translate3 F1 F3)
  (kill "$gram_out_file")
  (addcl (("$gram_out_file" F3)))
  (stack_gdict "$gdict1" gdict)
  (load F1))

((savegram F2)
  (addfrl_extension F2 F3)
  (savegram1 F3))

((savegram1 F3)
  (gdict X)
  (listfile F3 X)
  (fail))
((savegram1 _))

((grammar (X : S|B))
  (!)
  (grammar1 X S)
  (grammar B))
((grammar (X|B))
  (!)
  (grammar1 X prolog)
  (grammar B))
((grammar ()))

((grammar1 ((H|T)|B) S)
  (cdict "$gram_out_file")
  (!)
  ("$gram_out_file" F)
  (gram_record H)
  (gram_translate ((H|T)|B) P)
  (if (stricteq S prolog)
		  ((wq F P))
		  ((wq F P : S)))
  (write F)
  (if (eq F stdout) () ((p '.')) ))
((grammar1 ((H|T)|B) S)
  (gram_record H)
  (gram_translate ((H|T)|B) P)
  (if (stricteq S prolog)
		  ((addcl P))
		  ((addcl P : S))))

((stack_gdict X Y)
  (kill X)
  (cdict Y)
  (!)
  (forall ((Y N))
		  ((delcl ((Y N)))
		   (addcl ((X N))))))
((stack_gdict _ _))

((gram_record H)
  (cdict gdict)
  (gdict H)
  (!))
((gram_record H)
  (kill H)
  (addcl ((gdict H))))

((gram_translate (X '-->'|Z) (P|Q))
  (gram_translate1 X Z (P|Q)))
((gram_translate (X (Y) '-->'|Z) (P|Q))
  (gram_translate1 (X Y) Z (P|Q)))

((gram_translate1 X Z (P|Q))
  (gram_lhs X A B P)
  (gram_rhs Z A B R)
  (gram_flatten R Q))

((gram_lhs X _ _ _)
  (var X)
  (!)
  (fail))
((gram_lhs (S T) A B (X|P))
  (islist T)
  (eq S (X|Y))
  (!)
  (append Y (A C) P)
  (append T A C))
((gram_lhs (X|Y) A B (X|P))
  (append Y (A B) P))

((gram_rhs () A A ()))
((gram_rhs ((? ())|R) A B P)
  (!)
  (gram_rhs R A B P))
((gram_rhs ((? (H|T))|R) A B P)
  (!)
  (gram_rhs1 (? H) A C P1)
  (gram_rhs ((? T)|R) C B P2)
  (gram_conj P1 P2 P))
((gram_rhs ((H|T)|R) A B P)
  (!)
  (gram_rhs1 (H|T) A C P1)
  (gram_rhs R C B P2)
  (gram_conj P1 P2 P))

((gram_rhs1 (orr X Y) A B (orr P Q))
  (!)
  (gram_disj X A B P)
  (gram_disj Y A B Q))
((gram_rhs1 (? P) A A P)
  (!))
((gram_rhs1 (!) A A (!))
  (!))
((gram_rhs1 (S) A B ())
  (islist S)
  (!)
  (append S B A))
((gram_rhs1 (X|Y) A B (X|P))
  (append Y (A B) P))
((gram_rhs1 () A A ()))

((gram_disj X A B P)
  (gram_rhs X C B Q)
  (orr ((var C) (eq C B) (!) (eq A C) (eq P Q))
       ((eq P ((eq A C)|Q)))))

((gram_conj () P P)
  (!))
((gram_conj P () (P))
  (!))
((gram_conj P Q (P|Q)))

((gram_flatten A A)
  (var A)
  (!))
((gram_flatten ((H|T)|B) R)
  (!)
  (gram_flatten1 (H|T) R P)
  (gram_flatten B P))
((gram_flatten A A))

((gram_flatten1 A (A|B) B)
  (var A)
  (!))
((gram_flatten1 ((H|T)|B) C R)
  (!)
  (gram_flatten1 (H|T) C S)
  (gram_flatten1 B S R))
((gram_flatten1 (H|T) ((H|T)|R) R))

((phrase (P|A) W)
  (append A (W ()) N)
  (P|N))