From 667482ffa5d8fbac27a3994ac364c8bc7772ec16 Mon Sep 17 00:00:00 2001 From: Francis St-Amour Date: Sun, 22 Dec 2024 23:14:22 -0500 Subject: [PATCH] use vectors instead of lists for node children --- src/analysis.lisp | 55 ++++++-- src/lossless-reader.lisp | 87 ++++++++----- tests/analysis.lisp | 102 +++++---------- tests/lossless-reader.lisp | 176 ++++++++++++++------------ tests/lossless-reader.randomized.lisp | 25 +++- 5 files changed, 243 insertions(+), 202 deletions(-) diff --git a/src/analysis.lisp b/src/analysis.lisp index cc8960a2..68ce454b 100644 --- a/src/analysis.lisp +++ b/src/analysis.lisp @@ -79,8 +79,9 @@ children nodes." (and (null package) (node-string-equal state symbol-node name))) ((qualified-symbol possibly-internal-symbol) - (destructuring-bind (package-name-node symbol-name-node) - (node-children symbol-node) + (let* ((nodes (node-children symbol-node)) + (package-name-node (first-node nodes)) + (symbol-name-node (second-node nodes))) (and (node-string-equal state symbol-name-node name) (some (lambda (package-name) @@ -193,13 +194,21 @@ N.B. This doesn't guarantee that it's a valid node." (defun find-node (position nodes) "Given a list of NODES, return which node contains the POSITION." - (when (listp nodes) - (loop :for node :in nodes - :for start = (node-start node) - :for end = (node-end node) - :for i :from 0 - :when (and (<= start end) (< position end)) - :do (return (cons node i))))) + (typecase nodes + (vector + (loop :for node :across nodes + :for start = (node-start node) + :for end = (node-end node) + :for i :from 0 + :when (and (<= start end) (< position end)) + :do (return (cons node i)))) + (cons + (loop :for node :in nodes + :for start = (node-start node) + :for end = (node-end node) + :for i :from 0 + :when (and (<= start end) (< position end)) + :do (return (cons node i)))))) (defun find-path-to-position (state position) "Given a list of NODES, return a path (list of cons (node . index))" @@ -227,6 +236,7 @@ N.B. This doesn't guarantee that it's a valid node." (list (loop :for i :from 0 + :for firstp = (zerop i) :for previous = nil :then (first rest) :for rest :on tree :for node = (car rest) @@ -237,13 +247,36 @@ N.B. This doesn't guarantee that it's a valid node." (cb node :aroundp t :nth i - :firstp (eq tree rest) - :lastp (null (cdr rest)) + :firstp firstp + :lastp (null next) :previous previous :next next :quotedp quotedp) (1+ depth) quotedp))) + (vector + (nodes + (loop + :for i :from 0 + :for firstp = (zerop i) + :for lastp = (= (1- (length tree)) i) + :for previous = nil :then node + ;; :for rest :on tree + :for node :across tree + :for next = (unless lastp (aref tree (1+ i))) + ;; Recurse + :collect (%walk state + callback + (cb node + :aroundp t + :nth i + :firstp firstp + :lastp (null next) + :previous previous + :next next + :quotedp quotedp) + (1+ depth) + quotedp)))) (node (case (node-type tree) (parens diff --git a/src/lossless-reader.lisp b/src/lossless-reader.lisp index dcd36676..1b455395 100644 --- a/src/lossless-reader.lisp +++ b/src/lossless-reader.lisp @@ -25,12 +25,17 @@ common lisp.") #:node-end #:node-type #:node-children - #:ensure-nodes - #:append-nodes - #:nodes #:copy-node #:valid-node-p #:node-content) + ;; Node sequences + (:export #:ensure-nodes + #:append-nodes + #:nodes + #:nth-node + #:first-node + #:second-node + #:last-node) ;; Node constructors (:export #:block-comment #:parens @@ -251,23 +256,43 @@ common lisp.") (defun ensure-nodes (x) "Ensure that that X is a sequence of node." - (if (listp x) - x - (list x))) + (typecase x + (null nil) + (vector x) + (cons (coerce x 'vector)) + (t (vector x)))) (defun append-nodes (nodes1 nodes2) "Concatenate two sequences of nodes." - (append nodes1 nodes2)) + (concatenate 'vector nodes1 nodes2)) ;; (declaim (inline %nodes)) (defun %nodes (x y) "Create a sequence of nodes. But less used-friendly." - (append-nodes (ensure-nodes x) (ensure-nodes y))) + (if x + (if y + (append-nodes (ensure-nodes x) (ensure-nodes y)) + (ensure-nodes x)) + (when y (ensure-nodes y)))) (defun nodes (&optional node &rest nodes) "Create a sequence of nodes." (%nodes node nodes)) + +(defun nth-node (nodes n) + (when nodes + (aref nodes n))) + +(defun first-node (nodes) + (nth-node nodes 0)) + +(defun second-node (nodes) + (nth-node nodes 1)) + +(defun last-node (nodes) + (nth-node nodes (1- (length nodes)))) + (defun node (type start end &optional child &rest children) #++ (when (= +end+ end) (break)) @@ -845,15 +870,7 @@ first node being whitespaces.)" (when (read-char* state #\=) (multiple-value-bind (end children) (read-any* state) - ;; TODO sharp-label would benefit from having it own data - ;; structure, this is abusing the children - (node 'sharp-label start end - (append - (when (and (integerp number) - (<= 0 number)) - (list :label number)) - (when children - (list :form children))))))) + (node 'sharp-label start end (%nodes number children))))) (defun read-sharpsign-sharpsign (state start number) (when (read-char* state #\#) @@ -1104,8 +1121,8 @@ Returns a new node with one of these types: :when el :collect el :into content :unless (valid-node-p el) - :do (return (parens start +end+ content)) - :finally (return (parens start (pos state) content))))) + :do (return (parens start +end+ (ensure-nodes content))) + :finally (return (parens start (pos state) (ensure-nodes content)))))) ;; TODO add tests with skip-whitespaces-p set (defun read-any (state &optional skip-whitespaces-p) @@ -1220,21 +1237,23 @@ Returns a new node with one of these types: (end node))))) (defun %unparse (tree state stream depth transform) - (when tree - (if (listp tree) - (mapcar (lambda (node) - (%unparse (funcall transform node) - state stream (1+ depth) - transform)) - tree) - (case (node-type tree) - (parens - (write-char #\( stream) - (%unparse (node-children tree) state stream depth transform) - (unless (no-end-p tree) - (write-char #\) stream))) - (t - (write-node (funcall transform tree) state stream)))))) + (etypecase tree + (null) + ((or vector cons) + (map nil (lambda (node) + (%unparse (funcall transform node) + state stream (1+ depth) + transform)) + tree)) + (node + (case (node-type tree) + (parens + (write-char #\( stream) + (%unparse (node-children tree) state stream depth transform) + (unless (no-end-p tree) + (write-char #\) stream))) + (t + (write-node (funcall transform tree) state stream)))))) (defun unparse (state &optional (stream t) (transform #'identity)) (if stream diff --git a/tests/analysis.lisp b/tests/analysis.lisp index 0e81db71..cc333a2d 100644 --- a/tests/analysis.lisp +++ b/tests/analysis.lisp @@ -33,6 +33,10 @@ #'string< :key #'car)))) +(defun make-binding (term input) + (normalize-bindings + (breeze.pattern::make-binding term input))) + (defun test-match-parse (pattern string &optional skip-whitespaces-and-comments) (let* ((state (parse string)) (*match-skip* (when skip-whitespaces-and-comments @@ -174,29 +178,29 @@ (is equalp (list :?x nil) (test-match-parse :?x "")) (is equalp (list :?x nil) (test-match-parse :?x "" t)) (is equalp - (list :?x (list (token 0 1))) + (make-binding :?x (list (token 0 1))) (test-match-parse :?x "x")) (is equalp - (list :?x (list (whitespace 0 1) (token 1 2))) + (make-binding :?x (list (whitespace 0 1) (token 1 2))) (test-match-parse :?x " x")) (is equalp - (list :?x (list (whitespace 0 1) (token 1 2))) + (make-binding :?x (list (whitespace 0 1) (token 1 2))) (test-match-parse :?x " x" t))) (progn (false (test-match-parse '(:?x) "")) (false (test-match-parse '(:?x) "" t)) (is equalp - (list :?x (token 0 1)) + (make-binding :?x (token 0 1)) (test-match-parse '(:?x) "x")) (false (test-match-parse '(:?x) " x")) (is equalp - (list :?x (token 1 2)) + (make-binding :?x (token 1 2)) (test-match-parse '(:?x) " x" t)) (is equalp - (list :?x (parens 0 4 (list (token 1 3)))) + (make-binding :?x (parens 0 4 (nodes (token 1 3)))) (test-match-parse '(:?x) "(42)")) (is equalp - (list :?x (token 1 3)) + (make-binding :?x (token 1 3)) (test-match-parse '((:?x)) "(42)")))) (define-test+run "match vector against parse trees" @@ -263,7 +267,7 @@ :for path = (find-node i (tree state)) :collect (cons (node-type (car path)) (cdr path))))) -(define-test find-path-to-position +(define-test+run find-path-to-position (is equalp '((whitespace) (parens whitespace) @@ -285,56 +289,6 @@ path) #++(list i (length path))))) - -;;; Fixing formatting issues... - -(defun parens-has-leading-whitespaces-p (node) - (and (parens-node-p node) - (whitespace-node-p (first (node-children node))))) - -(defun parens-has-trailing-whitespaces-p (node) - (and (parens-node-p node) - (whitespace-node-p (alexandria:lastcar (node-children node))))) - -(defun cdr-if (condition list) - (if condition (cdr list) list)) - -(defun butlast-if (condition list) - (if condition (butlast list) list)) - -(defun fix-trailing-whitespaces-inside-parens (node) - (let ((first-child (parens-has-leading-whitespaces-p node)) - (last-child (parens-has-trailing-whitespaces-p node))) - (if (or first-child last-child) - (copy-parens - node - :children (butlast-if - last-child - (cdr-if first-child (node-children node)))) - node))) - - -(defun test-remove-whitespaces (input output) - (let* ((input (format nil input)) - (output (format nil output)) - (state (parse input))) - (breeze.kite:is - :comparator 'string= - :form `(unparse ,state nil 'fix-trailing-whitespaces-inside-parens) - :got (unparse state nil 'fix-trailing-whitespaces-inside-parens) - :expected output))) - -(define-test+run remove-whitespaces - (test-remove-whitespaces "( )" "()") - (test-remove-whitespaces "(~%~%~%)" "()") - (test-remove-whitespaces "( ) " "() ") - (test-remove-whitespaces " ( ) " " () ") - ;; TODO handle indentation levels! - ;; (test-remove-whitespaces "(;;~% )" "(;;~% )") - (test-remove-whitespaces "( x)" "(x)") - (test-remove-whitespaces "( x )" "(x)")) - - ;;; Testing the linter @@ -457,7 +411,7 @@ diags)) (defun test-fix (input) - (multiple-value-list (fix :buffer-string input))) + (multiple-value-list (fix :buffer-string (format nil input)))) (define-test+run test-fix (is equal '("()" nil) (test-fix "()")) @@ -468,20 +422,24 @@ ;; (is equal '("()" t) (test-fix "(")) ;; (is equal '("((()))" t) (test-fix "(((")) (is equal '("()" t) (test-fix "( )")) - (is equal '("()" t) (test-fix "( -)")) - (is equal '("(a b)" t) (test-fix "(a b)")) + (is equal '("()" t) (test-fix "(~%)")) + (is equal '("() " t) (test-fix "( ) ")) + (is equal '("() " t) (test-fix "( ) ")) + (is equal '(" ()" t) (test-fix " ( )")) + (is equal '(" () " t) (test-fix " ( ) ")) + (is equal '("(a)" t) (test-fix "( a)")) + (is equal '("(a)" t) (test-fix "(a )")) (is equal '("(a)" t) (test-fix "( a )")) - (is equal '("((a))" t) (test-fix "( - ( - a - ) -)")) - (is equal '("((a))" t) (test-fix "(( - - a - - ))")) + (is equal '("(a b)" t) (test-fix "(a b)")) + (is equal '("((a))" t) (test-fix "(~% (~% a~% )~%)")) + (is equal '("((a))" t) (test-fix "((~%~% a~%~% ))")) + ;; TODO handle indentation levels! + #++ + (progn + (is equal '("(;;~% )" t) (test-fix "(;;~% )")) + (is equal '("(;;~% )" t) (test-fix "(;;~% ~%)")) + ;; TODO This should be detected as "extraneous internal newlines"... + (is equal '("(;;~% )" t) (test-fix "(;;~% ~%)"))) #++ ;; TODO more whitespace fixes (progn (is equal '("#+(or)" t) (test-fix "#+ (or)")) diff --git a/tests/lossless-reader.lisp b/tests/lossless-reader.lisp index f810b80e..ebdb31df 100644 --- a/tests/lossless-reader.lisp +++ b/tests/lossless-reader.lisp @@ -169,33 +169,38 @@ newline or +end+) (test-node-print-object (list #s(node :type boo :start 1 :end 2)) "((node 'boo 1 2))") - (test-node-print-object - (list '#s(node :type boo :start 1 :end 2)) - "((node 'boo 1 2))") (test-node-print-object (node 'asdf 1 3 (node 'qwer 3 5)) "(node 'asdf 1 3 (node 'qwer 3 5))") (test-node-print-object - (node 'asdf 1 3 (list (node 'qwer 3 5) - (node 'uiop 6 8))) + (node 'asdf 1 3 (list (node 'qwer 3 5) (node 'uiop 6 8))) "(node 'asdf 1 3 (list (node 'qwer 3 5) (node 'uiop 6 8)))") (test-node-print-object - (parens 3 5) "(parens 3 5)")) + (node 'asdf 1 3 (nodes (node 'qwer 3 5) (node 'uiop 6 8))) + "(node 'asdf 1 3 #((node 'qwer 3 5) (node 'uiop 6 8)))") + (test-node-print-object + (node 'asdf 1 3 #((node 'qwer 3 5) (node 'uiop 6 8))) + "(node 'asdf 1 3 #((node 'qwer 3 5) (node 'uiop 6 8)))") + (test-node-print-object + (parens 3 5) "(parens 3 5)") + (test-node-print-object + (parens 3 5 'x) "(parens 3 5 x)")) (define-test+run ensure-nodes (false (ensure-nodes nil)) - (is equal '(t) (ensure-nodes t)) - (is equal '(t) (ensure-nodes (ensure-nodes t)))) + (is equalp #(t) (ensure-nodes t)) + (is equalp #(t) (ensure-nodes (ensure-nodes t))) + (is equalp #(a b c) (ensure-nodes '(a b c)))) (define-test+run nodes (false (%nodes nil nil)) - (is equal '(t) (%nodes t nil)) - (is equal '(t t) (%nodes t t)) - (is equal '(t) (%nodes nil t)) + (is equalp #(t) (%nodes t nil)) + (is equalp #(t t) (%nodes t t)) + (is equalp #(t) (%nodes nil t)) (false (nodes)) - (is equal '(t) (nodes t)) - (is equal '(a b) (nodes 'a 'b)) - (is equal '(a b c) (nodes 'a 'b 'c))) + (is equalp #(t) (nodes t)) + (is equalp #(a b) (nodes 'a 'b)) + (is equalp #(a b c) (nodes 'a 'b 'c))) ;;; Low-level parsing helpers @@ -346,10 +351,16 @@ the function read-sharpsign-dispatching-reader-macro (let* ((starting-position (if (listp input) (length (first input)) 1)) (input (if (listp input) (apply 'concatenate 'string input) input)) (expected-end (or expected-end (length input))) - (expected-pos (or expected-pos expected-end))) + (expected-pos (or expected-pos expected-end)) + (expected-children (if (listp expected-children) + ;; coerce to vector + (if (breeze.utils:length>1? expected-children) + (ensure-nodes expected-children) + (first expected-children)) + expected-children))) (with-state (input) (setf (pos state) starting-position) - (let* ((expected (node node-type 0 + (let* ((expected (node node-type 0 expected-end expected-children)) (got @@ -410,13 +421,13 @@ the function read-sharpsign-dispatching-reader-macro (define-test+run read-sharpsign-quote (test-read-sharpsign-quote "#'" nil +end+) - (test-read-sharpsign-quote "#' " (list (whitespace 2 3)) +end+) - (test-read-sharpsign-quote "#'a" (list (token 2 3)) 3) - (test-read-sharpsign-quote "#' a" (list (whitespace 2 3) - (token 3 4)) + (test-read-sharpsign-quote "#' " (nodes (whitespace 2 3)) +end+) + (test-read-sharpsign-quote "#'a" (nodes (token 2 3)) 3) + (test-read-sharpsign-quote "#' a" (nodes (whitespace 2 3) + (token 3 4)) 4) - (test-read-sharpsign-quote "#'(lambda...)" (list (parens 2 13 - (list (token 3 12)))) + (test-read-sharpsign-quote "#'(lambda...)" (nodes (parens 2 13 + (token 3 12))) 13)) @@ -500,9 +511,9 @@ the function read-sharpsign-dispatching-reader-macro (define-test+run read-sharpsign-dot (test-read-sharpsign-dot "#." nil +end+) - (test-read-sharpsign-dot "#.a" (list (token 2 3)) 3) - (test-read-sharpsign-dot "#. a" (list (whitespace 2 3) - (token 3 4)) + (test-read-sharpsign-dot "#.a" (nodes (token 2 3)) 3) + (test-read-sharpsign-dot "#. a" (nodes (whitespace 2 3) + (token 3 4)) 4)) ;;; #b sharp-binary @@ -668,20 +679,20 @@ the function read-sharpsign-dispatching-reader-macro (test-read-sharpsign-c "#C1" :end +end+) ;; N.B. #c(1) is actually invalid (test-read-sharpsign-c "#c(1)" - :child (node 'parens 2 5 (list (node 'token 3 4)))) + :child (parens 2 5 (node 'token 3 4))) (test-read-sharpsign-c "#C(1)" - :child (node 'parens 2 5 (list (node 'token 3 4)))) + :child (parens 2 5 (node 'token 3 4))) (test-read-sharpsign-c "#c(1 2) a" - :child (node 'parens 2 7 - (list (node 'token 3 4) - (node 'whitespace 4 5) - (node 'token 5 6))) + :child (parens 2 7 + (nodes (node 'token 3 4) + (node 'whitespace 4 5) + (node 'token 5 6))) :end 7) (test-read-sharpsign-c "#C(1 2) a" :child (node 'parens 2 7 - (list (node 'token 3 4) - (node 'whitespace 4 5) - (node 'token 5 6))) + (nodes (node 'token 3 4) + (node 'whitespace 4 5) + (node 'token 5 6))) :end 7)) @@ -707,9 +718,9 @@ the function read-sharpsign-dispatching-reader-macro (test-read-sharpsign-a '("#2" "a()") :child (parens 3 5)) (test-read-sharpsign-a '("#2" "a(1 2)") :child (parens 3 8 - (list (token 4 5) - (whitespace 5 6) - (token 6 7)))) + (nodes (token 4 5) + (whitespace 5 6) + (token 6 7)))) (test-read-sharpsign-a '("#2" "A()") :child (parens 3 5))) @@ -727,9 +738,9 @@ the function read-sharpsign-dispatching-reader-macro (test-read-sharpsign-s "#s" :end +end+) (test-read-sharpsign-s "#S" :end +end+) (test-read-sharpsign-s "#S(node)" - :child (list (parens 2 8 (list (token 3 7))))) + :child (nodes (parens 2 8 (token 3 7)))) (test-read-sharpsign-s "#S(node) foo" - :child (list (parens 2 8 (list (token 3 7)))) + :child (nodes (parens 2 8 (token 3 7))) :end 8)) @@ -747,10 +758,10 @@ the function read-sharpsign-dispatching-reader-macro (test-read-sharpsign-p "#p" :end +end+) (test-read-sharpsign-p "#P" :end +end+) (test-read-sharpsign-p "#p\"/root/\"" - :child (list (node 'string 2 10)) + :child (nodes (node 'string 2 10)) :end 10) (test-read-sharpsign-p "#p\"/root/\" foo" - :child (list (node 'string 2 10)) + :child (nodes (node 'string 2 10)) :end 10)) @@ -763,23 +774,21 @@ the function read-sharpsign-dispatching-reader-macro :input input :expected-end end :expected-children child - :given-numeric-argument (getf child :label))) + :given-numeric-argument (first-node child))) (define-test+run read-sharpsign-equal (test-read-sharpsign-equal "#=" :end +end+) (test-read-sharpsign-equal '("#1" "=") - :child (list :label 1) + :child (nodes 1) :end +end+) (test-read-sharpsign-equal '("#2" "= ") - :child (list :label 2 - :form (list (whitespace 3 4))) + :child (nodes 2 (whitespace 3 4)) :end +end+) (test-read-sharpsign-equal '("#3" "=(foo)") - :child (list :label 3 - :form (list (parens 3 8 (token 4 7)))))) + :child (nodes 3 (parens 3 8 (token 4 7))))) @@ -812,13 +821,13 @@ the function read-sharpsign-dispatching-reader-macro (define-test+run read-sharpsign-plus (test-read-sharpsign-plus "#+" :end +end+) - (test-read-sharpsign-plus "#++" :child (list (token 2 3))) + (test-read-sharpsign-plus "#++" :child (nodes (token 2 3))) (test-read-sharpsign-plus "#+ #+ x" - :child (list (whitespace 2 3) - (sharp-feature 3 7 - (list (whitespace 5 6) - (token 6 7)))))) + :child (nodes (whitespace 2 3) + (sharp-feature 3 7 + (nodes (whitespace 5 6) + (token 6 7)))))) ;;; #- @@ -833,13 +842,13 @@ the function read-sharpsign-dispatching-reader-macro (define-test+run read-sharpsign-minus (test-read-sharpsign-minus "#-" :end +end+) - (test-read-sharpsign-minus "#--" :child (list (token 2 3))) + (test-read-sharpsign-minus "#--" :child (nodes (token 2 3))) (test-read-sharpsign-minus "#- #- x" - :child (list (whitespace 2 3) - (sharp-feature-not 3 7 - (list (whitespace 5 6) - (token 6 7)))))) + :child (nodes (whitespace 2 3) + (sharp-feature-not 3 7 + (nodes (whitespace 5 6) + (token 6 7)))))) @@ -902,7 +911,7 @@ the function read-sharpsign-dispatching-reader-macro (with-state ("") (test* (read-quoted-string state #\| #\/) nil)) (with-state ("|") - (test* (read-quoted-string state #\| #\/) (list 0 +end+))) + (test* (read-quoted-string state #\| #\/) (list 0 +end+))) (with-state ("||") (test* (read-quoted-string state #\| #\/) '(0 2))) (with-state ("| |") @@ -951,12 +960,12 @@ the function read-sharpsign-dispatching-reader-macro (is equalp (node 'uninterned-symbol 2 3) (tsn "#:x")) (is equalp (node 'qualified-symbol 0 3 - (list (node 'package-name 0 1) - (node 'symbol-name 2 3))) + (nodes (node 'package-name 0 1) + (node 'symbol-name 2 3))) (tsn "p:x")) (is equalp (node 'possibly-internal-symbol 0 4 - (list + (nodes (node 'package-name 0 1) (node 'symbol-name 3 4))) (tsn "p::x")) @@ -972,12 +981,12 @@ the function read-sharpsign-dispatching-reader-macro (is equalp (node 'keyword 4 5) (tsn-padded ":x")) (is equalp (node 'uninterned-symbol 5 6) (tsn-padded "#:x")) (is equalp (node 'qualified-symbol 3 6 - (list (node 'package-name 3 4) - (node 'symbol-name 5 6))) + (nodes (node 'package-name 3 4) + (node 'symbol-name 5 6))) (tsn-padded "p:x")) (is equalp (node 'possibly-internal-symbol 3 7 - (list (node 'package-name 3 4) - (node 'symbol-name 6 7))) + (nodes (node 'package-name 3 4) + (node 'symbol-name 6 7))) (tsn-padded "p::x")) (false (tsn-padded "")) (false (tsn-padded "#:")) @@ -1024,7 +1033,7 @@ the function read-sharpsign-dispatching-reader-macro (with-state (input) (test* (read-parens state) (when expected-end - (parens 0 expected-end children))))) + (parens 0 expected-end (ensure-nodes children)))))) (define-test+run read-parens :depends-on (read-char*) @@ -1093,27 +1102,27 @@ the function read-sharpsign-dispatching-reader-macro (node 'parens 2 4))) (test-parse "#<>" (node 'sharp-unknown 0 +end+)) (test-parse "#+ x" (node 'sharp-feature 0 4 - (list + (nodes (whitespace 2 3) (token 3 4)))) (test-parse "(char= #\\; c)" (parens 0 13 - (list (token 1 6) - (whitespace 6 7) - (sharp-char 7 10 (token 8 10)) - (whitespace 10 11) - (token 11 12)))) + (nodes (token 1 6) + (whitespace 6 7) + (sharp-char 7 10 (token 8 10)) + (whitespace 10 11) + (token 11 12)))) (test-parse "(#\\;)" (parens 0 5 - (list (sharp-char 1 4 (token 2 4))))) + (nodes (sharp-char 1 4 (token 2 4))))) (test-parse "#\\; " (sharp-char 0 3 (token 1 3)) (whitespace 3 4)) (test-parse "`( asdf)" (node 'quasiquote 0 1) (parens 1 8 - (list + (nodes (whitespace 2 3) (token 3 7)))) (test-parse "#\\Linefeed" (sharp-char 0 10 (token 1 10))) (test-parse "#\\: asd" (sharp-char 0 3 (token 1 3)) (whitespace 3 4) (token 4 7)) - (test-parse "((( )))" (parens 0 8 (list (parens 1 7 (list (parens 2 6 (list (whitespace 3 5)))))))) + (test-parse "((( )))" (parens 0 8 (parens 1 7 (parens 2 6 (whitespace 3 5))))) (test-parse "(#" (parens 0 +end+ (sharp-unknown 1 +end+))) (test-parse "(#)" (parens 0 +end+ (sharp-unknown 1 +end+))) (test-parse "(#) " @@ -1124,16 +1133,15 @@ the function read-sharpsign-dispatching-reader-macro 0 +end+ (sharp-function 1 +end+ - (list (node ':extraneous-closing-parens 3 +end+))))) + (nodes (node ':extraneous-closing-parens 3 +end+))))) (test-parse "#1=#1#" (sharp-label 0 6 - (list :label 1 :form - (list (sharp-reference 3 6 1))))) - (test-parse "(;)" (parens 0 -1 (list (line-comment 1 3)))) + (nodes 1 (sharp-reference 3 6 1)))) + (test-parse "(;)" (parens 0 -1 (line-comment 1 3))) ;; TODO This is wrong - (test-parse "#+;;" (sharp-feature 0 4 (list (line-comment 2 4)))) + (test-parse "#+;;" (sharp-feature 0 4 (nodes (line-comment 2 4)))) ;; TODO Is that what I want? - (test-parse "#++;;" (sharp-feature 0 3 (list (token 2 3))) (line-comment 3 5)) + (test-parse "#++;;" (sharp-feature 0 3 (nodes (token 2 3))) (line-comment 3 5)) ;; TODO This is wrong... but _OMG_ (test-parse (format nil "cl-user::; wtf~%reaally?") (token 0 9) (line-comment 9 14) (whitespace 14 15) (token 15 23)) @@ -1142,9 +1150,9 @@ the function read-sharpsign-dispatching-reader-macro ;; TODO This is silly (test-parse ",." (node 'comma 0 1) (node 'dot 1 2)) (test-parse "(in-package #)" (parens 0 -1 - (list (token 1 11) - (whitespace 11 12) - (sharp-unknown 12 -1))))) + (nodes (token 1 11) + (whitespace 11 12) + (sharp-unknown 12 -1))))) #++ ;; this is cursed (read-from-string "cl-user::; wtf diff --git a/tests/lossless-reader.randomized.lisp b/tests/lossless-reader.randomized.lisp index a73accf6..58166313 100644 --- a/tests/lossless-reader.randomized.lisp +++ b/tests/lossless-reader.randomized.lisp @@ -148,4 +148,27 @@ #++ (∀ (128 x y z) - (map 'string 'code-char (list x y z))) + (map 'string 'code-char (list x y z))) + + + +; file: /home/fstamour/dev/breeze/tests/lossless-reader.randomized.lisp +; in: +; PARACHUTE:DEFINE-TEST+RUN BREEZE.TEST.LOSSLESS-READER::PARSE-RANDOMIZED +; (REMHASH STRING BREEZE.TEST.LOSSLESS-READER::*TEST-STRINGS*) +; +; caught WARNING: +; undefined variable: COMMON-LISP:STRING + +; (FORMAT STREAM "Remove ~s from *test-strings* and continue to the next test." +; STRING) +; +; caught WARNING: +; undefined variable: COMMON-LISP:STRING +; +; compilation unit finished +; Undefined variable: +; STRING +; caught 2 WARNING conditions +; caught 16 STYLE-WARNING conditions +; printed 1 note