ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/MAGAZINE/MISC/AI_DEC86.ZIP/AIAPP.DEC

Text File | 1986-12-09 | 26.3 KB | 913 lines

                         Code Taken from
                     'AI Apprentice' column
              AI EXPERT magazine -- Dec. 1986 issue


                           GRAMMAR.PAS


{$R+}
PROGRAM grammar ;

(* Copyright 1986 - MicroExpert Systems
                    Box 430 R.D. 2
                    Nassau, NY 12123       *)

(* GRAMMAR implements the parser described in the December 1986 AI Apprentice
   column in AI Expert magazine.

   This program has been tested using Turbo ver 3.01A on an IBM PC. It has
   been run under both DOS 2.1 and Concurrent 4.1 .

   To change the vocabulary that the program recognizes, change the constant
   declarations in the procedures noun, verb etc. To change the grammar,
   write down the new rewrite rules and code a new procedure for each one.

   We would be pleased to hear your comments, good or bad, or any applications
   and modifications of the program. Contact us at the above address or
   on Compuserve or BIX. Our Compuserve id is 76703,4324 and may be reached by
   Easyplex mail or in the AI Expert forum. Our BIX id is bbt and we may be
   contacted by BIX mail or by leaving  comments in the MicroExpert conference.

   Bill and Bev Thompson    *)

 CONST
  tab = ^I ;

 TYPE
  string80 = string[80] ;

 VAR
  line : string80 ;


 PROCEDURE strip_leading_blanks(VAR s : string80) ;
  (* generic procedure for removing leading blanks *)
  BEGIN
   IF length(s) > 0
    THEN
     IF (s[1] = ' ') OR (s[1] = tab)
      THEN
       BEGIN
        delete(s,1,1) ;
        strip_leading_blanks(s) ;
       END ;
  END ; (* strip_leading_blanks *)


 FUNCTION toupper(s : string80) : string80 ;
  (* Convert the string, s, to upper case *)
  VAR
   i : byte ;
  BEGIN
   IF length(s) > 0
    THEN
     FOR i := 1 TO length(s) DO
      s[i] := upcase(s[i]) ;
   toupper := s ;
  END ; (* toupper *)


 PROCEDURE sentence(word_string : string80) ;
  VAR
   indent : string80 ;

  PROCEDURE error(error_msg : string80) ;
   (* Display an error message and halt the program. This is a sloppy way
      to end the parsing procedure. It should be changed to return an error
      code and exit more elagantly. *)
   BEGIN
    writeln ;
    writeln ;
    writeln('Error : ',error_msg) ;
    halt ;
   END ; (* error *)

  FUNCTION get_word : string80 ;
   (* Returns the first word, in upper case, from word_string *)
   VAR
    token : string80 ;
   BEGIN
    token := '' ;
    strip_leading_blanks(word_string) ;
    WHILE (word_string <> '') AND (copy(word_string,1,1) <> ' ') DO
     BEGIN
      token := concat(token,copy(word_string,1,1)) ;
      delete(word_string,1,1)
     END ;
    get_word := toupper(token) ;
   END ; (* get_word *)

  PROCEDURE noun_phrase ;
   (* noun_phrase ::- determiner noun | determiner adj_set noun *)
   VAR
    temp_word : string80 ;

   PROCEDURE determiner ;
    (* Is the first word in the current sentence a determiner *)
    CONST
     det_list = ' THE A ' ;
    VAR
     det_word : string80 ;
    BEGIN
     det_word := get_word ;
     IF pos(concat(' ',det_word,' '),det_list) = 0
      THEN error(concat('Illegal determiner --- ',det_word))
      ELSE writeln(indent,'Determiner : ',det_word) ;
    END ; (* determiner *)

   FUNCTION adj : boolean ;
    (* Look ahead at the first word, is it an adjective ?
       This routine doesn't remove the word, just looks at it *)
    CONST
     adj_list = ' BIG RED ' ;
    VAR
     adj_word : string80 ;
    BEGIN
     adj_word := get_word ;
     word_string := concat(concat(' ',adj_word),word_string) ;
     IF pos(concat(' ',adj_word,' '),adj_list)  <> 0
      THEN
       BEGIN
        adj := true ;
        writeln(indent,'Adjective : ',adj_word) ;
       END
      ELSE adj := false ;
    END ; (* adj *)

   PROCEDURE adj_set ;
    (* remove the adjectives from the front of the sentence. Stop when
       a word is encountered that is not an adjective *)
    VAR
     adj_word : string80 ;
    BEGIN
     IF adj
      THEN
       BEGIN
        adj_word := get_word ;
        adj_set ;
       END ;
    END ; (* adj_set *)

   PROCEDURE noun ;
    (* Is the first word a noun *)
    CONST
     nouns = ' GIRL BALL TABLE ' ;
    VAR
     noun_word : string80 ;
    BEGIN
     noun_word := get_word ;
     IF pos(concat(' ',noun_word,' '),nouns) = 0
      THEN error(concat('Illegal noun --- ',noun_word))
      ELSE writeln(indent,'Noun : ',noun_word) ;
    END ; (* noun *)

   BEGIN
    writeln(indent,'Noun phrase :') ;
    indent := concat('  ',indent) ;
    determiner ;
    IF adj
     THEN
      BEGIN
       temp_word := get_word ;
       adj_set ;
       noun ;
      END
     ELSE noun ;
    delete(indent,1,2) ;
   END ; (* noun_phrase *)

  PROCEDURE verb_phrase ;
   (* verb_phrase ::- verb | verb noun_phrase | verb noun_phrase prep_pharse *)

   PROCEDURE verb ;
    (* Does the reamining part of the sentence start with a verb ? *)
    CONST
     verbs = ' MOVED PUSHED ' ;
    VAR
     verb_word : string80 ;
    BEGIN
     verb_word := get_word ;
     IF pos(concat(' ',verb_word,' '),verbs) = 0
      THEN error(concat('Illegal verb --- ',verb_word))
      ELSE writeln(indent,'Verb : ',verb_word) ;
    END ; (* verb *)

   PROCEDURE prep_phrase ;
    (* prep_phrase ::- preposition noun_phrase *)

    PROCEDURE preposition ;
     (* Is the first word a preposition ? *)
     CONST
      prep_list = ' TO FROM ' ;
     VAR
      prep_word : string80 ;
     BEGIN
      prep_word := get_word ;
      IF pos(concat(' ',prep_word,' '),prep_list) = 0
       THEN error(concat('Illegal preposition --- ',prep_word))
       ELSE writeln(indent,'Preposition : ',prep_word) ;
     END ; (* preposition *)

    BEGIN
     writeln(indent,'Prepositional phrase :') ;
     indent := concat('  ',indent) ;
     preposition ;
     noun_phrase ;
     delete(indent,1,2) ;
    END ; (* prep_phrase *)

   BEGIN
    writeln(indent,'Verb phrase :') ;
    indent := concat('  ',indent) ;
    verb ;
    IF word_string <> ''
     THEN
      BEGIN
       noun_phrase ;
       IF word_string <> ''
        THEN prep_phrase ;
       IF word_string <> ''
        THEN error(concat('Illegal word ---- ',word_string)) ;
      END ;
    delete(indent,1,2) ;
   END ; (* verb_phrase *)

  BEGIN
   writeln('Sentence :') ;
   indent := '  ' ;
   noun_phrase ;
   verb_phrase ;
   writeln ;
   writeln('This is a legal sentence.') ;
  END ; (* sentence *)

 BEGIN
  clrscr ;
  writeln('Grammar - Copyright [c] 1986 MicroExpert Systems') ;
  writeln ;
  write('Enter a sentence : ') ;
  readln(line) ;
  sentence(line) ;
 END.


                           GRAMMAR.PRO

/*
  Copyright 1986 - MicroExpert Systems
                   Box 430 R.D. 2
                   Nassau, NY 12123

  This program implements the parser described in the December 1986 AI Apprentice
  column in AI Expert magazine.

  The program was developed and tested using PDPROLOG 1.7f. It should
  work on just about any version of PROLOG.

  To run the program, type : consult(grammar).
                             go.

  To change the vocabulary that the program recognizes, change the constant
  declarations in the procedures noun, verb etc. To change the grammar,
  write down the new rewrite rules and code a new procedure for each one.

  We would be pleased to hear your comments, good or bad, or any applications
  and modifications of the program. Contact us at the above address or
  on Compuserve or BIX. Our Compuserve id is 76703,4324 and may be reached by
  Easyplex mail or in the AI Expert forum. Our BIX id is bbt and we may be
  contacted by BIX mail or by leaving  comments in the MicroExpert conference.

  Bill and Bev Thompson

*/

go :-
    print('Enter a sentence, terminated with a "."'),nl,nl,
    print('See December 1986 AI Expert for the proper grammar'),nl,
    print('and vocabulary'),nl,nl,
    print('==> '),
    read_in(SS),nl,
    parse(SS),!.


parse(S) :-
    sentence(S),
    nl,nl,
    print('You have entered a well formed sentence.'),nl.

parse(S) :-
    nl,nl,
    print('This string of words is not a well formed sentence.'),nl.


/* A sentence is a sentence if it is made up of sentence parts */

sentence(S) :-
    sentence_parts(S,['.']).

/* Sentence parts are noun_phrase verb_phrase */

sentence_parts(S0,S) :-
    print('Sentence : '),nl,
    noun_phrase(S0,S1,"  "),!,
    verb_phrase(S1,S,"  ").


/* noun_phrase ::= determiner noun | determiner adj_set noun
   the program actually treats adj_set as if it could be empty.
   This is different than the Pascal and LISP versions */

noun_phrase(S0,S,Indent) :-
    print_string(Indent),
    print('Noun phrase : '),nl,
    append("  ",Indent,Indent2),
    determiner(S0,S1,Indent2),
    adj_set(S1,S2,Indent2),!,
    noun(S2,S,Indent2).


/* verb_phrase ::= verb | verb noun_phrase | verb noun_phrase prep_phrase
   The program breaks this down into:
   verb_phrase ::= verb obj
   obj ::= [] | noun_phrase modifier
   modifier ::= [] | prep_phrase
   This makes it easier to trap errors and avoids duplicate printing of
   nonterminals on backtracking. */

verb_phrase(S0,S,Indent) :-
    print_string(Indent),
    print('Verb Phrase : '),nl,
    append("  ",Indent,Indent2),
    verb(S0,S1,Indent2),!,
    obj(S1,S,Indent2).

obj(['.'],['.'],Indent).

obj(S0,S,Indent) :-
    noun_phrase(S0,S1,Indent),!,
    modifier(S1,S,Indent).

modifier(['.'],['.'],Indent).

modifier(S0,S,Indent) :-
    prep_phrase(S0,S,Indent).


/* adj_set := [] | adj | adj adj_set   */

adj_set(S0,S,Indent) :-
   adj(S0,S1,Indent),
   adj_set(S1,S,Indent).

adj_set(S0,S,Indent) :-
   adj(S0,S,Indent).

adj_set(S0,S0,Indent).


prep_phrase(S0,S,Indent) :-
    print_string(Indent),
    print('Prepositional phrase : '),nl,
    append("  ",Indent,Indent2),
    preposition(S0,S1,Indent2),
    noun_phrase(S1,S,Indent2).

/* Terminal symbol definitions :
   Each, except adj, has two definitions. The second signals an error
   has occurred.   */

determiner([Det|S],S,Indent) :-
    member(Det,[the,a]),
    print_string(Indent),
    print('Determiner : ',Det),nl.

determiner([Det|S],S,Indent) :-
    nl,print('Error : Illegal determiner --- ',Det),nl,
    fail.

adj([Adj|S],S,Indent) :-
    member(Adj,[big,red]),
    print_string(Indent),
    print('Adjective : ',Adj),nl.

noun([Noun_word|S],S,Indent) :-
    member(Noun_word,[girl,ball,table]),
    print_string(Indent),
    print('Noun : ',Noun_word),nl.

noun([Noun_word|S],S,Indent) :-
    nl,print('Error : Illegal noun --- ',Noun_word),nl,
    fail.

verb([Verb_word|S],S,Indent) :-
    member(Verb_word,[moved,pushed]),
    print_string(Indent),
    print('Verb : ',Verb_word),nl.

verb([Verb_word|S],S,Indent) :-
    nl,print('Error : Illegal verb --- ',Verb_word),nl,
    fail.

preposition([P|S],S,Indent) :-
    member(P,[to,from]),
    print_string(Indent),
    print('Preposition : ',P),nl.

preposition([P|S],S,Indent) :-
    nl,print('Error : Illegal preposition --- ',P),nl,
    fail.

/*  Some Utility predicates */

member(X,[X|_]).

member(X,[_|Y]) :-
    member(X,Y).


append([],L,L).

append([X|L1],L2,[X|L3]) :- append(L1,L2,L3).


print_string([]).

print_string([H|T]) :-
    put(H),print_string(T).

/* read_in - From Clocksin and Mellish */

read_in([W|Ws]) :-
    get0(C),
    readword(C,W,C1),
    restsent(W,C1,Ws).

restsent( W,_,[]) :-
    lastword(W), !.

restsent(W,C,[W1|Ws]) :-
    readword(C,W1,C1),
    restsent(W1,C1,Ws).

readword(C,W,C1) :-
    single_character(C), !,
    name(W,[C]),
    get0(C1).

readword(C,W,C2) :-
    in_word(C,NewC), !,
    get0(C1),
    restword(C1,Cs,C2),
    name(W,[NewC|Cs]).

readword(C,W,C2) :-
    get0(C1),
    readword(C1,W,C2).

restword(C,[NewC|Cs],C2) :-
     in_word(C,NewC), !,
     get0(C1),
     restword(C1,Cs,C2).
     restword(C,[],C).

single_character(44).  /* , */
single_character(59).  /* ; */
single_character(58).  /* : */
single_character(63).  /* ? */
single_character(33).  /* ! */
single_character(46).  /* . */

in_word(C,C) :- C>96, C<123.                /* a b..z */
in_word(C,L) :- C>64, C<91, L is C+32.      /* A,B..Z */
in_word(C,C) :- C>47, C<58.                 /* 1,2,..9 */
in_word(39,39).                             /*  ' */
in_word(45,45).                             /* - */

lastword( '.' ).
lastword( '!' ).
lastword( '?' ).



                          GRAMMAR1.LSP

;  Copyright 1986 - MicroExpert Systems
;                   Box 430 R.D. 2
;                   Nassau, NY 12123
;
;  Sentence implements the parser described in the December 1986 AI Apprentice
;  column in AI Expert magazine. This is the Pascal "clone" program. It is
;  an example of some pretty poor LISP style.
;
;  The program was implemented and tested under XLISP 1.6. It should work
;  with later versions.
;
;  To change the vocabulary that the program recognizes, change the constant
;  declarations in the procedures noun, verb etc. To change the grammar,
;  write down the new rewrite rules and code a new procedure for each one.
;
;  We would be pleased to hear your comments, good or bad, or any applications
;  and modifications of the program. Contact us at the above address or
;  on Compuserve or BIX. Our Compuserve id is 76703,4324 and may be reached by
;  Easyplex mail or in the AI Expert forum. Our BIX id is bbt and we may be
;  contacted by BIX mail or by leaving  comments in the MicroExpert conference.
;
;  Bill and Bev Thompson
;
(defun sentence (word-list)
;
   (let ((indent "      "))
;
;    Some simple print functions
;
     (defun print-with-indent (stuff)
        (princ indent)
        (princ stuff))
;
     (defun print-line (stuff)
        (print-with-indent stuff)
        (terpri))
;
     (defun print-with-title (title stuff)
        (print-with-indent title)
        (princ " ")
        (princ stuff)
        (terpri))
;
;    The error function. It uses the XLISP primitive "error"
;    to terminate the program
;
     (defun parse-error (message error-word)
        (terpri)
        (terpri)
        (terpri)
        (error (strcat message " --- " (symbol-name error-word))))
;
;    Extract the first word from "word-list"
;
     (defun get-word ()
        (let ((token (car word-list)))
          (setq word-list (cdr word-list))
          token))
;
     (defun noun-phrase ()
;
        (defun determiner ()
           (let ((det-list '(a the))
                 (det-word (get-word)))
             (cond ((member det-word det-list)
                       (print-with-title "Determiner : " det-word))
                   (T (parse-error "Illegal determiner" det-word)))))
;
        (defun adj ()
           (let ((adj-list '(big red))
                 (adj-word (get-word)))
             (setq word-list (cons adj-word word-list))
             (cond ((member adj-word adj-list)
                      (print-with-title "Adjective : " adj-word) T)
                   (T nil))))
;
        (defun adj-set ()
           (cond ((adj) (get-word) (adj-set))))
;
        (defun noun ()
            (let ((nouns '(girl ball table))
                  (noun-word (get-word)))
            (cond ((member noun-word nouns)
                      (print-with-title "Noun : " noun-word))
                  (T (parse-error "Illegal noun" noun-word)))))
;
        (print-line "Noun phrase : ")
        (setq indent (strcat "  " indent))
        (determiner)
        (cond ((adj) (get-word)
                     (adj-set)
                     (noun))
              (T (noun)))
        (setq indent (substr indent 3)))
;
;
     (defun verb-phrase ()
;
        (defun verb ()
           (let ((verbs '(moved pushed))
                 (verb-word (get-word)))
           (cond ((member verb-word verbs)
                     (print-with-title "Verb : " verb-word))
                 (T (prase-error "Illegal verb" verb-word)))))
;
        (defun prep-phrase ()
;
           (defun preposition ()
              (let ((prep-list '(to from))
                    (prep-word (get-word)))
              (cond ((member prep-word prep-list)
                          (print-with-title "Preposition : " prep-word))
                    (T (parse-error "Illegal preposition" prep-word)))))
;
           (print-line "Prepositional phrase : ")
           (setq indent (strcat "  " indent))
           (preposition)
           (noun-phrase)
           (setq indent (substr indent 3)))
;
        (print-line "Verb phrase : ")
        (setq indent (strcat "  " indent))
        (verb)
        (cond ((not (null word-list)) (noun-phrase)
                                      (cond ((not (null word-list))
                                               (prep-phrase)))))
        (setq indent (substr indent 3)))
;
;
     (print-line "Sentence : ")
     (setq indent (strcat "  " indent))
     (noun-phrase)
     (verb-phrase)
     (terpri)
     (terpri)
     (terpri)
     (print "You have entered a legal sentence")
     NIL))
;
;
;   Opening instructions
;
(terpri)
(princ "To run the parser, Type: (sentence '(the girl moved the ball))")
(terpri)
(terpri)
(princ "See December 1986 AI Expert magazine for a description of")
(terpri)
(princ "the grammar that this routine implements.")
(terpri)
(terpri)


                          GRAMMAR2.LSP


;  Copyright 1986 - MicroExpert Systems
;                   Box 430 R.D. 2
;                   Nassau, NY 12123
;
;  Sentence implements the parser described in the December 1986 AI Apprentice
;  column in AI Expert magazine. This is the Pascal "clone" program. This is
;  the slightl more LISP-like version. It could also stand some improvement.
;  For example,most of the local varaibles are unnecessary.
;
;  The program was implemented and tested under XLISP 1.6. It should work
;  with later versions.
;
;  To change the vocabulary that the program recognizes, change the constant
;  declarations in the procedures noun, verb etc. To change the grammar,
;  write down the new rewrite rules and code a new procedure for each one.
;
;  We would be pleased to hear your comments, good or bad, or any applications
;  and modifications of the program. Contact us at the above address or
;  on Compuserve or BIX. Our Compuserve id is 76703,4324 and may be reached by
;  Easyplex mail or in the AI Expert forum. Our BIX id is bbt and we may be
;  contacted by BIX mail or by leaving  comments in the MicroExpert conference.
;
;  Bill and Bev Thompson
;
(defun print-line (indent line)
   (princ indent)
   (princ line)
   (terpri))
;
;
(defun print-word (indent title word)
   (princ indent)
   (princ title)
   (princ word)
   (terpri))
;
;
(defun parse-error (message error-word)
   (terpri)
   (terpri)
   (terpri)
   (error (strcat message " --- " (symbol-name error-word))))
;
;
(defun determiner (word-list indent)
   (let ((det-list '(a the)))
      (cond ((member (car word-list) det-list)
                 (print-word indent "Determiner : " (car word-list))
                 (cdr word-list))
             (T (parse-error "Illegal determiner " (car word-list))))))
;
;
(defun adj (word-list indent)
   (let ((adj-list '(big red)))
     (cond ((member (car word-list) adj-list)
                  (print-word indent "Adjective : " (car word-list))
                  T)
            (T nil))))
;
;
(defun adj-set (word-list indent)
   (cond ((adj word-list indent) (adj-set (cdr word-list) indent))
         (T word-list)))
;
;
(defun noun (word-list indent)
   (let ((nouns '(girl ball table)))
     (cond ((member (car word-list) nouns)
                 (print-word indent "Noun : " (car word-list))
                 (cdr word-list))
           (T (parse-error "Illegal noun " (car word-list))))))
;
;
(defun noun-phrase (word-list indent)
   (let ((remaining-words nil))
     (print-line indent "Noun phrase : ")
     (setq remaining-words (determiner word-list (strcat "  " indent)))
     (cond ((adj remaining-words (strcat "  " indent))
                    (setq remaining-words (adj-set (cdr remaining-words)
                                               (strcat "  " indent)))
                    (noun remaining-words (strcat "  " indent)))
           (T (noun remaining-words (strcat "  " indent))))))
;
;
(defun verb (word-list indent)
   (let ((verbs '(moved pushed)))
     (cond ((member (car word-list) verbs)
                 (print-word indent "Verb : " (car word-list))
                 (cdr word-list))
           (T (parse-error "Illegal verb " (car word-list))))))
;
;
(defun preposition (word-list indent)
   (let ((prep-list '(to from)))
     (cond ((member (car word-list) prep-list)
                 (print-word indent "Preposition : " (car word-list))
                 (cdr word-list))
           (T (parse-error "Illegal preposition " (car word-list))))))
;
;
(defun prep-phrase (word-list indent)
   (let ((remaining-words nil))
     (print-line indent "Prepositional phrase :")
     (setq remaining-words (preposition word-list (strcat "  " indent)))
     (noun-phrase remaining-words (strcat "  " indent))))
;
;
(defun verb-phrase (word-list indent)
   (let ((remaining-words nil))
     (print-line indent "Verb phrase :")
     (setq remaining-words (verb word-list (strcat "  " indent)))
     (cond ((not (null remaining-words))
                (setq remaining-words (noun-phrase remaining-words
                                           (strcat "  " indent)))
                (cond ((not (null remaining-words))
                           (setq remaining-words
                                   (prep-phrase remaining-words
                                        (strcat "  " indent)))))))))
;
;
;
(defun sentence (word-list)
   (let ((remaining-words nil))
     (print-line "" "Sentence : ")
     (setq remaining-words (noun-phrase word-list "  "))
     (cond ((null (verb-phrase remaining-words "  "))
                 (terpri)
                 (princ "You have entered a legal sentence.")
                 (terpri)
                 NIL))))
;
;
;   Opening instructions
;
(terpri)
(princ "To run the parser, Type: (sentence '(the girl moved the ball))")
(terpri)
(princ "See December 1986 AI Expert magazine for a description of")
(terpri)
(terpri)
(princ "the grammar that this routine implements.")
(terpri)
(terpri)



                 FIGURES IN THIS MONTH'S COLUMN


sentence ::= noun_phrase verb_phrse
noun_phrase ::= determiner adj_set noun | determiner noun
adj_set ::= adj | adj adj_set
verb_phrase ::= verb | verb noun_phrase | verb noun_pharse prep_phrase
prep_phrase ::= preposition noun_phrase
determiner ::= "a" | "the"
noun ::= "girl" | "ball"
adj ::= "big" | "red"
verb ::= "moved" | "pushed"
preposition ::= "to | "from"

Figure 1 - Rules for a simple context-free grammar



PROCEDURE sentence               |    (defun sentence (word_string)
          (word_string : string) |               .
 .                               |               .
 .                               |            (print-line "Sentence : ")
 .                               |            (setq indent "  ")
 .                               |            (noun-phrase)
                                 |            (verb-phrase))
BEGIN                            |
 writeln('Sentence : ') ;        |
 indent := '  ' ;                |
 noun_phrase ;                   |
 verb_phrase ;                   |
END ; (* sentence *)             |
                                 |

Figure 2 - Pascal and LISP code to begin parsing the grammar.



PROCEDURE noun_phrase ;             |   (defun noun ()
 .                                  |       .
 .                                  |       .
 .                                  |   (print-line indent "Noun Phrase :")
 .                                  |   (setq indent (strcat "  " indent))
                                    |   (determiner)
 BEGIN                              |   (cond ((adj) (get-word)
  writeln(indent,'Noun Phrase :') ; |                (adj-set)
  indent := concat ('  ',indent) ;  |               (noun))
  determiner ;                      |         (T (noun)))
  IF adj                            |
   THEN                             |
    BEGIN                           |
     temp := get_word ;             |
     adj_set ;                      |
     noun ;                         |
    END                             |
   ELSE noun ;                      |
  delete (indent,1,2) ;             |
END ; (* noun_phrase *)             |

Figure 3 - Pascal and LISP code for finding noun phrases.




PROCEDURE determiner ;                                    | (defun determiner ()
 CONST                                                    |     (let ((det-list '(a the))
   det_list = ' a the ' ;                                 |           (det-word (get-word))
 VAR                                                      |       (cond ((member det-word det-list)
   det_word : string80 ;                                  |                 (print-line indent "Determiner : " det-word))
 BEGIN                                                    |             (T (parse-error "Illegal Determiner --- " det-word)))))
   det_word := get_word ;                                 |
   IF pos(concat(' ',det_word,' '),det_list) = 0          |
     THEN error(concat(Illegal determiner --- ',det_word))|
     ELSE writeln(indent,'Determiner : ',det_word) ;      |
 END ; (* determiner *)                                   |

Figure 4 - Pascal and LISP code for finding determiners.



Sentence :
  Noun phrase :
    Determiner : the
    Noun : girl
  Verb phrase :
    Verb : moved
    Noun phrase :
      Determiner : the
      Noun : ball
    Prepositional phrase :
      Preposition : to
      Noun phrase :
        Determiner : the
        Adjective : big
        Adjective : red
        Noun : table

Figure 5 - The parse tree for "the girl moved the ball to the big red table"




sentence
     noun_phrase
          determiner
          adj
          adj_set
          noun
     verb_phrase
          verb
          prep_phrase
               preposition

Figure 6 -  The block structure of the recursive descent parser.