close Warning: Can't synchronize with repository "(default)" (The repository directory has changed, you should resynchronize the repository with: trac-admin $ENV repository resync '(default)'). Look in the Trac log for more information.

source: branches/f4grobner/parser.lisp@ 622

Last change on this file since 622 was 622, checked in by Marek Rychlik, 9 years ago

* empty log message *

File size: 4.4 KB
RevLine 
[622]1;;; -*- Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*-
2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3;;;
4;;; Copyright (C) 1999, 2002, 2009, 2015 Marek Rychlik <rychlik@u.arizona.edu>
5;;;
6;;; This program is free software; you can redistribute it and/or modify
7;;; it under the terms of the GNU General Public License as published by
8;;; the Free Software Foundation; either version 2 of the License, or
9;;; (at your option) any later version.
10;;;
11;;; This program is distributed in the hope that it will be useful,
12;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with this program; if not, write to the Free Software
18;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
19;;;
20;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
21
22
23;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24;;
25;; Maxima expression parsing
26;;
27;;
28;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
29
30(eval-when
31 #+gcl (load eval)
32 #-gcl (:load-toplevel :execute)
33 (unless (find-package :maxima)
34 (defpackage "MAXIMA" (:use :cl))))
35
36(defpackage "PARSER"
37 (:use :cl)
38 (:export "PARSE-POLY"
39 "PARSE-POLY-LIST"
40 "PARSE-POLY-LIST-LIST"))
41
42(in-package :parser)
43
44;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
45;;
46;; Functions and macros dealing with internal representation
47;; structure.
48;;
49;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
50
51(defun equal-test-p (expr1 expr2)
52 (alike1 expr1 expr2))
53
54(defun coerce-maxima-list (expr)
55 "Convert a Maxima list to Lisp list."
56 (cond
57 ((and (consp (car expr)) (eql (caar expr) 'mlist)) (cdr expr))
58 (t expr)))
59
60(defun free-of-vars (expr vars) (apply #'$freeof `(,@vars ,expr)))
61
62(defun parse-poly (expr vars &aux (vars (coerce-maxima-list vars)))
63 "Convert a maxima polynomial expression EXPR in variables VARS to internal form."
64 (labels ((parse (arg) (parse-poly arg vars))
65 (parse-list (args) (mapcar #'parse args)))
66 (cond
67 ((eql expr 0) (make-poly-zero))
68 ((member expr vars :test #'equal-test-p)
69 (let ((pos (position expr vars :test #'equal-test-p)))
70 (make-variable *expression-ring* (length vars) pos)))
71 ((free-of-vars expr vars)
72 ;;This means that variable-free CRE and Poisson forms will be converted
73 ;;to coefficients intact
74 (coerce-coeff *expression-ring* expr vars))
75 (t
76 (case (caar expr)
77 (mplus (reduce #'(lambda (x y) (poly-add *expression-ring* x y)) (parse-list (cdr expr))))
78 (mminus (poly-uminus *expression-ring* (parse (cadr expr))))
79 (mtimes
80 (if (endp (cddr expr)) ;unary
81 (parse (cdr expr))
82 (reduce #'(lambda (p q) (poly-mul *expression-ring* p q)) (parse-list (cdr expr)))))
83 (mexpt
84 (cond
85 ((member (cadr expr) vars :test #'equal-test-p)
86 ;;Special handling of (expt var pow)
87 (let ((pos (position (cadr expr) vars :test #'equal-test-p)))
88 (make-variable *expression-ring* (length vars) pos (caddr expr))))
89 ((not (and (integerp (caddr expr)) (plusp (caddr expr))))
90 ;; Negative power means division in coefficient ring
91 ;; Non-integer power means non-polynomial coefficient
92 (mtell "~%Warning: Expression ~%~M~%contains power which is not a positive integer. Parsing as coefficient.~%"
93 expr)
94 (coerce-coeff *expression-ring* expr vars))
95 (t (poly-expt *expression-ring* (parse (cadr expr)) (caddr expr)))))
96 (mrat (parse ($ratdisrep expr)))
97 (mpois (parse ($outofpois expr)))
98 (otherwise
99 (coerce-coeff *expression-ring* expr vars)))))))
100
101(defun parse-poly-list (expr vars)
102 "Parse a Maxima representation of a list of polynomials."
103 (case (caar expr)
104 (mlist (mapcar #'(lambda (p) (parse-poly p vars)) (cdr expr)))
105 (t (merror "Expression ~M is not a list of polynomials in variables ~M."
106 expr vars))))
107
108(defun parse-poly-list-list (poly-list-list vars)
109 "Parse a Maxima representation of a list of lists of polynomials."
110 (mapcar #'(lambda (g) (parse-poly-list g vars)) (coerce-maxima-list poly-list-list)))
111
Note: See TracBrowser for help on using the repository browser.