From: Mark Wooding Date: Thu, 17 Sep 2015 17:24:55 +0000 (+0100) Subject: Merge branch 'master' into doc X-Git-Url: https://git.distorted.org.uk/~mdw/sod/commitdiff_plain/a588c77a273681e3cdc85d15fc44f3ddb7da9224?hp=45e10a4f206558e310e8c9119918cc2b188453c6 Merge branch 'master' into doc * master: lib/sod-structs.3: Some clarifications and typesetting fixes. src/parser/scanner-charbuf.impl (charbuf-scanner-map): Return CONSUMEDP. src/parser/scanner-charbuf-impl.lisp: Simplify `stream-read-line'. src/parser/scanner-charbuf-impl.lisp: Use `replace' rather than a loop. src/parser/scanner-impl.lisp: More exports for `list-scanner'. src/parser/scanner-impl.lisp: Make streams from string scanners. final.lisp: Move definition of *sod-version* here. src/frontend.lisp: Use gensyms to name symbols consistently. --- diff --git a/lib/sod-structs.3 b/lib/sod-structs.3 index 6aefc9d..bc181ee 100644 --- a/lib/sod-structs.3 +++ b/lib/sod-structs.3 @@ -192,11 +192,13 @@ has no direct superclasses, and .B SodClass is its own metaclass. -It is not possible to define root classes because of circularities: +It is not possible to define root classes in module files +because of circularities: .B SodObject has .B SodClass -as its metaclass, and +as its metaclass, +and .B SodClass is a subclass of .BR SodObject . @@ -546,7 +548,8 @@ and this is followed by corresponding members .IB a ; .PP for each of -.IR C 's superclasses +.IR C 's +superclasses .IR A in the same chain in some (unimportant) order. A `pointer to @@ -617,13 +620,17 @@ each .B ichain must have as a prefix the .B ichain -for each superclass in the same chain, and -each slot must be stored in exactly one place. +for each superclass in the same chain, +and each slot must be stored in exactly one place. The layout of vtables doesn't have this second requirement: it doesn't matter that there are multiple method entry pointers for the same effective method as long as they all work correctly. +Indeed, it's essential that they do, +because each chain's method entry function +will need to apply a different offset to the receiver pointer +before invoking the effective method. .PP A vtable for a class .I C @@ -655,10 +662,8 @@ extern const union \fIC\fB__vtu_\fIh\fB \fIC\fB__vtable_\fIh\fB; .fi .PP The outer layer is a -.IP .B union .IB C __vtu_ h -.PP containing a member .IP .B struct @@ -718,7 +723,7 @@ of The metaclass .I R of -.IR O . +.I O is then the .I root metaclass of @@ -781,7 +786,7 @@ be the most specific superclass of in the same chain as .IR J . Then, if there is currently no class pointer of type -.I Q +.IR Q , then add a member .RS .IP @@ -825,7 +830,7 @@ If class .I A defines any messages, and there is currently no member -.I a +.IR a , then add a member .RS .IP diff --git a/src/final.lisp b/src/final.lisp index 5df72f1..fe07cc8 100644 --- a/src/final.lisp +++ b/src/final.lisp @@ -26,6 +26,13 @@ (cl:in-package #:sod) ;;;-------------------------------------------------------------------------- +;;; Miscellaneous details. + +(export '*sod-version*) +(defparameter *sod-version* sod-sysdef:*version* + "The version of the SOD translator system, as a string.") + +;;;-------------------------------------------------------------------------- ;;; Debugging utilities. (export '*debugout-pathname*) diff --git a/src/frontend.lisp b/src/frontend.lisp index 98652ec..0336d1a 100644 --- a/src/frontend.lisp +++ b/src/frontend.lisp @@ -25,7 +25,7 @@ (cl:defpackage #:sod-frontend (:use #:common-lisp #:optparse #:sod #:sod-parser) - (:shadowing-import-from #:optparse "INT")) + (:shadowing-import-from #:optparse #:int)) (cl:in-package #:sod-frontend) diff --git a/src/package.lisp b/src/package.lisp index d6e47f4..4ae7da7 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -30,8 +30,4 @@ (cl:in-package #:sod) -(export '*sod-version*) -(defparameter *sod-version* sod-sysdef:*version* - "The version of the SOD translator system, as a string.") - ;;;----- That's all, folks -------------------------------------------------- diff --git a/src/parser/scanner-charbuf-impl.lisp b/src/parser/scanner-charbuf-impl.lisp index 1919b69..f9cd792 100644 --- a/src/parser/scanner-charbuf-impl.lisp +++ b/src/parser/scanner-charbuf-impl.lisp @@ -198,11 +198,12 @@ and wishes to read more. If DONEP is true then the condition (<= START USED END) must hold; the FUNC has consumed the buffer as far as USED (exclusive) and has completed successfully; the values DONEP and `t' are - returned as the result of `charbuf-scanner-map'. + returned as the result of `charbuf-scanner-map', along with a CONSUMEDP + flag. If end-of-file is encountered before FUNC completes successfully then FAIL - is called with no arguments, and `charbuf-scanner-map' returns whatever - FAIL returns. + is called with no arguments and expected to return two values, and + `charbuf-scanner-map' returns these values, along with a CONSUMEDP flag. Observe that, if FAIL returns a second value of nil, then `charbuf-scanner-map' is usable as a parser expression.")) @@ -210,40 +211,49 @@ (defmethod charbuf-scanner-map ((scanner charbuf-scanner) func &optional fail) (with-slots (buf index size) scanner - (flet ((offer (buf start end) - - ;; Pass the buffer to the function, and see what it thought. - (multiple-value-bind (donep used) (funcall func buf start end) - - ;; Update the position as far as the function read. - (with-slots (line column) scanner - (let ((l line) (c column) (limit (if donep used end))) - (do ((i start (1+ i))) - ((>= i limit)) - (setf (values l c) - (update-position (char buf i) l c))) - (setf line l column c))) - - ;; If the function is finished then update our state and - ;; return. - (when donep - (setf index used) - (when (>= index size) - (charbuf-scanner-fetch scanner)) - (return-from charbuf-scanner-map (values donep t)))))) - - ;; If there's anything in the current buffer, offer it to the function. - (when (< index size) - (offer buf index size)) - - ;; Repeatedly fetch new buffers and offer them to the function. - ;; Because the buffers are fresh, we know that we must process them - ;; from the beginning. Note that `offer' will exit if FUNC has - ;; finished, so we don't need to worry about that. - (loop - (unless (charbuf-scanner-fetch scanner) - (return (if fail (funcall fail) (values nil nil)))) - (offer buf 0 size))))) + (let ((consumedp nil)) + (flet ((offer (buf start end) + + ;; Pass the buffer to the function, and see what it thought. + (multiple-value-bind (donep used) (funcall func buf start end) + + ;; Update the position as far as the function read. + (with-slots (line column) scanner + (let ((l line) (c column) (limit (if donep used end))) + (do ((i start (1+ i))) + ((>= i limit)) + (setf (values l c) + (update-position (char buf i) l c))) + (setf line l column c))) + + ;; If the function is finished then update our state and + ;; return. + (when donep + (setf index used) + (when (>= index size) + (charbuf-scanner-fetch scanner)) + (return-from charbuf-scanner-map + (values donep t (or consumedp (> used start))))) + + ;; We've definitely used that buffer. + (setf consumedp t)))) + + ;; If there's anything in the current buffer, offer it to the + ;; function. + (when (< index size) + (offer buf index size)) + + ;; Repeatedly fetch new buffers and offer them to the function. + ;; Because the buffers are fresh, we know that we must process them + ;; from the beginning. Note that `offer' will exit if FUNC has + ;; finished, so we don't need to worry about that. + (loop + (unless (charbuf-scanner-fetch scanner) + (return (if fail + (multiple-value-bind (result win) (funcall fail) + (values result win consumedp)) + (values nil nil consumedp)))) + (offer buf 0 size)))))) ;;;-------------------------------------------------------------------------- ;;; Initialization. @@ -415,10 +425,7 @@ (unless end (setf end (length seq))) (let ((i start) (n (- end start))) (labels ((copy (i buf start end) - (do ((j i (1+ j)) - (k start (1+ k))) - ((>= k end)) - (setf (char seq j) (schar buf k)))) + (replace seq buf :start1 i :start2 start :end2 end)) (snarf (buf start end) (let ((m (- end start))) (cond ((< m n) @@ -436,12 +443,10 @@ (flet ((snarf (buf start end) (let ((pos (position #\newline buf :start start :end end))) (push (make-charbuf-slice buf start (or pos end)) slices) - (if pos - (values (concatenate-charbuf-slices (nreverse slices)) - (1+ pos)) - (values nil 0)))) - (fail () - (values (concatenate-charbuf-slices (nreverse slices)) t))) - (charbuf-scanner-map scanner #'snarf #'fail))))) + (values pos (and pos (1+ pos)))))) + (multiple-value-bind (result eofp consumedp) + (charbuf-scanner-map scanner #'snarf) + (declare (ignore result consumedp)) + (values (concatenate-charbuf-slices (nreverse slices))) eofp))))) ;;;----- That's all, folks -------------------------------------------------- diff --git a/src/parser/scanner-impl.lisp b/src/parser/scanner-impl.lisp index 2abdff4..4909be9 100644 --- a/src/parser/scanner-impl.lisp +++ b/src/parser/scanner-impl.lisp @@ -92,10 +92,13 @@ (with-slots ((string %string) index) scanner (subseq string place-a (or place-b index)))) +(defmethod make-scanner-stream ((scanner string-scanner)) + (make-instance 'character-scanner-stream :scanner scanner)) + ;;;-------------------------------------------------------------------------- ;;; List scanner. -(export 'list-scanner) +(export '(list-scanner list-scanner-p make-list-scanner)) (defstruct (list-scanner (:constructor make-list-scanner (list &aux (%list list)))) "Simple token scanner for lists.