Function: math-read-number-fancy

math-read-number-fancy is a byte-compiled function defined in calc-ext.el.gz.

Signature

(math-read-number-fancy S)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-ext.el.gz
;;; Nontrivial number parsing.

(defun math-read-number-fancy (s)
  (cond

   ;; Integer+fractions
   ((string-match "^\\([0-9]*\\)[:/]\\([0-9]*\\)[:/]\\([0-9]*\\)$" s)
    (let ((int (math-match-substring s 1))
	  (num (math-match-substring s 2))
	  (den (math-match-substring s 3)))
      (let ((int (if (> (length int) 0) (math-read-number int) 0))
	    (num (if (> (length num) 0) (math-read-number num) 1))
	    (den (if (> (length num) 0) (math-read-number den) 1)))
	(and int num den
	     (math-integerp int) (math-integerp num) (math-integerp den)
	     (not (math-zerop den))
	     (list 'frac (math-add num (math-mul int den)) den)))))

   ;; Fractions
   ((string-match "^\\([0-9]*\\)[:/]\\([0-9]*\\)$" s)
    (let ((num (math-match-substring s 1))
	  (den (math-match-substring s 2)))
      (let ((num (if (> (length num) 0) (math-read-number num) 1))
	    (den (if (> (length num) 0) (math-read-number den) 1)))
	(and num den (math-integerp num) (math-integerp den)
	     (not (math-zerop den))
	     (list 'frac num den)))))

   ;; Modulo forms
   ((string-match "^\\(.*\\) *mod *\\(.*\\)$" s)
    (let* ((n (math-match-substring s 1))
	   (m (math-match-substring s 2))
	   (n (math-read-number n))
	   (m (math-read-number m)))
      (and n m (math-anglep n) (math-anglep m)
	   (list 'mod n m))))

   ;; Error forms
   ((string-match "^\\(.*\\) *\\+/- *\\(.*\\)$" s)
    (let* ((x (math-match-substring s 1))
	   (sigma (math-match-substring s 2))
	   (x (math-read-number x))
	   (sigma (math-read-number sigma)))
      (and x sigma (math-scalarp x) (math-anglep sigma)
	   (list 'sdev x sigma))))

   ;; Integer+fraction with explicit radix
   ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]\\)$" s)
    (let ((radix (string-to-number (math-match-substring s 1)))
	  (int (math-match-substring s 3))
	  (num (math-match-substring s 4))
	  (den (math-match-substring s 5)))
      (let ((int (if (> (length int) 0) (math-read-radix int radix) 0))
	    (num (if (> (length num) 0) (math-read-radix num radix) 1))
	    (den (if (> (length den) 0) (math-read-radix den radix) 1)))
	(and int num den (not (math-zerop den))
	     (list 'frac
		   (math-add num (math-mul int den))
		   den)))))

   ;; Fraction with explicit radix
   ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]*\\)$" s)
    (let ((radix (string-to-number (math-match-substring s 1)))
	  (num (math-match-substring s 3))
	  (den (math-match-substring s 4)))
      (let ((num (if (> (length num) 0) (math-read-radix num radix) 1))
	    (den (if (> (length den) 0) (math-read-radix den radix) 1)))
	(and num den (not (math-zerop den)) (list 'frac num den)))))

   ;; Float with explicit radix and exponent
   ((or (string-match "^0*\\(\\([2-9]\\|1[0-4]\\)\\(#\\|\\^\\^\\)[0-9a-dA-D.]+\\)[eE]\\([-+]?[0-9]+\\)$" s)
	(string-match "^\\(\\([0-9]+\\)\\(#\\|\\^\\^\\)[0-9a-zA-Z.]+\\) *\\* *\\2\\.? *\\^ *\\([-+]?[0-9]+\\)$" s))
    (let ((radix (string-to-number (math-match-substring s 2)))
	  (mant (math-match-substring s 1))
	  (exp (math-match-substring s 4)))
      (let ((mant (math-read-number mant))
	    (exp (math-read-number exp)))
	(and mant exp
	     (math-mul mant (math-pow (math-float radix) exp))))))

   ;; Float with explicit radix, no exponent
   ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)\\.\\([0-9a-zA-Z]*\\)$" s)
    (let ((radix (string-to-number (math-match-substring s 1)))
	  (int (math-match-substring s 3))
	  (fracs (math-match-substring s 4)))
      (let ((int (if (> (length int) 0) (math-read-radix int radix) 0))
	    (frac (if (> (length fracs) 0) (math-read-radix fracs radix) 0))
	    (calc-prefer-frac nil))
	(and int frac
	     (math-add int (math-div frac (math-pow radix (length fracs))))))))

   ;; Integer with explicit radix
   ((string-match "^\\([0-9]+\\)\\(#&?\\|\\^\\^\\)\\([0-9a-zA-Z]+\\)$" s)
    (math-read-radix (math-match-substring s 3)
		     (string-to-number (math-match-substring s 1))))

   ;; Two's complement with explicit radix
   ((string-match "^\\([0-9]+\\)\\(##\\)\\([0-9a-zA-Z]+\\)$" s)
    (let ((num (math-read-radix (math-match-substring s 3)
                                (string-to-number (math-match-substring s 1)))))
      (if (and
           (Math-lessp num math-2-word-size)
           (<= (math-compare math-half-2-word-size num) 0))
          (math-sub num math-2-word-size)
        num)))

   ;; C language hexadecimal notation
   ((and (eq calc-language 'c)
	 (string-match "^0[xX]\\([[:xdigit:]]+\\)$" s))
    (let ((digs (math-match-substring s 1)))
      (math-read-radix digs 16)))

   ;; Pascal language hexadecimal notation
   ((and (eq calc-language 'pascal)
	 (string-match "^\\$\\([[:xdigit:]]+\\)$" s))
    (let ((digs (math-match-substring s 1)))
      (math-read-radix digs 16)))

   ;; Hours (or degrees)
   ((or (string-match "^\\([^#^]+\\)[@oOhH]\\(.*\\)$" s)
	(string-match "^\\([^#^]+\\)[dD][eE]?[gG]?\\(.*\\)$" s))
    (let* ((hours (math-match-substring s 1))
	   (minsec (math-match-substring s 2))
	   (hours (math-read-number hours))
	   (minsec (if (> (length minsec) 0) (math-read-number minsec) 0)))
      (and hours minsec
	   (math-num-integerp hours)
	   (not (math-negp hours)) (not (math-negp minsec))
	   (cond ((math-num-integerp minsec)
		  (and (Math-lessp minsec 60)
		       (list 'hms hours minsec 0)))
		 ((and (eq (car-safe minsec) 'hms)
		       (math-zerop (nth 1 minsec)))
		  (math-add (list 'hms hours 0 0) minsec))
		 (t nil)))))

   ;; Minutes
   ((string-match "^\\([^'#^]+\\)[mM']\\(.*\\)$" s)
    (let* ((minutes (math-match-substring s 1))
	   (seconds (math-match-substring s 2))
	   (minutes (math-read-number minutes))
	   (seconds (if (> (length seconds) 0) (math-read-number seconds) 0)))
      (and minutes seconds
	   (math-num-integerp minutes)
	   (not (math-negp minutes)) (not (math-negp seconds))
	   (cond ((math-realp seconds)
		  (and (Math-lessp minutes 60)
		       (list 'hms 0 minutes seconds)))
		 ((and (eq (car-safe seconds) 'hms)
		       (math-zerop (nth 1 seconds))
		       (math-zerop (nth 2 seconds)))
		  (math-add (list 'hms 0 minutes 0) seconds))
		 (t nil)))))

   ;; Seconds
   ((string-match "^\\([^\"#^]+\\)[sS\"]$" s)
    (let ((seconds (math-read-number (math-match-substring s 1))))
      (and seconds (math-realp seconds)
	   (not (math-negp seconds))
	   (Math-lessp seconds 60)
	   (list 'hms 0 0 seconds))))

   ;; Fraction using "/" instead of ":"
   ((string-match "^\\([0-9]+\\)/\\([0-9/]+\\)$" s)
    (math-read-number (concat (math-match-substring s 1) ":"
			      (math-match-substring s 2))))

   ;; Syntax error!
   (t nil)))