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

@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 **[ТС]**

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

Новые блоги и статьи Все статьи Все блоги /
Отображение реквизитов в документе по условию и контроль их заполнения Maks 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеСпецтехники", разработанного в конфигурации КА2. Данный документ берёт данные из другого нетипового документа. . .	Фото всей Земли с борта корабля Orion миссии Artemis II kumehtar 04.04.2026 Это первое подобное фото сделанное человеком за 50 лет. Снимок называют новым вариантом легендарной фотографии «The Blue Marble» 1972 года, сделанной с борта корабля «Аполлон-17». Новое фото. . .	Вывод диалогового окна перед закрытием, если документ не проведён Maks 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: реализовать программный контроль на предмет проведения документа. . .	Программный контроль заполнения реквизита табличной части документа Maks 02.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: реализовать контроль заполнения реквизита "ПричинаСписания". . .
wmic не является внутренней или внешней командой Maks 02.04.2026 Решение: DISM / Online / Add-Capability / CapabilityName:WMIC~~~~ Отсюда: https:/ / winitpro. ru/ index. php/ 2025/ 02/ 14/ komanda-wmic-ne-naydena/	Программная установка даты и запрет ее изменения Maks 02.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: при создании документов установить период списания автоматически. . .	Вывод данных в справочнике через динамический список Maks 01.04.2026 Реализация из решения ниже выполнена на примере нетипового справочника "Спецтехника" разработанного в конфигурации КА2. Задача: вывести данные из ТЧ нетипового документа. . .	Программное заполнения текстового поля в реквизите формы документа Maks 01.04.2026 Алгоритм из решения ниже реализован на нетиповом документе "ВыдачаОборудованияНаСпецтехнику" разработанного в конфигурации КА2, в дополнении к предыдущему решению. На форме документа создается. . .

@Catstail Супер-модератор 38195 / 21128 / 4309 Регистрация: 12.02.2012 Сообщений: 34,736 Записей в блоге: 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