Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/demos/qasete.sim
There is 1 other file named qasete.sim in the archive. Click here to see a list.
OPTIONS(/l/c); COMMENT demonstration program on question-answering
of simple set relations;

simset BEGIN

  REF (head) concept_set; !  all entered facts;

  link CLASS concept(identifier); TEXT identifier;
  BEGIN ! one for each entered noun;
    REF (head) underrelations, overrelations;
    ! create two sets, one for relations to underconcepts,
    one for relations to overconcepts;
    underrelations:- NEW head;
    overrelations:- NEW head;
    into(concept_set);
  END of concept;

  link CLASS relation(targetconcept);
  REF (concept) targetconcept;;

  REF (concept) PROCEDURE enter_concept(identifier);
  ! word(TEXT) is converted to REFerence to
  an object of the class concept;
  VALUE identifier; TEXT identifier;
  BEGIN
    REF (concept) already_there;
    already_there:- concept_set.first;
    WHILE already_there =/= NONE DO
    BEGIN
      IF already_there.identifier = identifier THEN
      BEGIN
        enter_concept:- already_there;
        GOTO out;
      END;
      already_there:- already_there.suc;
    END;
    enter_concept:- NEW concept(identifier);
    out:
  END of enter_concept;
  BOOLEAN PROCEDURE seek_relation(underconcept, overconcept);
  ! seeks recursively direct or indirect
  relation between the two concepts;
  REF (concept) underconcept, overconcept;
  IF underconcept == overconcept THEN
  seek_relation:= TRUE ELSE
  BEGIN
    REF (relation) test_relation;
    test_relation:- underconcept.overrelations.first;
    WHILE test_relation =/= NONE DO
    BEGIN ! loop across all direct overrelations;
      IF seek_relation(test_relation.targetconcept, overconcept)
      THEN BEGIN
        seek_relation:= TRUE;
        GOTO out;
      END;
      test_relation:- test_relation.suc;
    END;
    out:
  END of seek_relation;

  TEXT PROCEDURE
  enter_relation(underconcept, overconcept);
  REF (concept) underconcept, overconcept;
  ! tries to enter new relation, three possible
  outcomes are described in the answering texts;
  IF seek_relation(underconcept, overconcept) THEN
  enter_relation:- copy("I already knew.")
  ELSE IF seek_relation(overconcept, underconcept)
  THEN enter_relation:-
  copy("That is the opposite of what I already know.")
  ELSE
  BEGIN
    ! every new relation is entered doubly,
    both upwards and downwards;
    NEW relation(overconcept).
    into(underconcept.overrelations);
    NEW relation(underconcept).
    into(overconcept.underrelations);
    enter_relation:-
    copy("That is entered in the data base.");
  END of enter_relation;

  TEXT PROCEDURE read_word; ! read a word or character from the terminal;
  BEGIN
    INTEGER startpos;
    lastitem; startpos:= sysin.image.pos;
    WHILE sysin.image.more
    AND sysin.image.getchar NE ' ' DO;
    sysin.image.setpos(sysin.image.pos-1);
    IF sysin.image.pos > startpos+1 AND NOT
    letter(sysin.image.sub(sysin.image.pos-1,1).getchar)
    THEN sysin.image.setpos(sysin.image.pos-1);
    read_word:- inword:- copy(sysin.image.sub(startpos,
    sysin.image.pos-startpos));
  END;

  TEXT inword, left_word, right_word, stop_sign;
  REF (concept) left_concept, right_concept;

  PROCEDURE give_the_answer(answer);
  NAME answer; TEXT answer;
  BEGIN outtext(answer); outimage;
  END;

  PROCEDURE syntax_error(diagnostic_message);
  NAME diagnostic_message; TEXT diagnostic_message;
  BEGIN
    sysout.image.setpos(sysin.image.pos-inword.length+1);
    WHILE sysout.image.pos <= sysin.image.pos DO
    outchar('^'); outimage;
    give_the_answer("I do not understand you.");
    give_the_answer(diagnostic_message);
    ! skip the rest of this input line;
    sysin.image.setpos(sysin.image.length);
    GOTO main_loop; ! drect to the next input line;
  END;

  PROCEDURE wordchecking(word);
  TEXT word;
  BEGIN
    IF NOT letter(word.getchar) THEN
    syntax_error("I expected a letter here.")
    ELSE IF word = "IS" THEN
    syntax_error("The word ""IS"" was not expected here.");
  END;
  PROCEDURE question;
  BEGIN ! syntax analysis of question statements;
    BOOLEAN yes, no;
    ! analysis ready, answer the question;
    left_word:- read_word; wordchecking(left_word);
    right_word:- read_word; wordchecking(right_word);
    stop_sign:- read_word;
    IF stop_sign NE "?" THEN
    syntax_error(
    "I thought it was a question, expected a question sign (""?"").");
    left_concept:- enter_concept(left_word);
    right_concept:- enter_concept(right_word);
    yes:= seek_relation(left_concept,right_concept);
    no:= seek_relation(right_concept,left_concept);
    give_the_answer(IF yes THEN "Yes."
    ELSE IF no THEN "No, the opposite."
    ELSE "Not that I know.");
  END;

  PROCEDURE positive_statement;
  BEGIN ! syntax analysis of positive statements;
    left_word:- inword; wordchecking(left_word);
    IF read_word NE "IS" THEN
    syntax_error("I expected the word ""IS"".");
    right_word:- read_word; wordchecking(right_word);
    stop_sign:- read_word;
    IF stop_sign NE "." THEN
    syntax_error(
    "I believed this to be a positive statement and expected a dot.");
    ! analysis ready, store in data base and give answer;
    left_concept:- enter_concept(left_word);
    right_concept:- enter_concept(right_word);
    give_the_answer(enter_relation(left_concept,right_concept));
  END;

  concept_set:- NEW head;
  sysout.linesperpage(-1);
  give_the_answer("QASET1 starts execution:");
  give_the_answer("You can in upper case input statements like");
   give_the_answer("""BOOK IS DOCUMENT.""");
   give_the_answer("or ""IS BOOK OBJECT?""");

  main_loop: WHILE TRUE DO
  BEGIN
    outimage; outchar('*'); breakoutimage;
    IF read_word = "IS" THEN question ELSE positive_statement;
  END of huvud-loop;

END of program;