Синтаксический и семантический анализ арифметического выражения

@mr_Bo · Регистрация: 08.09.2012

Студворк — интернет-сервис помощи студентам

Здравствуйте.
Имею задание:
Написать программу, которая будет выполнять синтаксический и семантический анализ арифметических выражений. Выражение может иметь произвольный уровень вложенности скобок, использовать арифметические операции *, + , –, / , а также вызовы функций tg, cos, sin. Учитывать, что при синтаксическом анализе выражение может содержать константы и переменные. Перед выполнением семантического анализа всем переменным должны быть присвоены соответствующие значения. Переменные в исходном выражении, которым будут присвоены значения, должны идентифицироваться автоматически. Если выражение содержит ошибки, то при формировании результата синтаксического анализа должен быть указан тип ошибки. Для семантического анализа должен быть предусмотрен режим пошагового отображения, т.е. вывод текущего состояния вычисляемого выражения после выполнения каждой операции.

Содрал из книги "Мир лиспа" код:

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
(setq *operation* '(* / + - :=))
 
(defun reader ()
       ((lambda(x)
                  (if (eq x '!) nil
                      (cons x (reader))))
       (read)))
 
       
       
(defun analiz (derevo stek virazh)
       (cond 
             ((null virazh)
             (if (car stek)
                 (transform derevo stek virazh)
                 (car derevo))
             ((atom virazh) virazh)
             ((atom (car virazh))
             (cond 
                   ((not (member (car virazh) *operation*))
                   (analiz (cons (car virazh) derevo) stek (cdr virazh)))
                   ((older (car virazh) (car stek))
                   (analiz derevo (cons (car virazh)) stek) (cdr virazh)))
                   (t (transform derevo stek virazh)
                   (t (analiz (cons (analiz nil '(nil) (car virazh)) derevo) stek (cdr virazh)))))
                   
(defun transform (derevo stek virazh)
              (analiz (cons (list (car stek) (cadr derevo) (car derevo))
              (cddr derevo))
              (cdr stek) virazh))
 
(defun older (p q)
              (or (null q)
                  (member q (member p *operation*))))     
 
                  
(defun calculate (x &aux znach)
       (cond 
             ((numberp x) x)
             ((atom x)
                    (if (setq znach
                        (get x 'znach))
                    (calculate znach) x))
             (t (primeni (first x)
                (mapcar (function calculate)
                        (cdr x))))))
   
(defun primeni (operation args &aux (op (get operation 'fn)))
(if op (apply op args)
    (list op 
          (calculate (first args))
          (calculate (second args)))))
       
(defmacro defdeistvie (deistvie args telo)
          '(setf (get',deistvie 'fn)
          '(lambda ,args ,telo)))
 
(defdeistvie + (x y)
             (cond ((zerop x) y)
             ((zerop y) x)
             ((and (numberp x) (numberp y))
                   (+ x y))
             (t '(+ ,x ,y))))
             
(defdeistvie - (x y)
             (cond ((zerop y) x)
             ((and (numberp x) (numberp y))
                   (- x y))
             (t '(- ,x ,y))))
             
(defdeistvie * (x y)
             (cond ((equal x 1) y)
             ((equal y 1) x)
             ((or zerop x) (zerop y)) 0)
             ((and (nuberp x) (numberp y))
                   (* x y))
             (t '(* ,x ,y))))
 
(defdeistvie / (x y)
             (cond ((zerop x) 0)
                   ((zerop y) 'inf)
                   ((equal x y) 1)
                   ((and (numberp x) (numberp y))
                         (/ x y))
                   (t '(/ ,x ,y))))
 
(defdeistvie := (x y)
             (if (symbolp x)
                 (setf (get x 'znach) y)
                 (error "~%~S nelzia prisvoit znachenie" x)))
 
    
(defun ubrat-skobki (x)
       (if (atom x) x
         (append (ubrat-u-operator (first x) (second x))
         (list (first x))
         (ubrat-u-operator (first x) (third x)))))
         
(defun ubrat-u-operator (operator virazh &aux (x (ubrat-skobki virazh)))
       if (or (atom x)
          (older operator (second x)))
          (list x)
          x))
 
(defun Analizator (&auk virazh)
       (princ "Analizator:")
       (loop
       (terpri)
       (princ"<=")
       (setq virazh (reader))
       (when (equal virazh '(konec))
             (return))
             (princ"=> ")
             (prinl (ubrat-skobki( calculate (analiz nil '(nil) virazh))))

При попытке скомпилировать на muLisp выдает много ошибок синтаксиса. Просьба помочь.

@Catstail · 09.09.2012, 11:38

Естественно, что в muLisp этот код сразу не заработает... Нужно отлаживать. Могу дать свой код, проверенный в HomeLisp (код не совсем мой, но руку приложил).

@mr_Bo · 09.09.2012, 12:40 **[ТС]**

Давайте конечно

@Nameless One · 09.09.2012, 13:18

В каком формате должны быть выражения? Приведи примеры.

@mr_Bo · 09.09.2012, 14:15 **[ТС]**

(A + B) * 9!
! - конец ввода
между символами пробелы

@Catstail · 09.09.2012, 17:26

Вот как это реализовано в HomeLisp. Код не вполне мой, но и я руку приложил:

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
(Defun weight (x) 
       (COND ((EQ x '+) 1) 
             ((EQ x '-) 1) 
             ((EQ x '*) 2) 
             ((EQ x '\) 2) 
             ((EQ x '/) 2) 
             ((EQ x '^) 3) 
             (T 5)) )
 
(Defun opcode (op) 
       (COND ((EQ op '+) '+)
             ((EQ op '-) '-)
             ((EQ op '*) '*)
             ((EQ op '\) '\)
             ((EQ op '/) '/)
             ((EQ op '^) '^) 
             (T (RAISEERROR (STRCAT "Неверен код операции " (OUTPUT op))))) )
 
 
(Defun inf-aux  (ae operators operands) 
       (inf-iter (CDR ae) operators (CONS (CAR ae) operands))) 
 
 
(Defun inf-iter (ae operators operands) 
       (PROG NIL 
             (COND ((AND (NULL ae) (NULL operators)) (RETURN (CAR operands))))
             (COND ((AND 
                        (NOT (NULL ae)) 
                        (OR (NULL operators) (GREATERP (weight (CAR ae)) (weight (CAR operators))))
                    )
                     (RETURN (inf-aux (CDR ae) (CONS (CAR ae) operators) operands)))) 
             (RETURN (inf-iter ae (CDR operators) 
                                  (CONS (LIST (opcode (CAR operators))
                                              (CADR operands) (CAR operands))
                                        (CDDR operands))))))
 
(Defun inf2pref (x) 
       (PROG (hd tl cc xx rr) 
             (COND ((atomlist x) (RETURN (inf-aux x NIL NIL))))
             (SETQ rr NIL)
             (SETQ xx x) 
        LOOP (SETQ hd (CAR xx)) 
             (SETQ tl (CDR xx)) 
             (COND ((memb hd (QUOTE (SIN COS LOG EXP ATN ASN ACS SH CH SQR SIGN ABS))) 
                           (PROGN (SETQ rr (APPEND rr (LIST (LIST hd (inf2pref (CAR tl))))))
                                  (SETQ tl (CDR tl))))
                   ((ATOM hd) 
                            (SETQ rr (APPEND rr (LIST hd))))
                   (T (SETQ rr (APPEND rr (LIST (inf2pref hd))))))
             (COND ((NULL tl)
                   (RETURN (inf-aux rr NIL NIL)))) (SETQ xx tl) (GO LOOP)))
 
(Defun CalcExpr (expression) (EVAL (inf2pref (PARSE expression))))

Вот протокол проверки:

Lisp
1
2
3
4
5
6
7
(calcExpr "5+(7-4)*5")
 
==> 20
 
(calcExpr "(sin(1))^2+(cos(1))^2")
 
==> 1.000000000000000E+0

Правда, эта программа не обрабатывает переменные (только константы). Впрочем, это легко исправить.
Кроме того, она использует функцию HomLisp parse, которая парсит входную строку. В Common Lisp такой функции нет, но ее можно написать.

@Catstail · 10.09.2012, 18:49

А Ваш код - это ни больше, ни меньше - набросок Micsim-ы из финского двухтомника. В muLisp-е он работать не будет, а в HomeLisp-е будет:

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
(setq *действия* '(:= + - * / ^))
 
(defun amember (x y) (COND ((NULL y) NIL) ((equal x (CAR y)) y) (T (amember x (CDR y)))))
 
(defun старше (p q)
  (or (null q)
       (not (amember q (amember p *действия*)))))
 
(defun анализируй (дерево стек выражение)
   (cond 
     ((null выражение) (if (car стек) (преобразуй дерево стек выражение) (car дерево)))
     ((atom выражение) выражение)
     ((atom (car выражение))
           (cond
              ((not (amember (car выражение) *действия*))
                 (анализируй (cons (car выражение) дерево) стек (cdr выражение)))
              ((старше (car выражение) (car стек))
                 (анализируй дерево (cons (car выражение) стек) (cdr выражение)))
              (t (преобразуй дерево стек выражение))))
     (t (анализируй (cons (анализируй nil '(nil) (car выражение)) дерево) стек (cdr выражение)))))
 
(defun преобразуй (дерево стек выражение)
    (анализируй 
       (cons (list (car стек) (cadr дерево) (car дерево)) (cddr дерево)) (cdr стек) выражение))
 
(defun обработай (нечто) (анализируй nil '(nil) нечто))
 
(defun вычисли (x &aux значение)
   (cond 
     ((numberp x) x)
     ((atom x) (if (setq значение (getprop x 'значение)) (вычисли значение) x))
     (t (примени (car x) (mapcar (function вычисли) (cdr x)))))) 
 
(defun примени (операция args &aux (op (getprop операция 'fn)))
   (if op (apply op args)
          (list op (вычисли (car args)) (вычисли (cadr args)))))
 
(defmacro defдействие (действие args тело)
  `(putprop ',действие 'fn '(lambda ,args ,тело)))
 
(defun zeropp (x)
  (cond ((numberp x) (if (zerop x) t nil))
        (t nil)))
 
;;
;; операции
;;
 
(defдействие + (x y) 
   (cond ((zeropp x) y)
         ((zeropp y) x)
         ((and (numberp x) (numberp y)) (+ x y))
         (t `(+ ,x ,y))))
   
(defдействие - (x y) 
   (cond ((zeropp y) x)
         ((and (numberp x) (numberp y)) (- x y))
         (t `(- ,x ,y))))
 
(defдействие * (x y) 
   (cond ((equal x 1) y)
         ((equal y 1) x)
         ((or (zeropp x) (zeropp y)) 0) 
         ((and (numberp x) (numberp y)) (* x y))
         (t `(* ,x ,y))))
 
(defдействие ^ (x y) 
   (cond ((and (zeropp x) (zeropp y)) 'err)
         ((zeropp x) 0)
         ((zeropp y) 1)
         ((equal x 1) 1)
         ((equal y 1) x)
         ((and (numberp x) (numberp y)) (^ x y))
         (t `(^ ,x ,y))))
 
(defдействие / (x y) 
   (cond ((zeropp y) 'inf)
         ((zeropp x) 0)
         ((equal x y) 1)
         ((and (numberp x) (numberp y)) (\ x y))
         (t `(\ ,x ,y))))
 
(defдействие := (x y)
   (if (atom x) (putprop x 'значение y) nil))
 
(defun снять-скобки (x)
   (if (atom x) 
       x
       (append
         (append 
           (снять-у-оператора
                 (car x) (cadr x))
           (list (car x)))
         (снять-у-оператора (car x) (caddr x)))))
 
(defun снять-у-оператора (оператор выражение &aux (x (снять-скобки выражение)))
   (if (or (atom x) (старше оператор (cadr x))) (list x) x))

Проверяем:

Lisp
1
2
3
4
5
6
7
8
9
10
11
(вычисли (анализируй nil '(nil) '(a := 111)))
 
==> a
 
(вычисли (анализируй nil '(nil) '(b := 222)))
 
==> b
 
(вычисли (анализируй nil '(nil) '(a ^ 2 + b ^ 2)))
 
==> 61605

@mr_Bo · 15.09.2012, 10:01 **[ТС]**

Огромное спасибо! Сдал.

Новые блоги и статьи Все статьи Все блоги /
Мысли в слух. Про "навсегда". kumehtar 16.04.2026 Подумалось тут, что наверное очень глупо использовать во всяких своих установках понятие "навсегда". Это очень сильное понятие, и я только начинаю понимать край его смысла, не смотря на то что давно. . .	My Business CRM MaGz GoLd 16.04.2026 Всем привет, недавно возникла потребность создать CRM, для личных нужд. Собственно программа предоставляет из себя базу данных клиентов, в которой можно фиксировать звонки, стадии сделки, а также. . .	Знаешь почему 90% людей редко бывают счастливыми? kumehtar 14.04.2026 Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.	Фиксация колонок в отчете СКД Maks 14.04.2026 Фиксация колонок в СКД отчета типа Таблица. Задача: зафиксировать три левых колонки в отчете. Процедура ПриКомпоновкеРезультата(ДокументРезультат, ДанныеРасшифровки, СтандартнаяОбработка) / / . . .
Настройки VS Code Loafer 13.04.2026 { "cmake. configureOnOpen": false, "diffEditor. ignoreTrimWhitespace": true, "editor. guides. bracketPairs": "active", "extensions. ignoreRecommendations": true, . . .	Оптимизация кода на разграничение прав доступа к элементам формы Maks 13.04.2026 Алгоритм из решения ниже реализован на нетиповом документе, разработанного в конфигурации КА2. Задачи, как таковой, поставлено не было, проделанное ниже исключительно моя инициатива. Было так:. . .	Контроль заполнения и очистка дат в зависимости от значения перечислений Maks 12.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: реализовать контроль корректности заполнения дат назначения. . .	Архитектура слоя интернета для сервера-слоя. Hrethgir 11.04.2026 В продолжение https:/ / www. cyberforum. ru/ blogs/ 223907/ 10860. html Знаешь что я подумал? Раз мы все источники пишем в голове ветки, то ничего не мешает добавить в голову такой источник, который сам. . .

@Catstail Супер-модератор 38203 / 21135 / 4310 Регистрация: 12.02.2012 Сообщений: 34,741 Записей в блоге: 14
	09.09.2012, 11:38
	Естественно, что в muLisp этот код сразу не заработает... Нужно отлаживать. Могу дать свой код, проверенный в HomeLisp (код не совсем мой, но руку приложил). 0

@mr_Bo 0 / 0 / 0 Регистрация: 08.09.2012 Сообщений: 4
	09.09.2012, 12:40 [ТС]
	Давайте конечно 0

@Nameless One 5828 / 3479 / 358 Регистрация: 08.02.2010 Сообщений: 7,448
	09.09.2012, 13:18
	В каком формате должны быть выражения? Приведи примеры. 0

@mr_Bo 0 / 0 / 0 Регистрация: 08.09.2012 Сообщений: 4
	09.09.2012, 14:15 [ТС]
	(A + B) * 9! ! - конец ввода между символами пробелы 0

@mr_Bo 0 / 0 / 0 Регистрация: 08.09.2012 Сообщений: 4
	15.09.2012, 10:01 [ТС]
	Огромное спасибо! Сдал. 0