@@ -1163,6 +1163,15 @@ LOCALS shares share tail structure with input arg locals." (define-setf-expander [list-expr] (items &environment e) (get-setf-expansion `(list/tuple-expr ,items) e)) +(defmacro [literal-expr] (kind value) + (ecase kind + (:string (check-type value string) + value) + (:bytes (check-type value string) + `(TODO-make-bytes ,value)) ;; XXX TODO + (:number (check-type value number) + value))) + (defvar *habitat* nil) (defvar *module-preload-hook*) core/compiler.lisp @@ -383,14 +383,14 @@ former requires that this form is executed within RECEIVE-YIELDED-VALUE." ([exec-stmt] ,@args)) ,(%call-continuation))) -(def-cps-macro [for-in-stmt] (target source suite else-suite) +(def-cps-macro [for-in-stmt] (target source suite else-suite &environment e) (with-gensyms (e-source it-fun for-cont for-break-cont else-cont ignore stmt-k) `(let ((,stmt-k ,%current-continuation)) (with-cps-conversion (,source ,e-source) (let* ((,it-fun (get-py-iterate-fun ,e-source))) - (labels (,@(when (contains-continue-stmt-p suite) + (labels (,@(when (contains-continue-stmt-p suite e) `((%continue-cont () (,for-cont)))) - ,@(when (contains-break-stmt-p suite) + ,@(when (contains-break-stmt-p suite e) `((%break-cont () (,for-break-cont)))) (,for-break-cont () (funcall ,stmt-k nil)) @@ -478,18 +478,19 @@ former requires that this form is executed within RECEIVE-YIELDED-VALUE." (def-cps-macro [listcompr-expr] (item for-in/if-clauses) (with-gensyms (result-list ignore) `(let ((,result-list (make-py-list-from-list ()))) + (with-pydecl ((:inside-cps-list-comprehension t)) ,(loop with builder = `([call-expr] ([attributeref-expr] ,result-list ([identifier-expr] {append})) (,item) nil nil nil) for clause in (reverse for-in/if-clauses) - do (setf builder - (ecase (car clause) - ([for-in-clause] (destructuring-bind (target source) (cdr clause) - `([for-in-stmt] ,target ,source ,builder nil))) - ([if-clause] (let ((test (second clause))) - `([if-stmt] ((,test ,builder)) nil))))) - finally (return `(with-cps-conversion (,builder ,ignore) - (declare (ignore ,ignore)) - ,(%call-continuation result-list))))))) + do (setf builder + (ecase (car clause) + ([for-in-clause] (destructuring-bind (target source) (cdr clause) + `([for-in-stmt] ,target ,source ,builder nil))) + ([if-clause] (let ((test (second clause))) + `([if-stmt] ((,test ,builder)) nil))))) + finally (return `(with-cps-conversion (,builder ,ignore) + (declare (ignore ,ignore)) + ,(%call-continuation result-list)))))))) (def-cps-macro [list-expr] (items) ;; Relies on tuples being Lisp lists. @@ -497,6 +498,10 @@ former requires that this form is executed within RECEIVE-YIELDED-VALUE." `(with-cps-conversion (([tuple-expr] ,items) ,e-tuple) ,(%call-continuation `(make-py-list-from-tuple ,e-tuple))))) +(def-cps-macro [literal-expr] (kind value) + (%call-continuation `(with-pydecl ((:ignore-cps-hook t)) + ([literal-expr] ,kind ,value)))) + (def-cps-macro [module-stmt] (&rest args) #+(or)(declare (ignore args)) ;; ends up in the wrong place args ;; so it's used @@ -660,8 +665,11 @@ former requires that this form is executed within RECEIVE-YIELDED-VALUE." `(with-cps-conversion (,val ,e-val) ,(%call-continuation `(funcall (function ,py-op-func) ,e-val)))))) -(defun contains-break-stmt-p (suite) +(defun contains-break-stmt-p (suite env) "Whether SUITE contains BREAK stmt (not within inner loop)." + (when (get-pydecl :inside-cps-list-comprehension env) + ;; List comprehension expansion is unwalkable; this is a hack to make the walker not crash. + (return-from contains-break-stmt-p nil)) (with-py-ast (form suite) (case (car form) (([for-in-stmt] [while-stmt]) (values nil t)) @@ -670,8 +678,11 @@ former requires that this form is executed within RECEIVE-YIELDED-VALUE." (t form))) nil) -(defun contains-continue-stmt-p (suite) +(defun contains-continue-stmt-p (suite env) "Whether SUITE contains BREAK stmt (not within inner loop)." + (when (get-pydecl :inside-cps-list-comprehension env) + ;; List comprehension expansion is unwalkable; this is a hack to make the walker not crash. + (return-from contains-continue-stmt-p nil)) (with-py-ast (form suite) (case (car form) (([for-in-stmt] [while-stmt]) (values nil t)) @@ -680,12 +691,12 @@ former requires that this form is executed within RECEIVE-YIELDED-VALUE." (t form))) nil) -(def-cps-macro [while-stmt] (test suite else-suite) +(def-cps-macro [while-stmt] (test suite else-suite &environment e) (let ((stmt-k %current-continuation)) (with-gensyms (while-cont val ignore) - `(labels (,@(when (contains-break-stmt-p suite) + `(labels (,@(when (contains-break-stmt-p suite e) `((%break-cont () (funcall ,stmt-k nil)))) - ,@(when (contains-continue-stmt-p suite) + ,@(when (contains-continue-stmt-p suite e) `((%continue-cont () (,while-cont)))) (,while-cont () (with-cps-conversion (,test ,val) core/generator.lisp @@ -23,6 +23,7 @@ :inside-class-p ;; T iff inside CLASSDEF (to check GLOBAL). :inside-loop-p ;; T iff inside WHILE of FOR (to check BREAK, CONTINUE). :inside-setf-py-attr ;; T if insides a (setf (py-attr ..) ..) form (work around Allegro CL bug). + :inside-cps-list-comprehension ;; T iff inside CPS conversion of LISTCOMPR-EXPR :declared-globals-current-scope ;; List of variable that in the current scope must be treated as globals :lexically-declared-globals ;; Variables declared global by functions :lexically-visible-vars ;; List of variable names that can be closed over (excludes globals). core/pydecl.lisp @@ -63,7 +63,7 @@ (defpackage :clpython.ast.token (:use ) - (:export "newline" "indent" "dedent" "identifier" "number" "string")) + (:export "newline" "indent" "dedent" "identifier" "literal-expr")) (defpackage :clpython.ast.node (:documentation "Statement and expression nodes") package/package.lisp @@ -49,6 +49,7 @@ ([lambda-expr] args expr) ([listcompr-expr] item for-in/if-clauses) ([list-expr] items) + ([literal-expr] value) ([module-stmt] suite) ([pass-stmt] ) ([print-stmt] dest items comma?) @@ -181,17 +182,9 @@ Value should be a (weak) EQ hash table: (make-weak-key-hash-table :test 'eq).") (defparameter *module->source-positions* (make-hash-table :test 'equal) "EQ hashtable, mapping from pathname to source data. Filled during loading.") -(defstruct (literal (:constructor make-literal (value))) - value) - -(defun maybe-unwrap-literal-value (x) - (if (literal-p x) - (literal-value x) - x)) - (defun record-source-location (outcome start end) "Records location in *python-form->source-location*" - (check-type outcome (or list literal number string symbol)) ;; XXX reduce number of possibilities + (check-type outcome list) (when *python-form->source-location* (let ((existing (gethash outcome *python-form->source-location*)) (loc (list :start start :end end))) @@ -551,27 +544,39 @@ Value should be a (weak) EQ hash table: (make-weak-key-hash-table :test 'eq).") (( [{] dictmaker [}] ) `([dict-expr] ,$2) ) (( [`] testlist1 [`] ) `([backticks-expr] ,$2) ) (( [identifier] ) `([identifier-expr] ,$1) ) - (( [number] ) $1 ) - (( [.] [number] ) (let (($2val (literal-value $2)) - (suffix (float-suffix *normal-float-representation-type*))) - ;; A float value starting with a dot, like ".5" - ;; As NUMBER is a fraction between 0 and 1, it always falls in the range - ;; of the float representation type. - (make-literal - (typecase $2val - (integer (let ((str (format nil "0.~A~A0" $2val suffix))) - (with-standard-io-syntax (read-from-string str)))) - (complex (assert (zerop (realpart $2val))) - (assert (typep (imagpart $2val) 'integer)) - (let ((str (format nil "0.~A~A0" (imagpart $2val) suffix))) - (complex 0 (with-standard-io-syntax (read-from-string str))))) - (t (raise-syntax-error - "Invalid format for number starting with dot: .~G" $2val)))))) - (( string+ ) - ;; consecutive string literals are joined: "ab" "c" => "abc" - (make-literal (apply #'concatenate 'string (mapcar #'literal-value $1))))) - -(gp string+) + (( [.] [literal-expr] ) (destructuring-bind (kind value) (cdr $2) + (unless (eq kind :number) + (raise-syntax-error "Invalid literal number: .~A" (third $2))) + (let ((suffix (float-suffix *normal-float-representation-type*))) + ;; A float value starting with a dot, like ".5" + ;; As NUMBER is a fraction between 0 and 1, it always falls in the range + ;; of the float representation type. + `([literal-expr] + :number + ,(typecase value + (integer (let ((str (format nil "0.~A~A0" value suffix))) + (with-standard-io-syntax (read-from-string str)))) + (complex (assert (zerop (realpart value))) + (assert (typep (imagpart value) 'integer)) + (let ((str (format nil "0.~A~A0" (imagpart value) suffix))) + (complex 0 (with-standard-io-syntax (read-from-string str))))) + (t (raise-syntax-error + "Invalid format for number starting with dot: .~G" value))))))) + (( literal+ ) + ;; Consecutive string literals are joined: "ab" "c" => "abc". + ;; Same with byte literals: b'1' b'2' -> b'12'. + ;; But not mixed string/byte. + (if (> (length $1) 1) + (let ((types (remove-duplicates (mapcar #'second $1)))) + (if (and (= (length types) 1) + (member (car types) '(:string :bytes))) + (let ((first-literal (car $1))) + (list (first first-literal) (second first-literal) (apply #'concatenate 'string (mapcar #'third $1)))) + (raise-syntax-error "Invalid sequence of literals: ~:{~S ~S~:^, ~}." (mapcar #'cdr $1)))) + (car $1)))) + +(gp literal+) +(p literal ([literal-expr]) $1) (p listmaker (test list-for) `([listcompr-expr] ,$1 ,$2)) (p listmaker (test comma--test* comma?) `([list-expr] ,(cons $1 $2))) @@ -743,21 +748,9 @@ For example: - (1 * 2) => (-1) * 2" (setf res `([attributeref-expr] ,res ([identifier-expr] ,x)))))) (defun finish-ast (ast) - (prog1 (unwrap-literals ast) + (prog1 ast (clean-source-locations))) -(defun unwrap-literals (x) - (etypecase x - ((or symbol number) x) - (literal (literal-value x)) - (list (let ((res (mapcar #'unwrap-literals x))) - (when *python-form->source-location* - (let ((loc (gethash x *python-form->source-location*))) - (when loc - (setf (gethash res *python-form->source-location*) loc) - (remhash x *python-form->source-location*)))) - res)))) - (defun clean-source-locations () (declare (special *expr-stmt-nodes*)) (when *python-form->source-location* @@ -774,3 +767,7 @@ For example: - (1 * 2) => (-1) * 2" (clpython.parser::py-pprint k) (getf v :start) (getf v :end) (if (listp k) (car k) k))) ht))) +(defun maybe-unwrap-literal-value (x) + (if (and (listp x) (eq (car x) '[literal-expr])) + (third x) + x)) parser/grammar.lisp @@ -105,7 +105,7 @@ (multiple-value-bind (token value source-loc) (funcall lexer op) ;; Assuming eof-token is a symbol, which is true for acl/cl yacc: - (check-type value (or list literal symbol)) + (check-type value (or list symbol)) (when (and source-loc *python-form->source-location*) (setf (gethash value *python-form->source-location*) source-loc)) (values token value))))) @@ -187,7 +187,7 @@ On EOF returns: eof-token, eof-token." ((digit-char-p c 10) (multiple-value-bind (val source-loc) (read-kind :number c) - (lex-return '[number] (make-literal val) source-loc))) + (lex-return '[literal-expr] (list '[literal-expr] :number val) source-loc))) ((identifier-char1-p c) (multiple-value-bind (token source-loc) @@ -199,16 +199,26 @@ On EOF returns: eof-token, eof-token." ;; ur"asdf" : `ur' stands for `raw unicode string' ;; ur + a : `ur' is identifier ;; `u' must appear before `r' if both are string prefix + ;; Bytes (introduced in CPython 2.6): + ;; b"sdf" : bytes + ;; b'sdf' : bytes + ;; br"sdf" : raw bytes + ;; br'sdf' : raw bytes (when (and (<= (length (symbol-name token)) 2) - (member (symbol-name token) '("u" "r" "ur") :test 'string-equal)) + (member (sort (copy-seq (symbol-name token)) #'char-lessp) + '("r" "u" "ru" "b" "br") + :test 'string-equal)) (let ((ch (lex-read-char :eof-error nil))) (if (and ch (char-member ch '(#\' #\"))) (let* ((sn (symbol-name token)) (unicode (position #\u sn :test 'char-equal)) - (raw (position #\r sn :test 'char-equal))) + (raw (position #\r sn :test 'char-equal)) + (bytes (position #\b sn :test 'char-equal))) (multiple-value-bind (val source-loc) (read-kind :string ch :raw raw :unicode unicode) - (lex-return '[string] (make-literal val) source-loc))) + (lex-return '[literal-expr] + (list '[literal-expr] (if bytes :bytes :string) val) + source-loc))) (when ch (lex-unread-char ch))))) (when (and open-deco (eq token '[def])) ;; All outstanding decorators are associated with this function @@ -221,7 +231,7 @@ On EOF returns: eof-token, eof-token." ((char-member c '(#\' #\")) (multiple-value-bind (val source-loc) (read-kind :string c) - (lex-return '[string] (make-literal val) source-loc))) + (lex-return '[literal-expr] (list '[literal-expr] :string val) source-loc))) ((or (punct-char1-p c) (punct-char-not-punct-char1-p c)) parser/lexer.lisp @@ -50,79 +50,6 @@ output to a string does not start with a newline." (with-standard-io-syntax (format stream "~A" object))) -(defmethod py-pprint-1 (stream (x integer)) - (with-standard-io-syntax - (format stream "~D" x))) - -(defmethod py-pprint-1 (stream (x float)) - (with-standard-io-syntax - (format stream "~G" x))) - -(defmethod py-pprint-1 (stream (x complex)) - (assert (= 0 (realpart x))) - (with-standard-io-syntax - (format stream "~Gj" (imagpart x)))) - -(defmethod py-pprint-1 (stream (x string)) - (multiple-value-bind (delim-quote other-quote unicode?) - (loop for ch of-type character across x - counting (char= ch #\') into single-qs - counting (char= ch #\") into double-qs - counting (> (char-code ch) 255) into unicode - finally (let* ((delim-quote (if (<= single-qs double-qs) #\' #\")) - (other-quote (if (char= delim-quote #\') #\" #\')) - (unicode? (> unicode 0))) - (return (values delim-quote other-quote unicode?)))) - - (with-standard-io-syntax ;; no recursion please - - (when unicode? ;; unicode prefix 'u' - (write-char #\u stream)) - - (write-char delim-quote stream) ;; starting quote - - (loop for ch of-type character across (the string x) - do (cond ((char= ch delim-quote) (write-char #\\ stream) - (write-char ch stream)) - - ((char= ch other-quote) (write-char ch stream)) - - ((char= ch #\\) (write-char #\\ stream) - (write-char #\\ stream)) - - ;; printable ASCII character - ((and (<= (char-code ch) 127) - (graphic-char-p ch)) (write-char ch stream)) - - ((> (char-code ch) 255) - (format stream "\\u~v,vX" - (if (> (char-code ch) #xFFFF) 8 4) - #\0 (char-code ch))) - - ((alphanumericp ch) (write-char ch stream)) - - (t (loop for ch across - ;; Cross-reference: #'(read-kind (string) ..) does the inverse. - (case ch - (#\Bell "\\a") - (#\Backspace "\\b") - (#\Page "\\p") - (#\Newline "\\n") - (#\Return "\\r") - (#\Tab "\\t") - (#.(code-char 11) "\\v") ;; #\VT or #\PageUp - (#\Space " " ) - - ;; Maybe there are more cases to catch before - ;; we encode the character in octal code? - - (t (format nil "\\0~3,vO" #\0 (char-code ch)))) - - do (write-char ch stream))))) - - (write-char delim-quote stream)))) ;; closing quote - - (defvar *precedence-level* -1) ;; XXX check prec levels @@ -277,6 +204,9 @@ output to a string does not start with a newline." ([if-clause] (format stream " if ~A" (second clause))))) (format stream "]")) + ([literal-expr] (destructuring-bind (kind value) (cdr x) + (py-pprint-literal stream kind value))) + ([module-stmt] (let ((suite (cadr x))) (assert (eq (first suite) '[suite-stmt])) (format stream "~{~A~%~}" (second suite)))) @@ -367,7 +297,6 @@ output to a string does not start with a newline." ([yield-stmt] (format stream "yield~@[ ~A~]" (second x))) (t (format stream "(~{~S~^ ~})" x)))) - (defun print-arg-list (stream pos-args key-args *-arg **-arg) (let ((*precedence-level* -1) @@ -383,7 +312,83 @@ output to a string does not start with a newline." (format stream "~@[**~A~]" **-arg))) + +(defgeneric py-pprint-literal (stream kind value)) + +(defmethod py-pprint-literal (stream (kind (eql :number)) (x integer)) + (with-standard-io-syntax + (format stream "~D" x))) + +(defmethod py-pprint-literal (stream (kind (eql :number)) (x complex)) + (assert (= 0 (realpart x))) + (with-standard-io-syntax + (format stream "~Gj" (imagpart x)))) + +(defmethod py-pprint-literal (stream (kind (eql :string)) (x string)) + (multiple-value-bind (delim-quote other-quote unicode?) + (loop for ch of-type character across x + counting (char= ch #\') into single-qs + counting (char= ch #\") into double-qs + counting (> (char-code ch) 255) into unicode + finally (let* ((delim-quote (if (<= single-qs double-qs) #\' #\")) + (other-quote (if (char= delim-quote #\') #\" #\')) + (unicode? (> unicode 0))) + (return (values delim-quote other-quote unicode?)))) + + (with-standard-io-syntax ;; no recursion please + + (when unicode? ;; unicode prefix 'u' + (write-char #\u stream)) + + (write-char delim-quote stream) ;; starting quote + + (loop for ch of-type character across (the string x) + do (cond ((char= ch delim-quote) (write-char #\\ stream) + (write-char ch stream)) + + ((char= ch other-quote) (write-char ch stream)) + + ((char= ch #\\) (write-char #\\ stream) + (write-char #\\ stream)) + + ;; printable ASCII character + ((and (<= (char-code ch) 127) + (graphic-char-p ch)) (write-char ch stream)) + + ((> (char-code ch) 255) + (format stream "\\u~v,vX" + (if (> (char-code ch) #xFFFF) 8 4) + #\0 (char-code ch))) + + ((alphanumericp ch) (write-char ch stream)) + + (t (loop for ch across + ;; Cross-reference: #'(read-kind (string) ..) does the inverse. + (case ch + (#\Bell "\\a") + (#\Backspace "\\b") + (#\Page "\\p") + (#\Newline "\\n") + (#\Return "\\r") + (#\Tab "\\t") + (#.(code-char 11) "\\v") ;; #\VT or #\PageUp + (#\Space " " ) + + ;; Maybe there are more cases to catch before + ;; we encode the character in octal code? + + (t (format nil "\\0~3,vO" #\0 (char-code ch)))) + + do (write-char ch stream))))) + + (write-char delim-quote stream)))) ;; closing quote + +(defmethod py-pprint-literal (stream (kind (eql :number)) (x float)) + (with-standard-io-syntax + (format stream "~G" x))) + + ;; Utils (defun parse-and-print (str) - (py-pprint (parse str))) \ No newline at end of file + (py-pprint (parse str))) parser/pprint.lisp @@ -12,7 +12,6 @@ (in-package :clpython.parser) (in-syntax *ast-readtable*) -(defvar *walk-lists-only*) (defvar *walk-build-result*) (defvar *walk-into-nested-namespaces*) (defvar *walk-warn-unknown-form* t) @@ -37,8 +36,7 @@ (defun walk-py-ast (ast f &key (value +no-value+) (target +no-target+) - (lists-only t) - (build-result nil) + (build-result nil) (into-nested-namespaces nil) (warn-unknown-form *walk-warn-unknown-form*)) (declare (optimize (debug 3))) @@ -62,8 +60,6 @@ value, the second value must be true.) The initial form AST is considered an expression used for its value iff VALUE is true; it is considered an assignment target iff TARGET is true. -When LISTS-ONLY is false, F will also be called on numbers and strings. - When build-result is false, no new AST will be returned, so F is only called for side effects. @@ -74,9 +70,6 @@ CLASSDEF, FUNCDEF or LAMBDA." ;; module, is evaluated in a non-value non-target context, that ;; context seems a reasonable default for the keyword arguments. - (when (and lists-only (not (listp ast))) - (return-from walk-py-ast ast)) - (labels ((walk-py-ast-1 (ast &key value target) (declare (optimize (debug 3))) @@ -85,34 +78,29 @@ CLASSDEF, FUNCDEF or LAMBDA." (unless ast (break "Attempt to WALK-PY-AST into an AST that is NIL")) - (when (and lists-only (not (consp ast))) ;; Don't call user function on AST - (return-from walk-py-ast-1 ast)) - - ;; Call user function on whole form. The returned values + ;; Call user function on whole form. The returned values ;; control how we proceed. (multiple-value-bind (ret-ast final-p) (funcall f ast :value value :target target) (when final-p (return-from walk-py-ast-1 ret-ast)) - - (assert ret-ast () + + (assert ret-ast () "User AST func returned NIL (for AST: ~S); that is only allowed ~ when second value (final-p) is True, but second value was: ~S" ast final-p) - (when (or (consp ret-ast) (not lists-only)) - (return-from walk-py-ast-1 - (ast-recurse-fun (lambda (ast &key value target) - (walk-py-ast-1 ast :value value :target target)) - ret-ast - :value value - :target target))) + (return-from walk-py-ast-1 + (ast-recurse-fun (lambda (ast &key value target) + (walk-py-ast-1 ast :value value :target target)) + ret-ast + :value value + :target target)) - (break "Walking AST: invalid return value ~S (AST: ~S, F: ~S)" + (break "Walking AST: invalid return value ~S (AST: ~S, F: ~S)" ret-ast ast f)))) - (let ((*walk-lists-only* lists-only) - (*walk-build-result* build-result) + (let ((*walk-build-result* build-result) (*walk-into-nested-namespaces* into-nested-namespaces) (*walk-warn-unknown-form* warn-unknown-form)) @@ -240,6 +228,9 @@ CLASSDEF, FUNCDEF or LAMBDA." (def-ast-node [list-expr] ((&rest names +normal-value+)) (:targetable t) (:subtargetable t)) +;; Literal value itself (number, string) is not walked into. +(def-ast-node [literal-expr] (kind value)) + ;; listcompr-expr : hairy (def-ast-node [tuple-expr] ((&rest names +normal-value+)) (:targetable t) (:subtargetable t)) @@ -259,7 +250,7 @@ CLASSDEF, FUNCDEF or LAMBDA." (def-ast-node [try-finally-stmt] ((try-suite +suite+) (finally-suite +suite+))) -(def-ast-node [unary-expr] ((val +normal-value+))) +(def-ast-node [unary-expr] (op (val +normal-value+))) (def-ast-node [while-stmt] ((test +normal-value+) (suite +suite+) (&optional else-suite +suite+))) (def-ast-node [with-stmt] ((test +normal-value+) (&optional var +normal-target+) (suite +suite+))) (def-ast-node [yield-expr] ((val +normal-value+))) @@ -446,7 +437,7 @@ CLASSDEF, FUNCDEF or LAMBDA." ;; Handy functions for dealing with ASTs (defmacro with-py-ast ((subform ast &rest options) - ;; key value target walk-lists-only + ;; key value target ;; into-nested-namespaces &body body) ;; (with-sub-ast ((form &key value target) ast) @@ -463,18 +454,16 @@ CLASSDEF, FUNCDEF or LAMBDA." (lambda ,subform (declare (optimize (debug 3)) ,@(when context `((ignore ,context)))) - ,@body)) + ,@body)) ;; user-supplied options take precedence... ,@options ;; but these are the defaults - :build-result nil - :lists-only t))) + :build-result nil))) ;;; Printing walker, for debugging (defgeneric walk-print (ast &rest walk-options) (:method ((ast list) &rest walk-options) - (setf walk-options (append walk-options '(:lists-only nil))) (prog1 (apply #'walk-py-ast ast (lambda (ast &key value target) parser/walk.lisp @@ -47,19 +47,20 @@ (test-true (find-symbol "foo" :clpython.user)) ;; created by previous test (test-true (eq '{abs} '{abs} )) - ;; atoms - (test-equal '([module-stmt] ([suite-stmt] (42))) (ps "42")) - (test-equal '([module-stmt] ([suite-stmt] ("x"))) (ps "'x'")) + ;; literals + (test-equal '([module-stmt] ([suite-stmt] (([literal-expr] :number 42)))) (ps "42")) + (test-equal '([module-stmt] ([suite-stmt] (([literal-expr] :string "x")))) (ps "'x'")) + (test-equal '([module-stmt] ([suite-stmt] (([literal-expr] :bytes "x")))) (ps "b'x'")) ;; variables - (test-equal '([assign-stmt] 3 (([identifier-expr] {y} ))) (ps "y = 3" nil)) - (test-equal '([assign-stmt] 3 (([identifier-expr] {len}))) (ps "len = 3" nil)) + (test-equal '([assign-stmt] ([literal-expr] :number 3) (([identifier-expr] {y} ))) (ps "y = 3" nil)) + (test-equal '([assign-stmt] ([literal-expr] :number 3) (([identifier-expr] {len}))) (ps "len = 3" nil)) ;; floating point (complex) numbers - (test-equal 0.5d0 (ps "0.5" nil)) - (test-equal 0.5d0 (ps ".5" nil)) - (test-equal #C(0.0 0.5d0) (ps "0.5j" nil)) - (test-equal #C(0.0 0.5d0) (ps ".5j" nil)) + (test-equal '([literal-expr] :number 0.5d0) (ps "0.5" nil)) + (test-equal '([literal-expr] :number 0.5d0) (ps ".5" nil)) + (test-equal '([literal-expr] :number #C(0.0 0.5d0)) (ps "0.5j" nil)) + (test-equal '([literal-expr] :number #C(0.0 0.5d0)) (ps ".5j" nil)) (assert (not (eq clpython.parser::*normal-float-representation-type* clpython.parser::*enormous-float-representation-type*)) @@ -68,7 +69,7 @@ (clpython.parser::number-range clpython.parser::*normal-float-representation-type*) (assert (< min-f 0)) (assert (< (expt 10 3) max-f) () "Really small float range in this Lisp implementation?!") - (test-equal 1D3 (ps "1e3" nil)) ;; 1e3 is small enough to be a regular ..-FLOAT + (test-equal '([literal-expr] :number 1D3) (ps "1e3" nil)) ;; 1e3 is small enough to be a regular ..-FLOAT (let* ((n-expt (1+ (floor (log max-f 10)))) (s (format nil "1E~A" n-expt))) (test-error (ps s nil) :condition-type '{SyntaxError}) ;; "too large to represent as ..-FLOAT" @@ -77,30 +78,31 @@ (test-true (find-restart 'continue)) (invoke-restart (find-restart 'continue))))) (ps s nil)) - (expt 10 n-expt)))) + `([literal-expr] :number ,(expt 10 n-expt))))) ;; suffix operations (test-equal '([attributeref-expr] ([call-expr] - ([subscription-expr] ([identifier-expr] {x}) 1) - (2) nil nil nil) + ([subscription-expr] ([identifier-expr] {x}) ([literal-expr] :number 1)) + (([literal-expr] :number 2)) nil nil nil) ([identifier-expr] {a3})) (ps "x[1](2).a3" nil)) ;; call arguments (test-equal '([attributeref-expr] ([call-expr] ([subscription-expr] ([identifier-expr] {x}) - 1) - nil ((([identifier-expr] {len}) 2)) nil nil) + ([literal-expr] :number 1)) + nil ((([identifier-expr] {len}) ([literal-expr] :number 2))) nil nil) ([identifier-expr] {a3})) (ps "x[1](len=2).a3" nil)) (test-equal '([call-expr] ([identifier-expr] {f}) - (1 2) ((([identifier-expr] {y}) 3)) + (([literal-expr] :number 1) ([literal-expr] :number 2)) + ((([identifier-expr] {y}) ([literal-expr] :number 3))) ([identifier-expr] {args}) ([identifier-expr] {kw})) - (ps "f(1,2, y=3, *args, **kw)" nil)) + (ps "f(1, 2, y=3, *args, **kw)" nil)) ;; order of args: pos, key, *, ** (test-error (ps "f(a=1,b)" nil) @@ -130,53 +132,61 @@ def f(): pass" nil)) ;; Precedence of unary operators and exponentiation (test-equal '([binary-expr] [*] - ([unary-expr] [-] 1) - 2) + ([unary-expr] [-] ([literal-expr] :number 1)) + ([literal-expr] :number 2)) (ps "-1 * 2" nil) :fail-info "-1 * 2 == (-1) * 2") (test-equal '([binary-expr] [*] - ([unary-expr] [+] 1) - 2) + ([unary-expr] [+] ([literal-expr] :number 1)) + ([literal-expr] :number 2)) (ps "+1 * 2" nil) :fail-info "+1 * 2 == (+1) * 2") - (test-equal '([unary-expr] [-] ([binary-expr] [**] 1 2)) + (test-equal '([unary-expr] [-] ([binary-expr] [**] + ([literal-expr] :number 1) + ([literal-expr] :number 2))) (ps "-1 ** 2" nil) :fail-info "-1 ** 2 == - (1 ** 2)") - (test-equal '([unary-expr] [+] ([binary-expr] [**] 1 2)) + (test-equal '([unary-expr] [+] ([binary-expr] [**] + ([literal-expr] :number 1) + ([literal-expr] :number 2))) (ps "+1 ** 2" nil) :fail-info "+1 ** 2 == + (1 ** 2)") (test-equal '([binary-expr] [-] - 1 - ([binary-expr] [*] 2 3)) + ([literal-expr] :number 1) + ([binary-expr] [*] + ([literal-expr] :number 2) + ([literal-expr] :number 3))) (ps "1 - 2 * 3" nil) :fail-info "1 - 2 * 3 == 1 - (2 * 3)") (test-equal '([binary-expr] [/] - ([unary-expr] [~] 1) - 2) + ([unary-expr] [~] ([literal-expr] :number 1)) + ([literal-expr] :number 2)) (ps "~1 / 2" nil) :fail-info "~1 / 2 == (~1) / 2") (test-equal '([unary-expr] [~] - ([binary-expr] [**] 1 2)) + ([binary-expr] [**] + ([literal-expr] :number 1) + ([literal-expr] :number 2))) (ps "~1 ** 2" nil) :fail-info "~1 ** 2 == ~ (1 ** 2)") (test-equal '([binary-expr] [*] - ([unary-expr] [-] 1) + ([unary-expr] [-] ([literal-expr] :number 1)) ([binary-expr] [*] - ([unary-expr] [+] 2) + ([unary-expr] [+] ([literal-expr] :number 2)) ([binary-expr] [*] - ([unary-expr] [-] 3) - ([unary-expr] [+] 4)))) + ([unary-expr] [-] ([literal-expr] :number 3)) + ([unary-expr] [+] ([literal-expr] :number 4))))) (ps "-1 * +2 * -3 * +4" nil)) (test-equal '([binary-expr] [*] - 1 + ([literal-expr] :number 1) ([unary-expr] [-] ([bracketed-expr] ([binary-expr] [*] ([bracketed-expr] ([binary-expr] [*] - ([unary-expr] [-] 2) - 3)) - 4)))) + ([unary-expr] [-] ([literal-expr] :number 2)) + ([literal-expr] :number 3))) + ([literal-expr] :number 4))))) (ps "1 * -((-2 * 3) * 4)" nil)) ;; Empty string is parsed as module without body @@ -190,7 +200,7 @@ def f(): pass" nil)) #+(and allegro unix) ;; no WITH-OPEN-TEMP-FILE on windows (let ((fname (excl.osi:with-open-temp-file (s (format nil "_clpython-ast-test-~A" (gensym))) (format s "print 42")))) - (test-equal '([print-stmt] nil (42) nil) + (test-equal '([print-stmt] nil (([literal-expr] :number 42)) nil) (values (clpython.parser:parse (pathname fname) :one-expr t))) (test t (excl.osi:unlink fname))) @@ -207,16 +217,17 @@ def f(): pass" nil)) (test :unexp-eof-error (try-parse "def f():") :fail-info "(EOF in grammar)") (test :syntax-error (try-parse "def def") :fail-info "(Incorrect grammar)") (test :syntax-error (try-parse " 42") :fail-info "(Leading whitespace)")) - (test-equal 42 (handler-bind (({SyntaxError} (lambda (c) (declare (ignore c)) - (continue)))) - (values (parse " 42" :one-expr t)))) + (test-equal '([literal-expr] :number 42) + (handler-bind (({SyntaxError} (lambda (c) (declare (ignore c)) + (continue)))) + (values (parse " 42" :one-expr t)))) ;; strings with quotes (let ((s (apply #'concatenate 'string (mapcar 'string '(#\' #\" #\\ #\' #\'))))) - (test-equal (values (parse s :one-expr t)) "\"'")) + (test-equal (values (parse s :one-expr t)) '([literal-expr] :string "\"'"))) (let ((s (apply #'concatenate 'string (mapcar 'string '(#\' #\\ #\\ #\'))))) - (test-equal (ignore-errors (values (parse s :one-expr t))) "\\")) + (test-equal (ignore-errors (values (parse s :one-expr t))) '([literal-expr] :string "\\"))) (let ((s (apply #'concatenate 'string (mapcar 'string '(#\' #\\ #\\ #\' #\Space))))) - (test-equal (ignore-errors (values (parse s :one-expr t))) "\\")) + (test-equal (ignore-errors (values (parse s :one-expr t))) '([literal-expr] :string "\\"))) ;; trailing comma (test-no-error (parse "def f(a=3,): pass")) ;; backslash at end of whitespace line @@ -495,7 +506,10 @@ finally: (let ((tests '(("()" (clpython.parser::handle-lisp nil)) ("(,)" :error) ("(f)" (clpython.parser::handle-lisp (f))) - ("(1,2)" (clpython.parser::handle-python ([module-stmt] ([suite-stmt] (([tuple-expr] (1 2)))))))))) + ("(1,2)" (clpython.parser::handle-python + ([module-stmt] ([suite-stmt] + (([tuple-expr] (([literal-expr] :number 1) + ([literal-expr] :number 2))))))))))) (loop for (test expected) in tests do (multiple-value-bind (val error) (ignore-errors (car (let ((*package* #.*package*)) test/parser-test.lisp 2196cfc945eba527c227b3b68f2d09529896164e unknown Willem@.(none) http://github.com/franzinc/cl-python/commit/8297f48ce9132f6a00d454ff1f8f7ea8a5d20160 8297f48ce9132f6a00d454ff1f8f7ea8a5d20160 2009-11-02T15:56:04-08:00 2009-10-24T10:21:50-07:00 Refactor literals, preparing for Python 2.6 bytes() type 690706bee4565ccfd0460acdcc8643cb6502aa79 Willem Broekema metawilm@gmail.com