home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / snobol / aisnobol / atn.in < prev    next >
Text File  |  1987-10-17  |  5KB  |  166 lines
  1. **********************************
  2.  NETWORK PARSE_CLAUSE
  3. **********************************
  4.     S1
  5.         IF PARSE_NOUN_GROUP(THIS_NODE) GOTO S2
  6.         AFTER SETR('SUBJECT',LAST_PARSED)
  7.         ENDIF
  8.     END S1
  9. **********************************
  10.     S2
  11.         IF PARSE_WORD(THIS_NODE,'VERB TENSED ') GOTO S3
  12.         AFTER SETR('VERB',LAST_PARSED)
  13.         ENDIF
  14.     END S2
  15. **********************************
  16.     S3
  17.         IF    TESTF(LAST_PARSED,'BE ')
  18.         PARSE_WORD(THIS_NODE,'PASTPARTICIPLE ') GOTO S4
  19.         AFTER    SETR('OBJECT',GETR('SUBJECT'))
  20.             SETR('SUBJECT')
  21.             SETR('VERB',LAST_PARSED)
  22.         ENDIF
  23.         IF    TESTF(GETR('VERB'),'TRANSITIVE ')
  24.         PARSE_NOUN_GROUP(THIS_NODE) GOTO S4
  25.         AFTER SETR('OBJECT',LAST_PARSED)
  26.         ENDIF
  27.         IF TESTF(GETR('VERB'),'INTRANSITIVE ') GOTO S4 ENDIF
  28.         IF ~NULL(GETR('OBJECT')) GOTO S4 ENDIF
  29.     END S3
  30. **********************************
  31.     S4
  32.         IF    ~NULL(GETR('SUBJECT'))
  33.         NULL(REMAINING_WORDS) GOTO WIN
  34.         ENDIF
  35.         IF    NULL(GETR('SUBJECT'))
  36.         IDENT(CURRENT_WORD,'BY')
  37.         PARSE_WORD(THIS_NODE) GOTO S5
  38.         ENDIF
  39.         IF NULL(GETR('SUBJECT')) GOTO S4
  40.         AFTER SETR('SUBJECT','SOMEONE')
  41.         ENDIF
  42.     END S4
  43. **********************************
  44.     S5
  45.         IF PARSE_NOUN_GROUP(THIS_NODE) GOTO S4
  46.         AFTER SETR('SUBJECT',LAST_PARSED)
  47.         ENDIF
  48.     END S5
  49.  END PARSE_CLAUSE
  50.  
  51. **********************************
  52.  NETWORK PARSE_NOUN_GROUP
  53. **********************************
  54.     S1
  55.         IF PARSE_WORD(THIS_NODE,'DETERMINER ') GOTO S2
  56.         AFTER SETR('NUMBER',
  57.                SELECT('SINGULAR PLURAL ',
  58.                   GETF(LAST_PARSED)))
  59.               SETR('DETERMINER',
  60.                SELECT('DEFINITE INDEFINITE ',
  61.                   GETF(LAST_PARSED)))
  62.         ENDIF
  63.     END S1
  64. **********************************
  65.     S2
  66.         IF PARSE_WORD(THIS_NODE,'ADJECTIVE ') GOTO S2
  67.          AFTER ADDR('ADJECTIVES',LAST_PARSED)
  68.         ENDIF
  69.         IF PARSE_WORD(THIS_NODE,'NOUN ') GOTO WIN
  70.          AFTER SETR('NUMBER',
  71.                 SELECT('SINGULAR PLURAL ',
  72.                    GETF(LAST_PARSED)))
  73.                SETR('NOUN',LAST_PARSED)
  74.         ENDIF
  75.     END S2
  76.  END PARSE_NOUN_GROUP
  77.  
  78. **********************************
  79.  NETWORK PARSE_WORD
  80.     S1
  81.         IF NULL(null) GOTO WIN
  82.         AFTER PARSE_WORD_1()
  83.         ENDIF
  84.     END S1
  85.  END PARSE_WORD
  86.  
  87. **********************************
  88.  FUNCTION PARSE_WORD_1 () ()
  89.     THIS_NODE = CURRENT_WORD ;
  90.     REMAINING_WORDS BREAK(" ") SPAN(" ") = ;
  91.     REMAINING_WORDS (BREAK(" ") | null) $ CURRENT_WORD    :(RETURN) ;
  92.  END PARSE_WORD_1
  93.  
  94. **********************************
  95.  FUNCTION SETR (REGISTER,VALUE) ()
  96.     PUT(THIS_NODE,VALUE,REGISTER)        :(RETURN) ;
  97.  END SETR
  98.  
  99. **********************************
  100.  FUNCTION GETR (REGISTER) ()
  101.     GETR = GET(THIS_NODE,REGISTER)        :(RETURN) ;
  102.  END GETR
  103.  
  104. **********************************
  105.  FUNCTION ADDR (REGISTER,VALUE) ()
  106.     SETR(REGISTER,GETR(REGISTER) VALUE " ")    :(RETURN) ;
  107.  END ADDR
  108.  
  109. **********************************
  110.  FUNCTION GENNAME (X) ()
  111.     GENNAME =
  112.         '*' X '_' &STCOUNT '*'
  113.         :(RETURN) ;
  114.  END GENNAME
  115.  
  116. **********************************
  117.  FUNCTION ATTACH (C,P) ()
  118.     PUT(C,P,'PARENT') ;
  119.     PUT(P,GET(P,'CHILDREN') C " ",'CHILDREN')
  120.         :(RETURN) ;
  121.  END ATTACH
  122.  
  123. **********************************
  124.  FUNCTION SELECT (S,T) ()
  125.     S (BREAK(" ") $ SELECT) SPAN(" ") =    :F(FRETURN) ;
  126.     T (POS(0) | " ") SELECT " "
  127.         :S(RETURN)F(SELECT) ;
  128.  END SELECT
  129.  
  130. **********************************
  131.  FUNCTION TESTF (X,F) (W,G)
  132.     NULL(F)        :S(RETURN) ;
  133.     G = GETF(X) ;
  134. TESTF1
  135.     F (BREAK(" ") $ W) SPAN(" ") =    :F(RETURN) ;
  136.     G (POS(0) | " ") W " "    :S(TESTF)F(FRETURN) ;
  137.  END TESTF
  138.  
  139. **********************************
  140.  FUNCTION GETF (X) ()
  141.     GETF = LEXICAL_FEATURES<X> :(RETURN) ;
  142.  END GETF
  143.  
  144. **********************************
  145.  LEXICON L1
  146.     <* >NOUN >SINGULAR BLOCK BOY
  147.     <* >DETERMINER >SINGULAR >INDEFINITE A
  148.                <SINGULAR >DEFINITE THE
  149.     <* >VERB >TENSED >TRANSITIVE >INTRANSITIVE >PASTPARTICIPLE DROPPED
  150.          <TENSED >BE WAS
  151.     <* >ADJECTIVE BIG RED
  152.     <* >PREPOSITION BY
  153.     <*
  154.  END L1
  155.  
  156. **********************************
  157.  SENTENCES S1
  158.     A BIG RED BLOCK WAS DROPPED BY THE BOY ;
  159.     THE BOY DROPPED A BIG RED BLOCK ;
  160.     A BLOCK WAS DROPPED ;
  161.     THE BLOCK DROPPED ;
  162.  END S1
  163.  
  164. **********************************
  165.  EXEC PARSE_CLAUSE("SENTENCE",null)
  166.