- Timestamp:
- 2016-06-07T19:34:32-07:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/infix-printer.lisp
r4404 r4405 81 81 (cond 82 82 ;; Handle *print-level* 83 ((and (numberp *print-level*)84 (> print-level *print-level*))85 (format stream "#"))83 ((and (numberp *print-level*) 84 (> print-level *print-level*)) 85 (format stream "#")) 86 86 87 ;; Null expression is an error88 ((null expr)89 (error "Null expression."))87 ;; Null expression is an error 88 ((null expr) 89 (error "Null expression.")) 90 90 91 ;; Atoms are printed using ~A format directive92 ((atom expr)93 (format stream "~a" expr))91 ;; Atoms are printed using ~A format directive 92 ((atom expr) 93 (format stream "~a" expr)) 94 94 95 ;; Check if the operator of this expression has lower precedence96 ;; than the surrounding operator, and parenthesize if necessary97 ((and op98 (operator-lessp (car expr) op))99 (format stream "(")100 (infix-print expr stream nil (1+ print-level))101 (format stream ")"))95 ;; Check if the operator of this expression has lower precedence 96 ;; than the surrounding operator, and parenthesize if necessary 97 ((and op 98 (operator-lessp (car expr) op)) 99 (format stream "(") 100 (infix-print expr stream nil (1+ print-level)) 101 (format stream ")")) 102 102 103 ;; Unary minus needs special handling104 ((and (eq (car expr) '-) (endp (cddr expr)))105 (format stream "-")106 ;; Print the second element in product context107 (infix-print (cadr expr) stream '* (1+ print-level)))103 ;; Unary minus needs special handling 104 ((and (eq (car expr) '-) (endp (cddr expr))) 105 (format stream "-") 106 ;; Print the second element in product context 107 (infix-print (cadr expr) stream '* (1+ print-level))) 108 108 109 ;; All other operators110 (t111 (case (car expr)109 ;; All other operators 110 (t 111 (case (car expr) 112 112 113 ;; Arithmetic operators114 ((+ - * /)115 116 (cdr expr)117 (car expr)118 stream119 (car expr)120 (1+ print-level)121 (cond ((eq (car expr) '+) '-)122 ((eq (car expr) '-) '-)123 (t nil))))113 ;; Arithmetic operators 114 ((+ - * /) 115 (infix-print-separated-list 116 (cdr expr) 117 (car expr) 118 stream 119 (car expr) 120 (1+ print-level) 121 (cond ((eq (car expr) '+) '-) 122 ((eq (car expr) '-) '-) 123 (t nil)))) 124 124 125 ;; Exponentials126 (expt127 128 (error "expt must take 2 arguments."))129 130 (cdr expr)131 '^132 stream133 '^134 (1+ print-level)))125 ;; Exponentials 126 (expt 127 (unless (= (length (cdr expr)) 2) 128 (error "expt must take 2 arguments.")) 129 (infix-print-separated-list 130 (cdr expr) 131 '^ 132 stream 133 '^ 134 (1+ print-level))) 135 135 136 ;; Assuming function call137 (otherwise138 136 ;; Assuming function call 137 (otherwise 138 (cond 139 139 140 ;; Handle array references141 ((eq (car expr) 'aref)142 ;; Special syntax for subscripted variables143 ;; consistent with the infix package.144 (format stream "~a[" (cadr expr))145 (infix-print-separated-list (cddr expr) '\, stream '\, (1+ print-level))146 (format stream "]"))140 ;; Handle array references 141 ((eq (car expr) 'aref) 142 ;; Special syntax for subscripted variables 143 ;; consistent with the infix package. 144 (format stream "~a[" (cadr expr)) 145 (infix-print-separated-list (cddr expr) '\, stream '\, (1+ print-level)) 146 (format stream "]")) 147 147 148 ;; Handle lists149 ((and (symbolp (car expr))150 151 (format stream "[")152 (infix-print-separated-list (cdr expr) '\, stream '\, (1+ print-level))153 (format stream "]"))148 ;; Handle lists 149 ((and (symbolp (car expr)) 150 (string= (symbol-name (car expr)) "[")) 151 (format stream "[") 152 (infix-print-separated-list (cdr expr) '\, stream '\, (1+ print-level)) 153 (format stream "]")) 154 154 155 ;; Handle generic function call syntax156 (t157 (format stream "~a(" (car expr))158 (infix-print-arg-list (cdr expr) stream (1+ print-level))159 (format stream ")")))))))155 ;; Handle generic function call syntax 156 (t 157 (format stream "~a(" (car expr)) 158 (infix-print-arg-list (cdr expr) stream (1+ print-level)) 159 (format stream ")"))))))) 160 160 (values)) 161 161
Note:
See TracChangeset
for help on using the changeset viewer.