Revert "attempt to read numbers with a readtable"
This reverts commit 8d5a93a2da.
This commit is contained in:
parent
8d5a93a2da
commit
f5bd882429
|
|
@ -20,7 +20,6 @@ designed to be used by a severely limited Scheme interpreter, which
|
|||
* only uses immutable strings
|
||||
* does not use "load" recursively
|
||||
* uses R3RS essential procedures/syntax only (with some exceptions)
|
||||
* lacks quasiquote
|
||||
|
||||
The goal is to have the compiler run under the MiniScheme in ``miniscm``
|
||||
in DOS, and then run in GLLV to compile itself.
|
||||
|
|
|
|||
380
read.scm
380
read.scm
|
|
@ -54,16 +54,6 @@
|
|||
(lambda ()
|
||||
(read-char port))))
|
||||
|
||||
(define string->read-function
|
||||
(lambda (str)
|
||||
(let ((index -1)
|
||||
(length (string-length str)))
|
||||
(lambda ()
|
||||
(if (= index length)
|
||||
#f
|
||||
(begin
|
||||
(set! index (+ 1 index))
|
||||
(string-ref str index)))))))
|
||||
;;; READ:
|
||||
;;;
|
||||
;;; Stream readers contain mutable state. This is the case-folding mode
|
||||
|
|
@ -77,13 +67,9 @@
|
|||
;;; (FOLD-CASE?): Returns a boolean if case folding is enabled.
|
||||
;;; (FOLD-CASE! BOOL): Sets the case folding to BOOL.
|
||||
(define port->read
|
||||
(lambda (read-function filename . location)
|
||||
(let ((line-number (if (null? location)
|
||||
1
|
||||
(car location)))
|
||||
(offset (if (null? location)
|
||||
0
|
||||
(cadr location)))
|
||||
(lambda (read-function filename)
|
||||
(let ((line-number 1)
|
||||
(offset 0)
|
||||
(pushback-buffer '())
|
||||
(datum-labels '())
|
||||
(fold-case? #f))
|
||||
|
|
@ -118,7 +104,7 @@
|
|||
(lambda (ch)
|
||||
(update-position! ch)
|
||||
(cond
|
||||
((or (eof-object? ch) (not ch)) #f)
|
||||
((or (eof-object? ch) (not ch)) ch)
|
||||
(fold-case? (char-downcase ch))
|
||||
(else ch))))
|
||||
(port
|
||||
|
|
@ -304,8 +290,6 @@
|
|||
;;; Identifier reader
|
||||
;;; ;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;; Container for an IDENT object. Stores the VALUE as a string, and the
|
||||
;;; LOCATION as a list.
|
||||
(define read:ident
|
||||
(lambda (name location)
|
||||
(lambda (op . args)
|
||||
|
|
@ -314,20 +298,6 @@
|
|||
((eq? op 'value) name)
|
||||
(else (error 'read:ident "invalid operation" op args))))))
|
||||
|
||||
;;; Convert a read identifier to a reader.
|
||||
(define read:ident->port
|
||||
(lambda (ident old-port)
|
||||
(apply port->read
|
||||
(string->read-function (ident 'value))
|
||||
(old-port 'location))))
|
||||
|
||||
;;; Create an IDENT-BUILDER object. This object encapsulates pushing
|
||||
;;; characters to create an ident, and stores the location of the start
|
||||
;;; of the identifier.
|
||||
;;;
|
||||
;;; Inherits from LINKED-LIST.
|
||||
;;;
|
||||
;;; (FINALIZE->IDENT): Return an IDENT object.
|
||||
(define read:ident-builder
|
||||
(lambda (location . start-char)
|
||||
(let ((char-list (linked-list:new)))
|
||||
|
|
@ -623,339 +593,6 @@
|
|||
(port 'restore-mutable! mutable))
|
||||
(readtable:next toplevel #f port)))
|
||||
|
||||
;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Number reader.
|
||||
;;;
|
||||
;;; Numbers are not written fully parenthesized. Instead, they are written
|
||||
;;; with prefix, infix, and postfix operators.
|
||||
;;;
|
||||
;;; Parsing algorithm:
|
||||
;;;
|
||||
;;; 1) If the current character is "#", read the next character and add
|
||||
;;; that as a prefix. Goto 1.
|
||||
;;; 2) Read a real.
|
||||
;;; 3) If the next character is a "+" or "-", then the number is a
|
||||
;;; complex number. Read a real and check for EOF, and return. Otherwise
|
||||
;;; go to the next step.
|
||||
;;; 4) If the next character is "i", then the number is purely imaginary.
|
||||
;;; Check that the next character is EOF and return.
|
||||
;;; Otherwise go to the next step.
|
||||
;;; 5) If the next character is "@", the charcter is a complex number in
|
||||
;;; polar form. Read the next number and check that afterwards is EOF.
|
||||
;;; Return.
|
||||
;;; 6) If the next character is EOF, return the number.
|
||||
;;; 7) Return an error.
|
||||
;;;
|
||||
;;; Real reading algorithm:
|
||||
;;;
|
||||
;;; 1) If there is a sign, read it.
|
||||
;;; 2) If what follows is "inf.0" or "nan.0", return that. If what follows
|
||||
;;; is "i", return that.
|
||||
;;; 3) Read in the radix.
|
||||
;;; 4) If there is a ".", read it and continue to read in the radix (the
|
||||
;;; number may now be inexact).
|
||||
;;; 5) If an exponent marker is found, read that and read in the radix.
|
||||
;;; 6) If there is a "/", the number is a rational. Repeat reading a real.
|
||||
|
||||
;;; A "special number", which is NAN.0 or INF.0.
|
||||
(define read:special-number
|
||||
(lambda (location sign type)
|
||||
(lambda (op . args)
|
||||
(cond
|
||||
((eq? op 'location) location)
|
||||
((eq? op 'sign) sign)
|
||||
((eq? op 'type) type)))))
|
||||
|
||||
;;; An integer number.
|
||||
(define read:integer-number
|
||||
(lambda (location radix exactness sign as-string)
|
||||
(if (not exactness)
|
||||
(set! exactness 'exact))
|
||||
(if (not radix)
|
||||
(set! radix 'decimal))
|
||||
|
||||
(lambda (op . args)
|
||||
(cond
|
||||
((eq? op 'location) location)
|
||||
((eq? op 'type) 'integer)
|
||||
((eq? op 'exactness) exactness)
|
||||
((eq? op 'radix) radix)
|
||||
((eq? op 'as-string) as-string)
|
||||
((eq? op 'sign) sign)
|
||||
(else (error 'integer 'invalid op args))))))
|
||||
|
||||
;;; A complex number.
|
||||
(define read:complex-number
|
||||
(lambda (location real imaginary)
|
||||
(lambda (op . args)
|
||||
(cond
|
||||
((eq? op 'location) location)
|
||||
((eq? op 'type) 'complex)
|
||||
((eq? op 'real-part) real)
|
||||
((eq? op 'imaginary-part) imaginary)
|
||||
(else (error 'complex-number 'invalid op args))))))
|
||||
|
||||
;;; Create a purely imaginary number.
|
||||
(define read:purely-imaginary
|
||||
(lambda (location exactness sign)
|
||||
(read:complex-number
|
||||
location
|
||||
(read:integer-number #f 'decimal 'exact '+ "0")
|
||||
(read:integer-number #f 'decimal exactness sign "1"))))
|
||||
|
||||
(define read:exponential-builder
|
||||
(lambda (whole-part fractional-part float-type)
|
||||
(let ((exponential-part (linked-list:new)))
|
||||
(lambda (op . args)
|
||||
(cond
|
||||
((eq? op 'push!) (exponential-part 'push! (car args)))
|
||||
(else (error 'exponential-builder 'invalid op args)))))))
|
||||
|
||||
;;; Create a fractional/rational number.
|
||||
(define read:fractional-builder
|
||||
(lambda (whole-part fractional-or-rational)
|
||||
(let ((fractional-part (linked-list:new)))
|
||||
(lambda (op . args)
|
||||
(cond
|
||||
((eq? op 'push!) (fractional-part 'push! (car args)))
|
||||
((eq? op 'type) fractional-or-rational)
|
||||
((eq? op '->exponential)
|
||||
(if (eq? fractional-or-rational 'rational)
|
||||
(error 'fractional-builder "cannot add exponent part to a rational"))
|
||||
(apply read:exponential-part
|
||||
whole-part
|
||||
(read:integer-number #f #f #f
|
||||
(list->string (body '->list)))
|
||||
args))
|
||||
(else (error 'fractional-builder 'invalid op args)))))))
|
||||
|
||||
;;; Builds an integer without fractional components or exponent.
|
||||
(define read:integer-builder
|
||||
(lambda ()
|
||||
(let ((body (linked-list:new)))
|
||||
(lambda (op . args)
|
||||
(cond
|
||||
((eq? op 'push!) (body 'push-tail! (car args)))
|
||||
((eq? op '->fractional) (apply read:fractional-builder
|
||||
body
|
||||
'fractional
|
||||
args))
|
||||
((eq? op '->rational) (apply read:fractional-builder
|
||||
body
|
||||
'rational
|
||||
args))
|
||||
((eq? op '->exponential) (apply read:exponential-builder
|
||||
body
|
||||
#f
|
||||
args))
|
||||
(else (error 'invalid 'integer-builder op args)))))))
|
||||
|
||||
;;; NUMBER-BUILDER:
|
||||
;;; Contains the state of the current number. Encapsulates the current
|
||||
;;; number's type, etc.
|
||||
;;;
|
||||
;;; (RADIX!): Set the radix to BINARY, OCTAL, DECIMAL, or HEX.
|
||||
;;; (EXACTNESS!): Set the exactness to EXACT or INEXACT.
|
||||
;;; (SIGN!): Set the sign to + or -.
|
||||
(define read:number-builder
|
||||
(lambda (location)
|
||||
(let ((radix #f)
|
||||
(exactness #f)
|
||||
(sign '+)
|
||||
(number (read:integer-builder)))
|
||||
(lambda (op . args)
|
||||
(cond
|
||||
((eq? op 'radix!) (set! radix (car args)))
|
||||
((eq? op 'exactness!) (set! exactness (car args)))
|
||||
((eq? op 'sign!) (set! sign (car args)))
|
||||
((eq? op '->nan.0) (read:special-number location sign 'nan.0))
|
||||
((eq? op '->inf.0) (read:special-number location sign 'inf.0))
|
||||
((eq? op 'with-imaginary-unit)
|
||||
(set! number '->complex sign exactness)
|
||||
(number 'push! 1)
|
||||
(number 'finalize! sign exactness))
|
||||
((eq? op 'make-fractional!)
|
||||
(if (not exactness)
|
||||
(set! exactness 'inexact))
|
||||
(set! number (number '->fractional exactness sign))
|
||||
(set! sign #f))
|
||||
((eq? op 'make-rational!)
|
||||
(set! number (number '->rational exactness sign))
|
||||
(set! exactness #f)
|
||||
(set! sign #f))
|
||||
((eq? op 'make-exponential!)
|
||||
(if (not exactness)
|
||||
(set! exactness 'inexact))
|
||||
(set! number (number '->exponential exactness sign (car args))))
|
||||
(else (error 'invalid op args)))))))
|
||||
|
||||
;;; Operate on the NUMBER-BUILDER and then continue reading in the table.
|
||||
(define read:operate-pass
|
||||
(lambda operation
|
||||
(lambda (table _ number-builder port)
|
||||
(number-builder operation)
|
||||
(readtable:next table acc port))))
|
||||
|
||||
(define readtable:make-complex
|
||||
(lambda (_ char number-builder port)
|
||||
(set! char (cond
|
||||
((eq? char #\+) '+)
|
||||
((eq? char #\-) '-)
|
||||
(else (error 'make-complex 'invalid-char char))))
|
||||
(number-builder 'make-complex! char)
|
||||
(let ((final-number (readtable:read-sign-for-number number-builder port)))
|
||||
(let ((final-char (port 'read)))
|
||||
(if (not (eqv? final-char #\i))
|
||||
(error 'make-complex "invalid complex number"
|
||||
final-char
|
||||
number-builder
|
||||
port)
|
||||
(let ((final-char (port 'read)))
|
||||
(if final-char
|
||||
(error 'make-complex "invalid complex number"
|
||||
final-char
|
||||
number-builder
|
||||
port)
|
||||
final-number)))))))
|
||||
|
||||
(define readtable:make-polar
|
||||
(lambda (_ char number-builder port)
|
||||
(number-builder 'make-complex-polar!)
|
||||
(let ((final-number (readtable:read-sign-for-number number-builder port)))
|
||||
(let ((final-char (port 'read)))
|
||||
(if final-char
|
||||
(error 'make-polar
|
||||
"invalid polar number"
|
||||
final-char
|
||||
number-builder
|
||||
port)
|
||||
final-number)))))
|
||||
|
||||
(define readtable:finalize-number
|
||||
(lambda (_ __ number-builder ___)
|
||||
(number-builder 'finalize!)))
|
||||
|
||||
(define readtable:possible-imaginary
|
||||
(readtable:empty/default (readtable:error 'possible-imaginary
|
||||
"unexpected character"))
|
||||
(list readtable:update #\+ read:make-complex)
|
||||
(list readtable:update #\- read:make-complex)
|
||||
(list readtable:update #f read:finalize-number)
|
||||
(list readtable:udpate #\@ read:make-polar))
|
||||
|
||||
;;; Add a value of the radix to the number builder, and continue reading
|
||||
;;; from the same table.
|
||||
(define read:add-radix-value
|
||||
(lambda (table char acc port)
|
||||
(acc 'push! char)
|
||||
(readtable:next table acc port)))
|
||||
|
||||
;;; The basic integer body reader. This handles all characters in the
|
||||
;;; number that are NOT a part of the radix. Things like ".", "/", etc.
|
||||
;;;
|
||||
;;; This implements SRFI-169, which allows for skipped underscores inside
|
||||
;;; of a number. Multiple underscores are explicitly allowed, but other
|
||||
;;; non-conforming syntax is not necessarily allowed. If it is, it is
|
||||
;;; coincidental.
|
||||
(define readtable:integer-body-base
|
||||
(readtable:process
|
||||
(readtable:empty/default (readtable:jump readtable:possible-imaginary))
|
||||
(list readtable:update #f read:finalize-number)
|
||||
(list readtable:update #\_ readtable:skip)
|
||||
(list readtable:update #\. (read:operate-pass 'make-fractional!))
|
||||
(list readtable:update #\/ (read:operate-pass 'make-rational!))
|
||||
(list readtable:update-list
|
||||
(list #\e #\s #\f #\d #\l)
|
||||
(read:operate-pass 'make-exponential!))))
|
||||
|
||||
;;; Generate a readtable that accepts all characters in the list
|
||||
;;; VALID-RADIX as radix characters.
|
||||
(define readtable:integer-body-for-radix
|
||||
(lambda (valid-radix)
|
||||
(readtable:process
|
||||
readtable:integer-body-base
|
||||
(list readtable:update-list valid-radix read:add-radix-value))))
|
||||
|
||||
;;; Read the rest of a special number value (i.e. "nf.0" after reading
|
||||
;;; "i") and return the special number container, erroring out if there
|
||||
;;; is unread data.
|
||||
(define readtable:rest-of-special-or-error
|
||||
(lambda (rest-of-string conversion-function error-message)
|
||||
(lambda (_ char number-builder port)
|
||||
(let ((ident (readtable:read-ident #f char #f port)))
|
||||
(if (equal? (ident 'value) rest-of-string)
|
||||
(if (port 'peek)
|
||||
(number-builder conversion-function)
|
||||
(error 'rest-of-special 'not-at-eof
|
||||
rest-of-string number-builder port))
|
||||
(error 'rest-of-special 'unknown-identifier
|
||||
rest-of-string (ident 'value)
|
||||
number-builder port))))))
|
||||
|
||||
;;; Read a special number starting with "i", either INF.0 or I.
|
||||
(define readtable:special-number-starting/i
|
||||
(readtable:process
|
||||
(readtable:empty/default
|
||||
(readtable:error 'special-number-starting/i 'invalid-after))
|
||||
(list readtable:update #f
|
||||
(lambda (_ __ number-builder ___)
|
||||
(number-builder '->imaginary-unit)))
|
||||
(list readtable:update #\n (readtable:rest-of-special-or-error
|
||||
"nf.0"
|
||||
'->inf.0
|
||||
'inf.0))))
|
||||
|
||||
;;; Checks for "special" numbers, +NAN.0, +INF.0, +I, etc.
|
||||
(define readtable:check-for-special-number
|
||||
(readtable:process
|
||||
(readtable:empty/default (readtable:jump readtable:read-integer))
|
||||
(list readtable:update #\n
|
||||
(readtable:rest-of-special-or-error "nan.0"
|
||||
'->nan.0
|
||||
'nan.0))
|
||||
(list readtalbe:update #\i readtable:special-number-starting/i)))
|
||||
|
||||
;;; Read the sign in front of a number. Scheme identifiers can start with
|
||||
;;; + or - and ++1 or --1 are identifiers (for example). This reader only
|
||||
;;; reads one sign at most.
|
||||
(define readtable:read-sign-for-number
|
||||
(let ((operate
|
||||
(lambda operation
|
||||
(lambda (_ __ number-builder port)
|
||||
(apply number-builder operation)
|
||||
(readtable:next readtable:check-for-special-number
|
||||
number-builder
|
||||
port)))))
|
||||
(readtable:process
|
||||
(readtable:empty/default (readtable:jump readtable:check-for-special-number))
|
||||
(list readtable:update #\+ (operate 'sign! '+))
|
||||
(list readtable:update #\- (operate 'sign! '-)))))
|
||||
|
||||
;;; Read a numeric prefix code #B0101, #XFF, etc.
|
||||
(define readtable:number-prefix-code
|
||||
(let ((update-prefix
|
||||
(lambda operations
|
||||
(lambda (_ __ number-builder port)
|
||||
(apply number-builder operations)
|
||||
(readtable:next readtable:number-start
|
||||
number-builder
|
||||
port)))))
|
||||
(readtable:process
|
||||
(readtable:empty/default (readtable:error 'invalid-number-prefix))
|
||||
(list readtable:update #\b (update-radix 'radix! 'binary))
|
||||
(list readtable:update #\o (update-radix 'radix! 'octal))
|
||||
(list readtable:update #\d (update-radix 'radix! 'decimal))
|
||||
(list readtable:update #\x (update-radix 'radix! 'hex))
|
||||
(list readtable:update #\i (update-exactness 'exactness! 'inexact))
|
||||
(list readtalbe:update #\e (update-exactness 'exactness! 'exact)))))
|
||||
|
||||
;;; Read numeric prefixes, and skip to reading a number in the absence
|
||||
;;; of a sign.
|
||||
(define readtable:number-start
|
||||
(readtable:process
|
||||
(readtable:empty/default readtable:read-sign-for-number)
|
||||
(list readtable:update #\# (readtable:jump/next readtable:number-prefix-code))))
|
||||
|
||||
;;; ;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Handling hash messages
|
||||
;;;
|
||||
|
|
@ -994,13 +631,10 @@
|
|||
(let ((ident (readtable:read-ident #f char #f port)))
|
||||
(let ((container (smap:search read:hash-messages
|
||||
(ident 'value))))
|
||||
;; TODO: check if the hash message starts a number.
|
||||
(if (null? container)
|
||||
;; Numbers are parsed as identifiers, and then re-parsed.
|
||||
(let ((port (read:ident->port ident port)))
|
||||
(port 'fold-case! #t)
|
||||
(readtable:next read:number-prefix
|
||||
(read:number-builder (port 'location))
|
||||
port))
|
||||
(error 'read-hash-messages 'unknown-constant
|
||||
(ident 'value))
|
||||
((map:val container) acc port))))))
|
||||
|
||||
;;; ;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
|
|||
Loading…
Reference in New Issue