Bug fix: operator with name with ':' in it, suchas Op:S, causes crash some cases.
tswd
8 years ago
| 313 | 313 | (print-sort-name bi *current-module*) |
| 314 | 314 | (princ ".") |
| 315 | 315 | (terpri)))) |
| 316 | ;; | |
| 317 | #|| | |
| 318 | (let ((gv (dictionary-get-token-info | |
| 319 | (dictionary-table dictionary) | |
| 320 | var-name))) | |
| 321 | (when gv | |
| 322 | (dolist (op-v gv) | |
| 323 | (when (eq (object-syntactic-type op-v) | |
| 324 | 'variable) | |
| 325 | (with-output-chaos-error ('already-used-name) | |
| 326 | (format t "~&on the fly variable name ~A is already used for static variable declaration..." var-name)))))) | |
| 327 | ||# | |
| 328 | 316 | (setq var-name (intern var-name)) |
| 329 | ||
| 330 | 317 | ;; success parsing it as a variable declaration. |
| 331 | 318 | ;; checks if there alredy a variable with the same |
| 332 | 319 | ;; name. |
| 333 | 320 | (when *on-parse-debug* |
| 334 | (format t "~%on-the-fly var decl: ~A" var-name) | |
| 321 | (format t "~%on-the-fly var decl: ~A" (string var-name)) | |
| 335 | 322 | (format t "... ~A" *parse-variables*)) |
| 336 | 323 | (let ((old-var (assoc var-name *parse-variables*))) |
| 337 | 324 | (if old-var |
| 343 | 330 | (string (sort-id |
| 344 | 331 | (variable-sort (cdr |
| 345 | 332 | old-var)))) |
| 346 | (string (sort-id sort)))) | |
| 347 | ;;(setf (cdr old-var) | |
| 348 | ;; (make-variable-term sort var-name)) | |
| 349 | ) | |
| 333 | (string (sort-id sort))))) | |
| 350 | 334 | (progn |
| 335 | ;; fresh new variable: | |
| 351 | 336 | ;; check name, if it start with `, we make |
| 352 | 337 | ;; pseudo variable |
| 353 | 338 | (if (eql #\` (char (the simple-string (string var-name)) 0)) |
| 356 | 341 | (push (cons var-name var) *parse-variables*))) |
| 357 | 342 | (if old-var |
| 358 | 343 | (progn |
| 359 | (push (cdr old-var) res) | |
| 360 | #|| | |
| 361 | (when (err-sort-p (variable-sort | |
| 362 | (cdr old-var))) | |
| 363 | (pushew (cdr old-var) | |
| 364 | (module-error-variables | |
| 365 | *current-module*))) | |
| 366 | ||# | |
| 367 | ) | |
| 368 | (let ((svar (assoc var res :test #'equal))) | |
| 344 | (push (cdr old-var) res)) | |
| 345 | (let ((svar (member var res :test #'equal))) | |
| 369 | 346 | (when *on-parse-debug* |
| 370 | 347 | (format t "~%!res = ~s" res)) |
| 371 | 348 | (when svar |
| 372 | 349 | (with-output-chaos-error () |
| 373 | 350 | (format t "Static variable ~s already used before in the same context" var-name))) |
| 374 | (push var res) | |
| 375 | #|| | |
| 376 | (when (err-sort-p (variable-sort var)) | |
| 377 | (pushnew var (module-error-variables | |
| 378 | *current-module*))) | |
| 379 | ||# | |
| 380 | ))))) | |
| 351 | (push var res)))))) | |
| 381 | 352 | |
| 382 | 353 | ;; must not be a variable declaration. |
| 383 | 354 | ;; try yet other possibilities. |
| 407 | 378 | (multiple-value-setq (res mod-token) |
| 408 | 379 | (get-qualified-op-pattern token)))))) |
| 409 | 380 | ;; end collect |
| 381 | (when *on-parse-debug* | |
| 382 | (format t "~%..end collecting info on token ~s" token) | |
| 383 | (format t "~%..first result: ~s" res)) | |
| 410 | 384 | (when sort-constraint |
| 411 | 385 | (let ((real-res nil)) |
| 412 | 386 | (dolist (r res) |