; ********************* Definite Clause Grammars *****************
;                   (cf. Sterling & Shapiro ch. 16)
;
; This program contains a predicate translate (Rule, Translation)  for
; translating DCG rules like e.g 
;         sentence -> noun_phrase : verb_phrase. 
; into clauses like: 
;         sentence (S\S'') <- noun_phrase (S\S'), verb_phrase (S'\S'').
; the DCG rules may have parameters and embedded Prolog goals #Goal 
;         quantity (Q) -> number (N) : unit (U) : # (Q := N*U).
; You may also use the special predicate 'lex':
;         verb -> lex(["go", "walk", ...]) or
;         verb (foo(Verb)) -> lex (Verb, ["go", "walk", ..])
; You could modify this program to make possible rules like :
;         number (N) -> lex ([["one",1],["two",2],........]) 
; How to use this module: write a grammar in the following form:
;         ? consult ("flp1_DCG_log").
;         .... -> ........
;         .... -> ........
;         ? translate_grammar_rules.


? op (3, ":").
? op (4, "#").

translate (Rule, Translation)  <-
     translate_dl (Rule, Translation\[]), !.      ; 1 solution only

translate_dl (Lhs -> Rhs, Translation\Rest) <-
     translate (Lhs, Translation\Tail, Xs\Ys),
     translate (Rhs, Tail\Rest, Xs\Ys).

translate (A:B, AB\Rest, Xs\Ys)      <-
     translate (A, AB\B', Xs\Xs'),
     translate (B, B'\Rest, Xs'\Ys).

translate (# G, [G|Any]\Any, S).
translate (lex (L), [member (Word, L)|Any]\Any , [Word|S]\S).
translate (lex (Word, List), [member (Word, List)|Any]\Any , [Word|S]\S).

translate (Xs, T\T, S)  <-
     terminals (Xs), !, sequence (Xs, S).

translate (A, [A'|Any]\Any, S)     <-
     A &= ListA,
     append (ListA, [S], ListA'),
     A' &= ListA'.

terminals ([X|Xs]).

sequence ([X|Xs],[X|S]\S0)    <- sequence (Xs, S\S0).
sequence ([], Xs\Xs).

translate_grammar_rules <-
     write (" TRANSLATING GRAMMAR RULES: "),
     retract ([Head -> Body]),
     write ("*"),
     translate (Head -> Body, Translation),
     assert (Translation).


;  the definition of &=   (the 'univ' operator, cf Sterling & Shapiro):
;  e.g. f(a,1) &= [f,a,1]   and 7*7 &= [*,7,7] (sic!)  

Term &= [F|Args]  <-       ; [F|Args] is the list corresponding to Term 
     nonvar (Term), !, functor (Term, F, N), args (0, N, Term, Args).
Term &= [F|Args]  <-       ; Term is the term corresponding to [F|Args]
     length (Args, N), functor (Term, F, N), args (Args, Term, 1).

args (I,N,Term,[Arg|Args])  <-  ; args/4
     I < N, I' := I+1, arg (I', Term, Arg), args (I', N, Term, Args).
args (N,N,Term,[]).

args ([Arg|Args], Term, N) <-
     arg (N,Term, Arg), N' := N + 1, args (Args, Term, N').
args ([], Term, N).  
      
length ([],0).
length ([X|Xs], N) <-  length (Xs, N'), N := N' + 1.

 
 
                                                                                                                                                                                                                                                                                  @           boot                                            100 FLP_OPT 1
110 base=RESPR(31482): LBYTES flp1_boot2_rext,base: CALL base
120 a=RESPR(2^14):LBYTES flp1_stk,a:CALL a+1368
130 prog_use flp2_:data_use flp2_
140 DEST_USE ram1_
150 LRESPR flp1_ramprt
160 LRESPR flp1_qlib_ext
170 LRESPR flp1_qmon_bin
180 ALTKEY "/","ex qram",""
190 ALTKEY "g","print_vrij_geheugen 2",""
200 LRESPR flp1_QLC
210 a=RESPR(400):LBYTES flp1_list_tra_o,a:TRA a
220 spiek = 2
225 INPUT " #define SYM ?", defsym$
227 INPUT " extensie? (b.v. _128k)", extensie$
230 IF defsym$ = "" THEN defsym$ = "gewoon": ext$ = ""
240 datum$ = DATE$
250 WHEN ERRor 
260    IF ERLIN
270        BEEP 10000,30, 10, 1000,10
280        LIST #2,ERLIN
290        REPORT #2
300    ELSE 
310        REPORT
320    END IF 
330    FOR i = 3 TO 10 : CLOSE #i: END FOR i
340    STOP
350 END WHEN 
360 init
370 DEFine PROCedure c1
380    LOCal doptie$
390    IF test_geheugen (152)
400       Q_ERR_ON "LC1"
410       doptie$ = '-d' & defsym$
420       LC1 "flp2_ =4000 %60000 >ram1_help  -n -cc "&doptie$&" -oram1_ flp2_"&naam$
430       Q_ERR_OFF "LC1"
440       type "ram1_help", 3 ,spiek
450    END IF 
460 END DEFine 
470 :
480 DEFine PROCedure c2
490   IF test_geheugen(152)
500      Q_ERR_ON "lc2"
510      LC2 "flp2_ =4000 %60000 >ram1_help  ram1_"&naam$
520      Q_ERR_OF