;======================================== ; ;　　　n 進構造の数詞の上の加法 ;======================================== ;========================================================================== ;　　九九表不使用の場合 ;========================================================================== (DEFUN MAIN ( )　　　　　　　　　　　　;実行用関数 　　(KNOW-CONSTANT) 　　(TASU '(7 A) '(B 5)) 　　　　　　　;16進数で 7A＋B5 ) (DEFUN TASU (M N) 　　(SETQ M1 (REVERSE M)) 　　(SETQ N1 (REVERSE N)) 　　(COND 　　　　((EQUAL N1 (LIST FIRST-LETR))　　(REVERSE (SUCCESSOR-OF M1))) 　　　　(T　　(REVERSE (SUCCESSOR-OF (TASU M1 (FORMER-OF N1))))) 　　) ) ;========================================================================== ;　　九九表使用の場合 ;========================================================================== (DEFUN MAIN ( )　　　　　　　　　　　　;実行用関数 　　(KNOW-CONSTANT) 　　(KNOW-TASU-TABLE) 　　(TASU '(7 A) '(B 5)) 　　　　　　　;16進数で 7A＋B5 ) (DEFUN TASU (M N) 　　(REVERSE (TASU0 (REVERSE M) (REVERSE N) NIL)) ) (DEFUN TASU0 (NUM1 NUM2 KURAI-AGARI)　　　　;KURAI-AGARI = T :位上りあり 　　(COND 　　　　　　　　　　　　　　　　　　; = NIL: なし 　　　　((AND (NULL NUM1) (NULL NUM2)) 　　　　　　(COND 　　　　　　　　((NULL KURAI-AGARI) NIL ) 　　　　　　　　( T '(1) ) 　　　　　　) 　　　　) 　　　　((NULL NUM2) 　　　　　　(COND 　　　　　　　　((NULL KURAI-AGARI) NUM1) 　　　　　　　　( T (SUCCESSOR-OF NUM1)) 　　　　　　) 　　　　) 　　　　((NULL NUM1) 　　　　　　(COND 　　　　　　　　((NULL KURAI-AGARI) NUM2) 　　　　　　　　( T (SUCCESSOR-OF NUM2)) 　　　　　　) 　　　　) 　　　　(T 　　　 　　　　　　(SETQ N ( FIND-TASU-VALUE-OF (CAR NUM1) (CAR NUM2))) 　　　　　　(COND 　　　　　　　　( (NULL KURAI-AGARI)　　　(SETQ NN N)) 　　　　　　　　( T (SETQ NN (SUCCESSOR-OF N)) ) 　　　　　　) 　　　　　　( COND 　　　　　　　　(( EQUAL (CADR NN) '1 ) 　　　　　　　　　　( CONS (CAR NN)　　　(TASU0 (CDR NUM1) (CDR NUM2) T) ) 　　　　　　　　) 　　　　　　　　(T 　　　　　　　　　　( CONS (CAR NN)　　　(TASU0 (CDR NUM1) (CDR NUM2) NIL) ) 　　　　　　　　) 　　　　　　) 　　　　) 　　) ) ;-------- 足し算九九表の中から，文字対 M,N に対応するリストを得る --------- (DEFUN FIND-TASU-VALUE-OF (M N)　　　　　　　　　　　　　; M,N はアトム 　　(F-T-V-O M N TASU-TABLE) ) (DEFUN F-T-V-O (M N G) 　　(COND 　　　　((EQUAL (LIST M N) (CAAR G))　　　(CADAR G) ) (T ( F-T-V-O M N (CDR G))) 　　) ) ;============ 数字を知る =============================================== (DEFUN KNOW-CONSTANT ( ) 　　(KNOW-SEQ) 　　(GET-FIRST-LETTER) 　　(GET-LAST-LETTER) 　　(KNOW-NULL-MARK) ) (DEFUN GET-FIRST-LETTER ( ) 　　(SETQ FIRST-LETR (CAR GIVEN-SEQ)) ) (DEFUN GET-LAST-LETTER ( ) 　　(SETQ LAST-LETR (G-L-L GIVEN-SEQ)) ) (DEFUN G-L-L (SEQ) 　　(COND 　　　　( (EQUAL (CDR SEQ) NIL)　　　(CAR SEQ) ) 　　　　( T　　　　　　(G-L-L (CDR SEQ)) ) 　　) ) (DEFUN KNOW-SEQ ( )　　　　　　　　　　　　　　　　　　;系列 　　(SETQ GIVEN-SEQ 　　　　　　'( 1 2 3 4 5 6 7 8 9 A B C D E F ) 　　) ) (DEFUN KNOW-NULL-MARK ( )　　　　　　　　　　　　　　　;空位の記号 　　(SETQ NULL-MARK　　　'@) ) ;=========== 前者，後者を得る ========================================== ;----------------------------------------------------------------------- ;文字のループ： ; ┌→ FIRST-LETR → ････ → LAST-LETR ┐ ; └─ NULL-MARK ←──────────┘ ; ;の中での，各文字の後者を得る (DEFUN ATO-LETTER-OF (LETR) 　　(COND 　　　　((EQUAL LETR NULL-MARK)　　　　　　FIRST-LETR ) 　　　　((EQUAL LETR LAST-LETR)　　　　　　NULL-MARK ) 　　　　( T　　　(FIND-ATO-LETTER LETR GIVEN-SEQ) ) 　　) ) (DEFUN FIND-ATO-LETTER (LETR SEQ) 　　(COND 　　　　((EQUAL LETR (CAR SEQ))　　　　　　(CADR SEQ)) 　　　　( T　　　　　　(FIND-ATO-LETTER LETR (CDR SEQ)) ) 　　) ) ;----------------------------------------------------------------------- ;文字のループ： ; ┌→ FIRST-LETR → ････ → LAST-LETR ┐ ; └─ NULL-MARK ←──────────┘ ; ;の中での，各文字の前者を得る (DEFUN MAE-LETTER-OF (LETR) 　　(COND 　　　　((EQUAL LETR NULL-MARK)　　　　　　LAST-LETR ) 　　　　((EQUAL LETR FIRST-LETR)　　　NULL-MARK ) 　　　　( T　　　(FIND-MAE-LETTER LETR GIVEN-SEQ) ) 　　) ) (DEFUN FIND-MAE-LETTER (LETR SEQ) 　　(COND 　　　　((EQUAL LETR (ATO-LETTER-OF (CAR SEQ)))　　　(CAR SEQ)) 　　　　( T　　　　　　(FIND-MAE-LETTER LETR (CDR SEQ)) ) 　　) ) ;----------------- 後者を得る --------------------------------------------- (DEFUN SUCCESSOR-OF (NUM)　　　　　　　　　　　　　　　　 ;NUM はリスト 　　(SETQ L (ATO-LETTER-OF (CAR NUM))) 　　(COND 　　　　((EQUAL L NULL-MARK)　　　　　　　　　　　　　　　;位上がりあり 　　　　　　(COND 　　　　　　　　((EQUAL (CDR NUM) NIL)　　　　　　　　　　;最上位が位上がり 　　　　　　　　　　(REVERSE (CONS FIRST-LETR (REVERSE (CONS L (CDR NUM))))) 　　　　　　　　) 　　　　　　　　( T　　　　　　(CONS L (SUCCESSOR-OF (CDR NUM))) ) 　　　　　　) 　　　　) 　　　　( T　　　　　(CONS L (CDR NUM)) )　　　　　　　　 ;位上がりなし 　　) ) ;----------------- 前者を得る --------------------------------------------- (DEFUN FORMER-OF (NUM)　　　　　　　　　　　　　　　　;NUM はリスト 　　(SETQ N (MAE-LETTER-OF (CAR NUM))) 　　(COND 　　　　((EQUAL (CDR NUM) NIL)　　　　　　　　　　　　;最上位数 　　　　　　(COND 　　　　　　　　((EQUAL N NULL-MARK)　　　NIL ) 　　　　　　　　( T 　　　(LIST N) ) 　　　　　　) 　　　　) 　　　　( T 　　　　　　(COND 　　　　　　　　((EQUAL N LAST-LETR) 　　　　　　　　　　(CONS N (FORMER-OF (CDR NUM))) 　　　　　　　　) 　　　　　　　　( T　　　(CONS N (CDR NUM)) ) 　　　　　　) 　　　　) 　　) ) ;======== 筆算のための参照テーブル（一位数同士の九九表ではない）========== (DEFUN KNOW-TASU-TABLE ( ) 　　(SETQ TASU-TABLE 　　　　'( 　　　　((@ @) (@ @)) ((@ 1) (1 @)) ((@ 2) (2 @)) ((@ 3) (3 @)) 　　　　((@ 4) (4 @)) ((@ 5) (5 @)) ((@ 6) (6 @)) ((@ 7) (7 @)) 　　　　((@ 8) (8 @)) ((@ 9) (9 @)) ((@ A) (A @)) ((@ B) (B @)) 　　　　((@ C) (C @)) ((@ D) (D @)) ((@ E) (E @)) ((@ F) (F @)) 　　　　 　　　　((1 @) (1 @)) ((1 1) (2 @)) ((1 2) (3 @)) ((1 3) (4 @)) 　　　　((1 4) (5 @)) ((1 5) (6 @)) ((1 6) (7 @)) ((1 7) (8 @)) 　　　　((1 8) (9 @)) ((1 9) (A @)) ((1 A) (B @)) ((1 B) (C @)) 　　　　((1 C) (D @)) ((1 D) (E @)) ((1 E) (F @)) ((1 F) (@ 1)) 　　　　((2 @) (2 @)) ((2 1) (3 @)) ((2 2) (4 @)) ((2 3) (5 @)) 　　　　((2 4) (6 @)) ((2 5) (7 @)) ((2 6) (8 @)) ((2 7) (9 @)) 　　　　((2 8) (A @)) ((2 9) (B @)) ((2 A) (C @)) ((2 B) (D @)) 　　　　((2 C) (E @)) ((2 D) (F @)) ((2 E) (@ 1)) ((2 F) (1 1)) 　　　　((3 @) (3 @)) ((3 1) (4 @)) ((3 2) (5 @)) ((3 3) (6 @)) 　　　　((3 4) (7 @)) ((3 5) (8 @)) ((3 6) (9 @)) ((3 7) (A @)) 　　　　((3 8) (B @)) ((3 9) (C @)) ((3 A) (D @)) ((3 B) (E @)) 　　　　((3 C) (F @)) ((3 D) (@ 1)) ((3 E) (1 1)) ((3 F) (2 1)) 　　　　((4 @) (4 @)) ((4 1) (5 @)) ((4 2) (6 @)) ((4 3) (7 @)) 　　　　((4 4) (8 @)) ((4 5) (9 @)) ((4 6) (A @)) ((4 7) (B @)) 　　　　((4 8) (C @)) ((4 9) (D @)) ((4 A) (E @)) ((4 B) (F @)) 　　　　((4 C) (@ 1)) ((4 D) (1 1)) ((4 E) (2 1)) ((4 F) (3 1)) 　　　　((5 @) (5 @)) ((5 1) (6 @)) ((5 2) (7 @)) ((5 3) (8 @)) 　　　　((5 4) (9 @)) ((5 5) (A @)) ((5 6) (B @)) ((5 7) (C @)) 　　　　((5 8) (D @)) ((5 9) (E @)) ((5 A) (F @)) ((5 B) (@ 1)) 　　　　((5 C) (1 1)) ((5 D) (2 1)) ((5 E) (3 1)) ((5 F) (4 1)) 　　　　((6 @) (6 @)) ((6 1) (7 @)) ((6 2) (8 @)) ((6 3) (9 @)) 　　　　((6 4) (A @)) ((6 5) (B @)) ((6 6) (C @)) ((6 7) (D @)) 　　　　((6 8) (E @)) ((6 9) (F @)) ((6 A) (@ 1)) ((6 B) (1 1)) 　　　　((6 C) (2 1)) ((6 D) (3 1)) ((6 E) (4 1)) ((6 F) (5 1)) 　　　　((7 @) (7 @)) ((7 1) (8 @)) ((7 2) (9 @)) ((7 3) (A @)) 　　　　((7 4) (B @)) ((7 5) (C @)) ((7 6) (D @)) ((7 7) (E @)) 　　　　((7 8) (F @)) ((7 9) (@ 1)) ((7 A) (1 1)) ((7 B) (2 1)) 　　　　((7 C) (3 1)) ((7 D) (4 1)) ((7 E) (5 1)) ((7 F) (6 1)) 　　　　((8 @) (8 @)) ((8 1) (9 @)) ((8 2) (A @)) ((8 3) (B @)) 　　　　((8 4) (C @)) ((8 5) (D @)) ((8 6) (E @)) ((8 7) (F @)) 　　　　((8 8) (@ 1)) ((8 9) (1 1)) ((8 A) (2 1)) ((8 B) (3 1)) 　　　　((8 C) (4 1)) ((8 D) (5 1)) ((8 E) (6 1)) ((8 F) (7 1)) 　　　　((9 @) (9 @)) ((9 1) (A @)) ((9 2) (B @)) ((9 3) (C @)) 　　　　((9 4) (D @)) ((9 5) (E @)) ((9 6) (F @)) ((9 7) (@ 1)) 　　　　((9 8) (1 1)) ((9 9) (2 1)) ((9 A) (3 1)) ((9 B) (4 1)) 　　　　((9 C) (5 1)) ((9 D) (6 1)) ((9 E) (7 1)) ((9 F) (8 1)) 　　　　((A @) (A @)) ((A 1) (B @)) ((A 2) (C @)) ((A 3) (D @)) 　　　　((A 4) (E @)) ((A 5) (F @)) ((A 6) (@ 1)) ((A 7) (1 1)) 　　　　((A 8) (1 2)) ((A 9) (3 1)) ((A A) (4 1)) ((A B) (5 1)) 　　　　((A C) (6 1)) ((A D) (7 1)) ((A E) (8 1)) ((A F) (9 1)) 　　　　((B @) (B @)) ((B 1) (C @)) ((B 2) (D @)) ((B 3) (E @)) 　　　　((B 4) (F @)) ((B 5) (@ 1)) ((B 6) (1 1)) ((B 7) (2 1)) 　　　　((B 8) (3 1)) ((B 9) (4 1)) ((B A) (5 1)) ((B B) (6 1)) 　　　　((B C) (7 1)) ((B D) (8 1)) ((B E) (9 1)) ((B F) (A 1)) 　　　　((C @) (C @)) ((C 1) (D @)) ((C 2) (E @)) ((C 3) (F @)) 　　　　((C 4) (@ 1)) ((C 5) (1 1)) ((C 6) (2 1)) ((C 7) (3 1)) 　　　　((C 8) (4 1)) ((C 9) (5 1)) ((C A) (6 1)) ((C B) (7 1)) 　　　　((C C) (8 1)) ((C D) (9 1)) ((C E) (A 1)) ((C F) (B 1)) 　　　　((D @) (D @)) ((D 1) (E @)) ((D 2) (F @)) ((D 3) (@ 1)) 　　　　((D 4) (1 1)) ((D 5) (2 1)) ((D 6) (3 1)) ((D 7) (4 1)) 　　　　((D 8) (5 1)) ((D 9) (6 1)) ((D A) (7 1)) ((D B) (8 1)) 　　　　((D C) (9 1)) ((D D) (A 1)) ((D E) (B 1)) ((D F) (C 1)) 　　　　((E @) (E @)) ((E 1) (F @)) ((E 2) (@ 1)) ((E 3) (1 1)) 　　　　((E 4) (2 1)) ((E 5) (3 1)) ((E 6) (4 1)) ((E 7) (5 1)) 　　　　((E 8) (6 1)) ((E 9) (7 1)) ((E A) (8 1)) ((E B) (9 1)) 　　　　((E C) (A 1)) ((E D) (B 1)) ((E E) (C 1)) ((E F) (D 1)) 　　　　((F @) (F @)) ((F 1) (@ 1)) ((F 2) (1 1)) ((F 3) (2 1)) 　　　　((F 4) (3 1)) ((F 5) (4 1)) ((F 6) (5 1)) ((F 7) (6 1)) 　　　　((F 8) (7 1)) ((F 9) (8 1)) ((F A) (9 1)) ((F B) (A 1)) 　　　　((F C) (B 1)) ((F D) (C 1)) ((F E) (D 1)) ((F F) (E 1)) 　　　　) 　　) )