대화형 모드의 진법(radix) 변환 예제 with Common Lisp

다음은  대화형 모드(interactive mode)에서 진법 변환(radix conversion)하는 Common Lisp 소스 코드이다.

메뉴는 주메뉴 Command: (S)et radix, (A)bout, (Q)uit or E(x)it
와 부메뉴 SubCommand: 'main()' to goto Main menu, 'exit()' or 'quit()' to exit
로 구성되어 있으며, 진법 변환의 핵심은 아래 소스의 52째 줄과 53째 줄에 있는

       (setf val (parse-integer s :radix srcRdx))
        (setf ret (write-to-string val :base destRdx))

이다. 지원되는 진법은 2진법에서 36진법까지이다.

1. ;;  Filename: convertRadix.lsp
2. ;;            Convert radix in a interactive mode.
3. ;;
4. ;;  Execute: clisp convertRadix.lsp
5. ;;
6. ;;      Date:  2013. 9. 5.
8. (defun printUsage()
9.     (format t "Usage: clisp convertRadix.lsp~%")
10.     (format t "Convert radix in a interactive mode, where the maximum radix is 36.~%") )
12. (defun printAbout()
13.     (format t "    About: Convert radix in a interactive mode.~%") )
15. (defun printMainMenu()
16.     (format t "  Command: (S)et radix, (A)bout, (Q)uit or E(x)it~%") )
18. (defun printMainPrompt()
19.     (format t "  Prompt> ") )
21. (defun printSubMenu(srcRadix destRadix)
22.     (format t "    Convert Radix_~D to Radix_~D~%" srcRadix destRadix)
23.     (format t "    SubCommand: 'main()' to goto Main menu, 'exit()' or 'quit()' to exit~%") )
25. (defun printSubPrompt()
26.     (format t "    Input Value>> ") )
29. (setf *BASE36* "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ")
31. (defun join-string-list (string-list)
32.     "Concatenates a list of strings and puts spaces between the elements."
33.     (format nil "~{~A~^~}" string-list))
35. (define-condition invalid-src-radix (error)
36.   ((msg :reader msg :initarg :msg))
37.   (:report (lambda (condition stream)
38.              (format stream "Exception: ~A." (msg condition)))))
40. (define-condition invalid-dest-radix (error)
41.   ((msg :reader msg :initarg :msg))
42.   (:report (lambda (condition stream)
43.              (format stream "Exception: ~A." (msg condition)))))
45. (defun convertRadix(s srcRdx destRdx)
46.   (ignore-errors
47.     (if (or (< srcRdx 2) (> srcRdx 36))
48.         (error 'invalid-src-radix :msg (format nil "Invalid source radix: ~A" srcRdx)))
49.     (if (or (< destRdx 2) (> destRdx 36))
50.         (error 'invalid-dest-radix :msg (format nil "Invalid destination radix: ~A" destRdx)))
51.     (let ((ret ""))
52.         (setf val (parse-integer s :radix srcRdx))
53.         (setf ret (write-to-string val :base destRdx))
54.         (string-upcase ret)))
55.   )
57. (defun nonwhite-char-p (c)
58.     (> (char-code c) (char-code #\Space)))
60. (defun white-char-p (c)
61.     (<= (char-code c) (char-code #\Space)))
63. (defun safe-parse-integer (s)
64.         (handler-case
65.              (parse-integer s :radix 10)
66.              (parse-error (c)
67.                        (format t "예외상황 발생: ~A" c)
68.                )
69.         )
70. )
72. (defun get-token (s)
73.   (let* ((i (if (find (elt s 0) "+-") 1 0))
74.          (d (position-if 'nonwhite-char-p s :start i))
75.          (f (position-if 'white-char-p s :start (1+ d))))
76.     ; (format t "d = ~A~%" d)
77.     ; (format t "f = ~A~%" f)
78.     (substring s d f)))
80. (defun get-two-tokens (s)
81.   (let* ((i (if (find (elt s 0) "+-") 1 0))
82.          (d (position-if 'nonwhite-char-p s :start i))
83.          (f (position-if 'white-char-p s :start (1+ d)))
84.          (d2 (position-if 'nonwhite-char-p s :start (1+ f)))
85.          (f2 (position-if 'white-char-p s :start (1+ d2))))
86.     (format t "d = ~A~%" d)
87.     (format t "f = ~A~%" f)
88.     (format t "d2 = ~A~%" d2)
89.     (format t "f2 = ~A~%" f2)
90.     (list (substring s d f) (substring s d2 f2)) ))
92. (defun get-tokens (s)
93.   (let ((arr (list))
94.         (n (length s))
95.         (x "")
96.         (c #\Space))
97.       (loop for i from 0 below n do
98.           (setf c (aref s i))
99.           (if (white-char-p c)
100.               (if (> (length x) 0) (progn
101.                    (push x arr)
102.                    (setf x "") )))
103.           (if (nonwhite-char-p c) (progn
104.                    (setf x (concatenate 'string x (format nil "~A" c))) ))
105.       )
106.       (if (> (length x) 0)
107.                    (push x arr))
109.       (reverse arr) ))
111. (defun doConvert(srcRadix destRadix)
112.     (let ((line "")
113.           (cmd "")
114.           (innerLoop t)
115.           (srcStr "")
116.           (destStr ""))
118.         (format t "~%")
119.         (printSubMenu srcRadix destRadix)
121.         (handler-case
122.           (progn
123.             (loop while innerLoop do
124.                 (printSubPrompt)
125.                 (setf cmd (read-line))
126.                 (setf cmd (string-trim " " cmd))
128.                 (if (equal (string-downcase cmd) "main()")
129.                     (progn
130.                         (setf innerLoop nil)
131.                         (return nil) ))
132.                 (if (or (equal (string-downcase cmd) "exit()") (equal (string-downcase cmd) "quit()"))
133.                     (quit))
135.                 (handler-case
136.                   (progn
137.                      (parse-integer cmd :radix srcRadix)
138.                      (setf srcStr (string-upcase cmd))
139.                      (setf destStr (convertRadix srcStr srcRadix destRadix))
                          (format t "        ( ~A )_~A   --->   ( ~A )_~A~%" srcStr srcRadix destStr destRadix)
140.                      (format t "~%")
141.                   )
142.                  (parse-error (c)
143.                        (format t "예외상황 발생: ~A" c)
144.                        (format t "다시 입력하시오,~%~%") )
145.                )
146.             )
147.         ))
148.     t
149.     ))
151. (defun doStart()
152.     (let ((line "")
153.           (cmd "")
154.           (outerLoop t)
155.           (srcRadix 10)
156.           (destRadix 10)
157.           (srcStr "")
158.           (destStr "")
159.           (onlyOnce t))
161.         (handler-case
162.           (progn
163.             (loop while outerLoop do
164.                    (format t "~%")
165.                    (if (equal onlyOnce t) (progn
166.                         (format t "  The supported maximum radix is 36.~%")
167.                         (setf onlyOnce nil)
169.                         (printMainMenu)
170.                         (printMainPrompt)
171.                         (setf cmd (read-line))
172.                         (setf cmd (string-trim " " cmd))
174.                         (if (or (equal cmd "q") (equal cmd "Q") (equal cmd "x") (equal cmd "X")) (quit) )
175.                         (if (or (equal cmd "a") (equal cmd "A")) (progn (printAbout) (setf onlyOnce t)) )
177.                         (if (or (equal cmd "s") (equal cmd "S")) (progn
178.                                (format t "  Input the source and target radices (say, 16 2): ")
179.                                (setf line (read-line))
180.                                (setf st (get-tokens line))
182.                                (loop while (not (= (length st) 2)) do
183.                                    (format t "  Input the source and target radices (say, 16 2): ")
184.                                    (setf line (read-line))
185.                                    (setf st (get-tokens line)) )
187.                                ; (setf srcRadix (parse-integer (nth 0 st) :radix 10))
188.                                ; (setf destRadix (parse-integer (nth 1 st) :radix 10))
189.                                (setf srcRadix (safe-parse-integer (nth 0 st)))
190.                                (setf destRadix (safe-parse-integer (nth 1 st)))
192.                                (if (and (not (equal srcRadix nil)) (not (equal destRadix nil)))
193.                                    (progn
194.                                        (doConvert srcRadix destRadix)
195.                                        (setf onlyOnce t)
196.                                    )
197.                                    (progn
198.                                        (format t "두 수를 다시 입력하시오.~%")
199.                                        (setf onlyOnce t)
200.                                    )
201.                                )
202.                         ))
203.             ))
204.           )
205.         ))
206.     ))
209. ;; Begin here
210. (if (and (> (length ext:*args*) 0) (equal (nth 0 ext:*args*) "-h")) (progn
211.     (printUsage)
212.     (quit) ))
214. (doStart)

실행> clisp convertRadix.lsp

  The supported maximum radix is 36.
  Command: (S)et radix, (A)bout, (Q)uit or E(x)it
  Prompt> s
  Input the source and target radices (say, 16 2): 10 8

    Convert Radix_10 to Radix_8
    SubCommand: 'main()' to goto Main menu, 'exit()' or 'quit()' to exit
    Input Value>> 200
        ( 200 )_10   --->   ( 310 )_8

    Input Value>> main()

  Command: (S)et radix, (A)bout, (Q)uit or E(x)it
  Prompt> S
  Input the source and target radices (say, 16 2): 8 10

    Convert Radix_8 to Radix_10
    SubCommand: 'main()' to goto Main menu, 'exit()' or 'quit()' to exit
    Input Value>> 2666
        ( 2666 )_8   --->   ( 1462 )_10

    Input Value>> main()

  Command: (S)et radix, (A)bout, (Q)uit or E(x)it
  Prompt> x