13、METEOR的LISP程序详解

onion

于 2025-08-13 15:40:10 发布

阅读量30

点赞数

CC 4.0 BY-SA版权

分类专栏：探索LISP：从基础到高级编程技巧文章标签： METEOR LISP 程序分析

本文链接：https://blog.youkuaiyun.com/onion/article/details/150435577

探索LISP：从基础到高级编程技巧专栏收录该内容

16 篇文章 ¥499.90

订阅专栏¥69.90

会员秒杀 ¥9.9 重磅福利

超级会员免费看

METEOR的LISP程序详解

1. 程序概述

METEOR的LISP程序是一个具有特定功能的程序，截至1964年2月20日，该程序的列表是最新的，并且已移除所有已知错误。程序开头列出了编译程序中使用的自由或“特殊”变量。此列表借助麻省理工学院的Daniel Edwards编写的格式打印程序生成，给出值的行和标签 $ / FUNCTION DEFINITIONS / 是该程序的产物。

2. 主要功能函数

METEOR中的主要功能函数如下：
| 函数名 | 功能描述 |
| ---- | ---- |
| MElRIX2 | 执行规则之间的控制转移 |
| COMIIRUE | 执行每个规则的跟踪和控制流 |
| CMAXH（从COMIRIIAXH调用） | 执行左半部分匹配 |
| COMITRIN（从COMIIR调用） | 创建转换后的工作空间和架子列表 |
| SHELVE | 执行搁置操作 |

3. 代码结构及关键函数分析

3.1 METEOR函数

(METEOR
  (LAMBDA (RULES WORKSPACE)
    (METRIX RULES WORKSPACE NIL NIL
            NIL I)))

此函数以规则和工作空间为参数，调用 METRIX 函数。

3.2 METRIX函数

(METRIX
  (LAMBDA (RULES WORKSPACE SHELF Dl SPCH TRACK)
    (METR1X2 RULES
             WORKS PACE 1))

该函数接收规则、工作空间、架子、调度和跟踪作为参数，调用 METR1X2 函数。

3.3 METR1X2函数

(METR1X2
  (LAMBDA (RULES WORKSPACE) (PROG (PC GT A)
    (SETQ PC RULES)
    START (COND
           ((NULL PC) (RETURN (PROG2 (PRINT (QUOTE (OVER
                                                     END OF PROGRAM)) 1) WORKSPACE) 1))
           (SETQ GT (Dl SPATCtI (COIvII TRULE (CAR PC) 1)))
           (COND
             ((EQ GT (QUOTE *)) (GO NEXT))
             ((EQ GT (QUOTE END))
              (RETURN WORKSPACE))
             ((EQUAL GT (CAAR PC))
              (GO START)))
           (SETQ A (TRANSFER CT RULES))
           (COND
             ((EQ (CAR A) (QUDTE NONAME))
              (RETURN (PROG2
                       (PRINT (LIST (CADR A) (QUOTE (UNDEF IRED GO-TO
                                                      IN)) (CAR PC)
                                    1) WORKSPACE))))
           (SETU PC A)
           (GO START)
           NEXT
           (SETQ PC (CDR PC))
           (GO START))))

METR1X2 函数是程序的核心部分，其工作流程如下：

graph TD;
    A[开始] --> B[设置PC为规则列表];
    B --> C{PC是否为空};
    C -- 是 --> D[打印结束信息并返回工作空间];
    C -- 否 --> E[获取GT值];
    E --> F{GT是否为*};
    F -- 是 --> G[跳转到NEXT];
    F -- 否 --> H{GT是否为END};
    H -- 是 --> I[返回工作空间];
    H -- 否 --> J{GT是否等于CAAR PC};
    J -- 是 --> B;
    J -- 否 --> K[调用TRANSFER函数];
    K --> L{返回值的CAR是否为NONAME};
    L -- 是 --> M[打印错误信息并返回工作空间];
    L -- 否 --> N[更新PC];
    N --> B;
    G --> O[更新PC为CDR PC];
    O --> B;

3.4 COMITRULE函数

(COMI TRULE
  (LAMBDA (RULE)
    (PROG (A B C D E G M LEFT)
      (SETQ G RULE)
      TOP
      (SET4 RULE (CDR RULE))
      (SETQ A (CAR RULE))
      (SETQ E (QUOTE *))
      (COND
        ((NOT (ATOM A))
         (GO START))
        ((EQ A (QUOTE *)) (GO STAR))
        ((EQ A (QUOTE *I.\))
         (GO *M))
        ((EQ A (QUOTE *Tl))
         (GO *Tl))
        ((EQ A (QUOTE *U))
         (GO *U)))
      (DEFLIST (CDR RULE) A)
      (KETURN (QUOTE *))
      STAR
      (SETQ RULE (CDR RULE))
      (SET4 E (FSTATivI RULE))
      START (COND
              ((AND
                (NULL TRACK)
                (NULL I4)) (GO TRACK))
              (PRINT (QUOTE LJORKSPACE))
              (PHI NT WORKSPACE)
              (PRINT (QUOTE RULE))
              (PRINT G)
              TRACK (SETQ LEFT (COMITMATCH (CAR RULE) WORKSPACE))
              (COND
                ((NULL LEFT) (RETURN El))
                LOOP
                (SETQ RULE (CDR RULE))
                (SET4 A (CAR RULE))
                (COND
                  ((NULL RULE) (RETURN El))
                  ((EQ A (QUOTE $1)) (GO DOLL))
                  ((EQUAL A O) (GO ON))
                  ((ATON A) (GO SW))
                  ((EQ (CAR A)
                       (QUOTE /)) (GO SHELVE)))
                ON
                (SETQ WORKSPACE (COMITR LEFT A))
                (COND
                  (M (PROGZ (PR1 NT (QUOTE WORKSPACE)) (PR1 NT WORKSPACE
                                                         1)))
                  (GO LOOP)
                DOLL
                (SETQ A (CAR WORKSPACE))
                SW
                (COND
                  ((EQ E (QUOTE *)) (RETURN A)))
                (RETURN (QUOTE *))
                SHELVE (SHELVE LEFT A)
                (GO LOOP)
                *M
                (SETQ M A)
                (GO TOP)
                *T
                (SETQ TRACK A)
                (GO TOP)
                *U
                (SETQ TRACK NIL)
                (GO TOP)))))

COMITRULE 函数用于处理规则，根据规则的不同情况进行相应操作，如跳转、匹配等。其流程较为复杂，涉及条件判断和递归调用。

3.5 TRANSFER函数

(TRAIJSFER
  (LAMBDA (GT RL) (PROG NIL
    START (COND
           ((NULL RL) (RETURN (LIST (QUOTE NONAME) GT)))
           ((EQ GT (CAAK RL)) (RETURN RL)))
           (SETQ RL (CDR RL))
           (GO START))))

该函数用于根据 GT 值在规则列表中查找匹配的规则，若未找到则返回包含 NONAME 的列表。

3.6 DISPATCH函数

(DI SPATCH
  (LAMBDA (GT)
    (PROG (A)
      (COND
        ((EQ GT (QUOTE *)) (RETURN GT)))
      (SETQ A (GTPAIR GT DISPCH))
      (COND
        ((NULL A) (RETURN GT)))
      (RETURN (CAR A)))))

DISPATCH 函数根据 GT 值在调度表中查找匹配项，若未找到则返回 GT 本身。

4. 其他辅助函数

除了上述主要函数外，程序中还有许多辅助函数，如 GTPAIR 、 FSTATM 、 SETDIS 、 GETDCT 等，它们各自承担着不同的功能，如查找匹配对、获取规则的第一个原子、设置调度表等。这些函数相互协作，共同完成METEOR程序的各项任务。

通过对METEOR的LISP程序的分析，我们可以看到其复杂而严谨的结构，各个函数之间的调用关系和逻辑判断构成了一个完整的系统，实现了规则的处理、匹配和控制转移等功能。

METEOR的LISP程序详解（续）

5. 更多关键函数深入分析

5.1 COMITR函数

(COMI TR
  (LAMBDA (LEFT ORDER)
    (PROG (A B C)
      (SETQ A (GTNAME O LEFT))
      (COND
        ((EQUAL A O) (SETQ A NIL))
        ((NULL A) (GO ON))
        ((ATOM A) (SETQ A (LIST A))))
      ON
      (SETQ B (GTNAblE (QUOTF WSEND)
                        LEFT))
      (COND
        ((EQUAL ORDER O) (SETQ C NIL))
        (T (SETQ C (COMITRIN LEFT ORDER))))
      (RETURN (APPEND A (APPEND C B))))))

COMITR 函数的主要作用是根据 LEFT 和 ORDER 生成结果。它首先调用 GTNAME 函数获取 A ，然后根据不同情况对 A 进行处理。接着获取 B ，并根据 ORDER 的值决定是否调用 COMITRIN 函数生成 C ，最后将 A 、 C 和 B 拼接返回。其工作流程如下：

graph TD;
    A[开始] --> B[调用GTNAME获取A];
    B --> C{ A是否等于O };
    C -- 是 --> D[设置A为NIL];
    C -- 否 --> E{ A是否为空 };
    E -- 是 --> F[跳转到ON];
    E -- 否 --> G{ A是否为原子 };
    G -- 是 --> H[将A转换为列表];
    G -- 否 --> F;
    F --> I[调用GTNAME获取B];
    I --> J{ ORDER是否等于O };
    J -- 是 --> K[设置C为NIL];
    J -- 否 --> L[调用COMITRIN生成C];
    K --> M[拼接A、C、B并返回];
    L --> M;

5.2 COMITRIN函数

(COMITRIN
  (LAMBDA (LEFT ORDER)
    (PROG (A B)
      START (COND
              ((NULL ORDER)
               (RETURN A)))
      (SETQ B (GTNAME (CAR ORDER)
                      LEFT))
      (COND
        ((NULL B) (GO ON))
        ((ATOM B) (SETQ B (LIST B))))
      (SETQ A (NCONC A B))
      ON
      (SETQ ORDER (CDR ORDER))
      (GO START))))

COMITRIN 函数用于遍历 ORDER 列表，根据 LEFT 调用 GTNAME 函数获取 B ，并将 B 合并到 A 中。其流程如下：

graph TD;
    A[开始] --> B{ ORDER是否为空 };
    B -- 是 --> C[返回A];
    B -- 否 --> D[调用GTNAME获取B];
    D --> E{ B是否为空 };
    E -- 是 --> F[跳转到ON];
    E -- 否 --> G{ B是否为原子 };
    G -- 是 --> H[将B转换为列表];
    G -- 否 --> I[将B合并到A];
    I --> F;
    F --> J[更新ORDER为CDR ORDER];
    J --> B;

5.3 GTNAME函数

(GTNAt4E
  (LAMBDA (NAME PRS)
    (PROG (A B C)
      (SET4 C (CAR NAME))
      (COND
        ((ATOM NAME)
         (GO START))
        ((EQ C (QUOTE FN))
         (RETURN (COPYTP (APPLY (CADR
                                  NAME)
                                 (COMITRIN PRS (CDDR NAME)) NIL))))
        ((EQ C (QUOTE *K))
         (RETURN (LIST (COMITRIN PRS
                                 (CDR NAME)))))
        ((EQ C (QUOTE *C))
         (RETURN (COMPRESS (COMITRIN
                            PRS (CDR NAME)))))
        ((EQ C (QUOTE *)) (RETURN (COPYTP (EVAL (CADR
                                                 NAI.1E)
                                                NIL))))
        ((EQ C (QUOTE *W))
         (RETURN (WRITES (COMITRIN
                          PRS (CDR NAME)))))
        ((EQ C (QUOTE *E)) (RETURN (EXPAND (GTNAME (
                                                 CADR NAME)
                                                PRS))))
        ((EQ C (QUOTE */)) (RETURN (LIST (SBMERGE (CDR
                                                   NAME)))))
        ((EQ C (QUOTE +N)) (RETURN (NEXT (CDR IIACIE))))
        ((EQ C (QUOTE *R))
         (RETURN (MTREAD)))
        ((EQ (CADR NAME)
             (QUOTE /)) (RETURI1 (LIST (SBMERGE
                                        (LIST (QUOTE I.ZERGE)
                                              C (CONS (QUOTE G99999) (CDR NAI4E))))))
        ((EQ C (QUOTE *F))
         (RETURN (CAAR (GTNAME (CADR
                                NAME)
                               PRS))))
        ((EQ C (QUOTE *A))
         (RETURN (ALL (CDR NAME))))
        ((EQ C (QUOTE QUOTE))
         (RETURN (CADR NAI4E))))
      START (COND
              ((NULL PRS) (RETURN NAME))
              (SETQ A (CAR PRS))
              (COND
                ((EQUAL NAME (CAR A))
                 (RETURN (COPYTP (CDR A)))))
              (SETQ PRS (CDR PRS))
              (GO START))))

GTNAME 函数根据 NAME 的不同形式进行不同的处理，包括调用其他函数进行计算、求值等。其处理规则如下表所示：
| NAME 形式 | 处理方式 |
| ---- | ---- |
| 原子 | 跳转到 START 进行后续处理 |
| (FN ...) | 应用函数并返回结果的副本 |
| (*K ...) | 返回 COMITRIN 结果的列表 |
| (*C ...) | 返回 COMITRIN 结果的压缩形式 |
| (* ...) | 求值并返回结果的副本 |
| (*W ...) | 调用 WRITES 函数处理 COMITRIN 结果 |
| (*E ...) | 展开 GTNAME 结果 |
| (*/ ...) | 返回 SBMERGE 结果的列表 |
| (+N ...) | 调用 NEXT 函数 |
| (*R) | 调用 MTREAD 函数 |
| ( ... / ...) | 返回特定 SBMERGE 结果的列表 |
| (*F ...) | 返回 GTNAME 结果的 CAAR |
| (*A ...) | 调用 ALL 函数 |
| (QUOTE ...) | 返回 CADR |

6. 匹配与合并相关函数

6.1 COMITMATCH函数

(COMITMATCH
  (LAMBDA (RULE WORKSPACE)
    (PROG (A B)
      (SETQ A (CMATCH (NAMER RULE) WORKSPACE NIL))
      (COND
        ((NULL A) (RETURN NIL))
        ((EQ A (QUOTE $IMP))
         (RETURN NIL)))
      (SETQ B (CONS (QUOTE WSEND)
                    (CDR A)))
      (RETURN (ADDLAST (CAR A) B)))))

COMITMATCH 函数调用 CMATCH 函数进行匹配，根据匹配结果进行处理，若匹配失败则返回 NIL ，否则进行结果的拼接和处理后返回。

6.2 CMATCH函数

(CMATCH
  (LAMBDA (RULE WORKSPACE WPAI RS)
    (PROG (RNAME A E C D E G
                 t i  1
      (SETQ RNAI*lE (CAR RULE))
      (SETQ RULE (CDR RULE))
      (SETQ B (CAR RULE))
      (COND
        ((NULL RULE) (RETURN (CONS MPAI RS WORKSPACE)))
        ((EQ B (QUOTE $0)) (GO $0))
        ((EQ B (QUOTE $1) (GO PDOLL)))
      (SETQ H (CAR B))
      (COND
        ((EQ H (QUOTE *P))
         (GO PRINT))
        ((EQ H (QUOTE FM))
         (GO FN))
        ((NULL k4ORKSPACE)
         (RETURN (QUOTE $l t . i P))))
      (SETQ G O)
      (COND
        ((EQ B (QUOTE $1))
         (SETQ G 1))
        ((EQ B (QUOTE $2)) (SETQ G 2))
        ((EQ B (QUOTE $3)) (SETQ G 3)))
      (COND
        ((NOT (EQUAL G O))
         (GO NDOLL2)))
      (GO TEST)
      go
      tcorro
      ((AND
        (NOT (NULL WORKSPACE))
        (NULL (CDR RULE)))
       (SETQ B NIL))
      (T (SET9 B (CONS NIL WORKSPACE)))
      (GO WATB)
      TEST
      (COND
        ((EQ tl (QUOTE $1) (GO NDOLL))
        ((EQ H (QUOTE *)) (GO EVAL))
        ((EQ H (QUOTE QUOTE))
         (GO ATB1))
        (T (GO ATG)))
      FN
      (SETQ B (CDR B))
      (SET9 E (CONS IJORKSPACE (COMITRIFJ b1PAI RS (CDR B
                                                         ))))
      (SETQ 6 (COPYTP (APPLY (CAR B) C NIL)))
      WATB
      (COND
        ((NULL 6) (RETURN NIL))
        ((EQ B (QUOTE $IMP))
         (RETURN B))
        (T (RETURN (CIv1ATCtI (CONS (CDR RNAME) (CDR RULE
                                                  1) (CDR B) (ADDLAST MPAIRS (CONS (CAR RNAME) (CAR B))))))))
      PDOLL (SETQ D (CDR RNAME))
      (SETQ RULE (CDR RULE))
      (COND
        ((NULL RULE) (RETURN (LIST (ADDLAST MPAIRS (
                                                  CONS (CAR RNAME) LJORKSPACE))))))
      DLOOP (SETQ B (CMATCH (CONS D RULE) HORKSPACE FlPAI RS))
      (COND
        ((NULL WORKSPACE)
         (RETURN NIL))
        ((EQ B (QUOTE 31E4P))
         (RETUR1.I
          R I))
        (B (RETURN (CUNS (ADDLAST (CAR G) (COriS (CAR
                                                  RNAME) C)) (CDR B)))))
      (SET4 C (ADDLAST C (CAR kJORKSPACE)))
      (SET4 LJORKSPACE (CDR WORKSPACE))
      (GO DLOOP)
      SUBMCH (SETQ B (SUBMCH B WORKSPACE))
      (GO WATB)
      PRINT (PRINT (CDR B))
      (PRINT WORKSPACE)
      $lMP
      (RETURN (QUOTE $IMP))
      EVAL
      (SETQ E (EVAL (CADI? B) NIL))
      (GO ATB2)
      ATB1
      (SET4 B (CADR El))
      (GO AT62)
      ATB
      (COND
        ((ATOt.1 G) (SETO. B (GTNAFlE B MPAI RS))))
      ATB2
      (SETQ II (CAR WORKSPACE))
      (COND
        ((ATOLI G) (GO B))
        ((EQ (CADR 6) (QUOTE /)) (GO SUBI~ICH))
        ((EQUAL B H) (SET4 B (COtiS (LIST 8) (CDR LJORKSPACE
                                              ))))
        (T (SETQ B NIL))
      (GO WATB)
      B
      (COND
        ((EQUAL B H) (SETQ B WORKSPACE))
        ((AND
          (EQUAL B (CAR H))
          (EQ (CADR H) (QUOTE /I))) (SETQ B (CONS (LIST
                                                   H) (CDR WORKSPACE))))
        (T (SETQ B NIL)))
      (GO WATB)
      NDOLL (SETQ G (CDR B))
      NDOLL2 (SETQ B (DOLNM G WORKSPACE))
      (GO WATB)))

CMATCH 函数是匹配的核心函数，根据规则和工作空间进行复杂的匹配操作，涉及多种条件判断和跳转，调用其他辅助函数完成匹配过程。其流程非常复杂，可根据不同的规则元素（如 $0 、 $1 、 *P 等）进行不同的处理。

6.3 SBMERGE函数

(SBMERGE
  (LAMBDA (X)
    (PROG (A B C D E G)
      (SETQ A (CAR X))
      (SETQ B (CADR X))
      (COND
        ((EQ (CADR B) (QUOTE /)) (GO EX))
      (SETQ B (GTNAME B PR'S))
      (COND
        ((NOT (ATOM 6)) (SETQ B (CAR 6))))
      EX
      (SETQ C (CADDR X))
      (COND
        ((EQ (CADR C) (QUOTE /)) (GO CX))
      (SETQ C (GTNAME C PRS))
      (COND
        ((NOT (ATOM X)) (SETQ C (CAR C))))
      CX
      (COND
        ((OR
          (ATOM C)
          (NOT (EQ (CADR C) (QUOTE /)))) (SETQ C EllL)
        (T (SETQ C (CDDR C))))
      (COND
        ((OR
          (ATON E)
          (NOT (EQ (CADR B) (QUOTE /)))) (GO G))
      (SETQ D (LIST (CAR B) (QUOTE /)))
      (SETQ G (CDDR B))
      (GO D)
      B
      (SETQ D (LIST B (QUOTE /)))
      (SET4 E NIL)
      D
      (COND
        ((EQ A (QUOTE AND))
         (GO AND))
        ((EQ A (QUOTE MERGE))
         (GO AND))
        ((EQ A (QUOTE OR))
         (GO OR))
        ((EQ A (QUOTE SUBST))
         (GO SU6ST)))
      ERROR (PRINT (QUOTE (SUBSCRIPT ERROR)))
      (PRINT X)
      (RETURN (GTNAME (CADR X) PRS))
      AND
      (COND
        ((NULL B) (GO RETURN))
        ((MEMBER (CAR B) C)
         (SETQ G (CONS (CAR B) G))
         (SETQ B (CDR B))
         (GO AND))
      OR
      (SETQ G C)
      OR1
      (COND
        ((NULL B) (GO RETURN))
        ((NOT (MEMBER (CAR B) G)) (SETQ G (CONS
                                           B) G)))
      (SETQ B (CDR 6))
      (GD OR1)
      SUBST (SET4 G C)
      RETURN (COND
               ((AND
                 (EQ A (QUOTE MERGE))
                 (NULL G))
                (SETQ G C))
               ((NULL G)
                (RETURN (CAR D)))
               (RETURN (NCONC D G)))))

SBMERGE 函数用于合并操作，根据输入的不同形式（如 AND 、 OR 、 SUBST 等）进行不同的合并处理。其工作流程较为复杂，涉及多次条件判断和调用其他函数。

7. 总结

METEOR的LISP程序是一个功能强大且复杂的系统，通过众多函数的相互协作，实现了规则的处理、匹配、控制转移、合并等功能。各个函数之间的调用关系和逻辑判断构成了一个完整的体系，每个函数都有其特定的功能和作用。在实际应用中，可以根据具体需求对这些函数进行组合和调用，以实现不同的业务逻辑。同时，通过对这些函数的分析，我们也可以学习到LISP语言在处理复杂逻辑和规则时的强大能力和灵活性。

通过深入研究这个程序，我们可以更好地理解LISP语言的编程思想和方法，以及如何构建一个高效、可维护的程序系统。在未来的开发中，我们可以借鉴这些经验，开发出更优秀的程序。