From 7b3a06b249e272857c858c6ab7ab37c8f1e128e1 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Thu, 15 Jan 2009 02:01:28 +0000 Subject: * 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. --- configure | 18 ++++++------- configure.ac | 2 +- configure.ac.pamphlet | 2 +- src/ChangeLog | 11 ++++++++ src/algebra/riccati.spad.pamphlet | 4 ++- src/interp/bootlex.lisp | 56 ++++++++++++++++++++++++++++++++++++--- src/interp/metalex.lisp | 17 ++++++------ 7 files changed, 87 insertions(+), 23 deletions(-) diff --git a/configure b/configure index a03c235c..a303a63d 100755 --- a/configure +++ b/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.60 for OpenAxiom 1.3.0-2009-01-12. +# Generated by GNU Autoconf 2.60 for OpenAxiom 1.3.0-2009-01-14. # # Report bugs to . # @@ -713,8 +713,8 @@ SHELL=${CONFIG_SHELL-/bin/sh} # Identity of this package. PACKAGE_NAME='OpenAxiom' PACKAGE_TARNAME='openaxiom' -PACKAGE_VERSION='1.3.0-2009-01-12' -PACKAGE_STRING='OpenAxiom 1.3.0-2009-01-12' +PACKAGE_VERSION='1.3.0-2009-01-14' +PACKAGE_STRING='OpenAxiom 1.3.0-2009-01-14' PACKAGE_BUGREPORT='open-axiom-bugs@lists.sf.net' ac_unique_file="src/Makefile.pamphlet" @@ -1405,7 +1405,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures OpenAxiom 1.3.0-2009-01-12 to adapt to many kinds of systems. +\`configure' configures OpenAxiom 1.3.0-2009-01-14 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1475,7 +1475,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of OpenAxiom 1.3.0-2009-01-12:";; + short | recursive ) echo "Configuration of OpenAxiom 1.3.0-2009-01-14:";; esac cat <<\_ACEOF @@ -1579,7 +1579,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -OpenAxiom configure 1.3.0-2009-01-12 +OpenAxiom configure 1.3.0-2009-01-14 generated by GNU Autoconf 2.60 Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, @@ -1593,7 +1593,7 @@ cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by OpenAxiom $as_me 1.3.0-2009-01-12, which was +It was created by OpenAxiom $as_me 1.3.0-2009-01-14, which was generated by GNU Autoconf 2.60. Invocation command line was $ $0 $@ @@ -26424,7 +26424,7 @@ exec 6>&1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by OpenAxiom $as_me 1.3.0-2009-01-12, which was +This file was extended by OpenAxiom $as_me 1.3.0-2009-01-14, which was generated by GNU Autoconf 2.60. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -26473,7 +26473,7 @@ Report bugs to ." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ -OpenAxiom config.status 1.3.0-2009-01-12 +OpenAxiom config.status 1.3.0-2009-01-14 configured by $0, generated by GNU Autoconf 2.60, with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" diff --git a/configure.ac b/configure.ac index b9c6b376..3d3e5621 100644 --- a/configure.ac +++ b/configure.ac @@ -1,6 +1,6 @@ sinclude(config/open-axiom.m4) sinclude(config/aclocal.m4) -AC_INIT([OpenAxiom], [1.3.0-2009-01-12], +AC_INIT([OpenAxiom], [1.3.0-2009-01-14], [open-axiom-bugs@lists.sf.net]) AC_CONFIG_AUX_DIR(config) diff --git a/configure.ac.pamphlet b/configure.ac.pamphlet index fe2e689e..cde31a8f 100644 --- a/configure.ac.pamphlet +++ b/configure.ac.pamphlet @@ -1126,7 +1126,7 @@ information: <>= sinclude(config/open-axiom.m4) sinclude(config/aclocal.m4) -AC_INIT([OpenAxiom], [1.3.0-2009-01-12], +AC_INIT([OpenAxiom], [1.3.0-2009-01-14], [open-axiom-bugs@lists.sf.net]) @ 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 + + * 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 * 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 <>= --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 -- cgit v1.2.3