diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 11 | ||||
| -rw-r--r-- | src/algebra/riccati.spad.pamphlet | 4 | ||||
| -rw-r--r-- | src/interp/bootlex.lisp | 56 | ||||
| -rw-r--r-- | src/interp/metalex.lisp | 17 |
4 files changed, 76 insertions, 12 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index af661a23..e3a5f83d 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,14 @@ +2009-01-14 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * algebra/riccati.spad.pamphlet (innerlb$PrimitiveRatRicDE): Fix + thinko. + * interp/bootlex.lisp (get-decimal-number-token): New. + (get-integer-in-radix): Likewise. + (is-radix-char): Likewise. + (get-spad-integer-token): Likewise. Use them. + (get-BOOT-token): Use it. + * interp/metalex.lisp: Tidy. + 2009-01-13 Gabriel Dos Reis <gdr@cs.tamu.edu> * algebra/net.spad.pamphlet (InputByteConduit): Add readInt8!, diff --git a/src/algebra/riccati.spad.pamphlet b/src/algebra/riccati.spad.pamphlet index 9f4666c5..0f411bdf 100644 --- a/src/algebra/riccati.spad.pamphlet +++ b/src/algebra/riccati.spad.pamphlet @@ -226,7 +226,7 @@ PrimitiveRatRicDE(F, UP, L, LQ): Exports == Implementation where innerlb(l, nu) == lb:List(IJ) := empty() n := degree l - for i in 0..n | (li := coefficient(l, i)) ~= 0repeat + for i in 0..n | (li := coefficient(l, i)) ~= 0 repeat for j in i+1..n | (lj := coefficient(l, j)) ~= 0 repeat u := (nu li - nu lj) exquo (i-j) if (u case Z) and ((b := u::Z) > 0) then @@ -554,6 +554,8 @@ RationalRicDE(F, UP): Exports == Implementation where <<license>>= --Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. --All rights reserved. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- All rights reserved. -- --Redistribution and use in source and binary forms, with or without --modification, are permitted provided that the following conditions are diff --git a/src/interp/bootlex.lisp b/src/interp/bootlex.lisp index 1afad6e7..4cd605d5 100644 --- a/src/interp/bootlex.lisp +++ b/src/interp/bootlex.lisp @@ -1,6 +1,6 @@ ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. ;; All rights reserved. -;; Copyright (C) 2007-2008, Gabriel Dos Reis. +;; Copyright (C) 2007-2009, Gabriel Dos Reis. ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without @@ -194,7 +194,7 @@ Otherwise, get a .. identifier." (get-boot-identifier-token token t)) (argument-designator (get-argument-designator-token token)) (id (get-boot-identifier-token token)) - (num (get-number-token token)) + (num (get-spad-integer-token token)) (string (get-SPADSTRING-token token)) (special-char (get-special-token token)) (t (get-gliph-token token token-type)))))) @@ -303,6 +303,56 @@ or the chracters ?, !, ' or %" (return (token-install (copy-seq buf) ;should make a simple string 'spadstring token)))) +;; -*- Parse an integer number -*- +;; The number may be written in plain format, where the radix +;; is implicitly taken to be 10. Or the spelling can explicitly +;; specify a radix. That radix can be anything in the range 2..36 + +;; Subroutine GET-NUMBER-TOKEN-MAYBE-WITH-RADIX. +;; Read a the characters of a decimal integer and returns its +;; value. +(defun get-decimal-number-token (buf) + (tagbody lp + (suffix (current-char) buf) + (let ((next-chr (next-char))) + (cond ((digitp next-chr) + (advance-char) + (go lp))))) + (parse-integer buf)) + +;; Subroutine of GET-NUMBER-TOKEN-MAYBE-WITH-RADIX. +;; We just read the radix of an integer number; parse the +;; digits forming that integer token. +(defun get-integer-in-radix (buf r) + (unless (> r 1) + (meta-syntax-error)) + (let ((mark (1+ (size buf)))) + (tagbody lp + (suffix (current-char) buf) + (let* ((nxt (next-char)) + (dig (|rdigit?| nxt))) + (when dig + (unless (< dig r) + (meta-syntax-error)) + (advance-char) + (go lp)))) + (parse-integer buf :start mark :radix r))) + +(defun is-radix-char (c) + (or (eql c #\r) + (eql c #\R))) + +;; Parse an integer token, written either implicitly in decimal form, +;; or explicitly specified radix. +(defun get-spad-integer-token (token) + (let* ((buf (make-adjustable-string 0)) + (val (get-decimal-number-token buf))) + (advance-char) + (when (is-radix-char (current-char)) + (setq val (get-integer-in-radix buf val)) + (advance-char)) + (token-install val 'number token (size buf)))) + ; **** 4. BOOT token parsing actions @@ -342,5 +392,5 @@ or the chracters ?, !, ' or %" (defun SPAD_SHORT_ERROR () (current-line-show)) (defun SPAD_ERROR_LOC (STR) - (format str "******** Boot Syntax Error detected ********")) + (format str "******** Spad Syntax Error detected ********")) diff --git a/src/interp/metalex.lisp b/src/interp/metalex.lisp index cc8189c6..5a4d718d 100644 --- a/src/interp/metalex.lisp +++ b/src/interp/metalex.lisp @@ -1,6 +1,6 @@ ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. ;; All rights reserved. -;; Copyright (C) 2007-2008, Gabriel Dos Reis. +;; Copyright (C) 2007-2009, Gabriel Dos Reis. ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without @@ -305,7 +305,8 @@ NonBlank is true if the token is not preceded by a blank." (defparameter Valid-Tokens 0 "Number of tokens in buffer (0, 1 or 2)") (defun Token-Install (symbol type token &optional (nonblank t)) - (setf (token-symbol token) symbol (token-type token) type + (setf (token-symbol token) symbol + (token-type token) type (token-nonblank token) nonblank) token) @@ -752,17 +753,17 @@ special character be the atom whose print name is the character itself." (defun get-number-token (token) "Take a number off the input stream." (prog ((buf (make-adjustable-string 0))) - nu1 (suffix (current-char) buf) ; Integer part + nu1 + (suffix (current-char) buf) ; Integer part (let ((next-chr (next-char))) (cond ((digitp next-chr) (advance-char) (go nu1)))) (advance-char) - formint(return (token-install - (read-from-string buf) - 'number token - (size buf) ;used to keep track of digit count - )))) + (return (token-install (read-from-string buf) + 'number token + (size buf) ;used to keep track of digit count + )))) ; *** 4. META Auxiliary Parsing Actions |