diff --git a/README.rst b/README.rst index fc6671a..abb5f5a 100644 --- a/README.rst +++ b/README.rst @@ -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. diff --git a/read.scm b/read.scm index 73ecab2..1007c00 100644 --- a/read.scm +++ b/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)))))) ;;; ;;;;;;;;;;;;;;;;;;;;;;