Add parser support for relative import.

Author: metawilm

compiler/compiler.lisp

@@ -1365,6 +1365,10 @@ LOCALS shares share tail structure with input arg locals."
 (defvar *inside-import-from-stmt* nil) ;; hack
 
 (defmacro [import-from-stmt] (mod-name-as-list items)
+  (when (eq (car mod-name-as-list) '[.])
+    (error "Relative imports are not yet supported by the compiler: ~A" 
+           (with-output-to-string (s)
+             (py-pprint `([import-from-stmt] ,mod-name-as-list ,items) s))))
   `(let* ((*module-namespace* nil) ;; hack
           (args (list :within-mod-path ,*compile-file-truename*
                       :within-mod-name ',*current-module-name*))

parser/grammar.lisp

@@ -348,12 +348,17 @@ Value should be a (weak) EQ hash table: (make-weak-key-hash-table :test 'eq).")
 (gp comma--dotted-as-name+)
 (p comma--dotted-as-name ([,] dotted-as-name) $2)
 
-(p import-from ([from] dotted-name [import] import-from-2) `([import-from-stmt] ,$2 ,$4))
+(p import-from ([from]      dotted-name  [import] import-from-2) `([import-from-stmt] ,$2 ,$4))
+(p import-from ([from] dots dotted-name? [import] import-from-2) `([import-from-stmt] ,(nconc $2 $3) ,$5))
+
 (p import-from-2 :or
    (([*]) $1)
    ((import-as-name comma--import-as-name*) (cons $1 $2))
    (([(] import-as-name comma--import-as-name* comma? [)]) (cons $2 $3)))
 
+(p dots ([.])       (list $1))
+(p dots (dots [.])  (nconc $1 (list $2)))
+
 (gp comma--import-as-name+)
 (p comma--import-as-name ([,] import-as-name) $2)
 

parser/lexer.lisp

@@ -100,7 +100,8 @@ where TOKEN-KIND is a symbol like '[identifier]"
    (bracket-level :accessor ls-bracket-level :initform 0  :type fixnum)
    (open-deco                                :initform nil)
    (return-count                             :initform 0)
-   (last-newline-in-source :reader ls-last-newline-in-source :initform :unknown))
+   (last-newline-in-source :reader ls-last-newline-in-source :initform :unknown)
+   (last-returned-value :accessor ls-last-returned-value :initform nil))
   (:metaclass closer-mop:funcallable-standard-class))
 
 (defmethod print-object ((lexer lexer) stream)
@@ -124,6 +125,7 @@ where TOKEN-KIND is a symbol like '[identifier]"
 (define-symbol-macro %lex-curr-line-no%        (ls-curr-line-no *lex-state*))
 (define-symbol-macro %lex-string%              (ls-string *lex-state*))
 (define-symbol-macro %lex-tab-width%           (ls-tab-width *lex-state*))
+(define-symbol-macro %lex-last-returned-value% (ls-last-returned-value *lex-state*))
 
 (defgeneric call-lexer (yacc-version lexer op)
   (:documentation "Returns either the eof-token, or two values: TOKEN-KIND, TOKEN-VALUE"))
@@ -162,6 +164,7 @@ On EOF returns: eof-token, eof-token."
     (flet ((lex-return (token value source-loc &optional msg)
              (when *lex-debug* (format t "Lexer returns: ~S ~S ~S~@[ ~A~]~%" token value source-loc msg))
              (incf return-count)
+             (setf %lex-last-returned-value% value)
              (return-from call-lexer (values token value source-loc)))
            (lex-todo (token value)
              (when *lex-debug* (format t "Lexer todo: ~S ~S~%" token value))
@@ -234,6 +237,12 @@ On EOF returns: eof-token, eof-token."
                      (read-kind :string c)
                    (lex-return '[literal-expr] (list '[literal-expr] :string val) source-loc)))
 
+                ((and (char= c #\.)
+                      (member %lex-last-returned-value% '([from] [.])))
+                 (multiple-value-bind (val source-loc)
+                     (read-kind :dot c)
+                   (lex-return val val source-loc)))
+                      
                 ((or (punct-char1-p c)
                      (punct-char-not-punct-char1-p c))
                  (multiple-value-bind (token source-loc)
@@ -422,6 +431,11 @@ Used by compiler to generate 'forbidden' identfiers.")
     (or (find-symbol str (load-time-value (find-package :clpython.ast.reserved)))
         (intern str (load-time-value (find-package :clpython.user))))))
 
+(defmethod read-kind ((kind (eql :dot)) c1 &rest args)
+  (declare (ignorable kind))
+  (assert (char= c1 #\.))
+  '[.])
+  
 ;; String
 
 (defmethod read-kind ((kind (eql :string)) ch1 &key raw unicode)

test/parser-test.lisp

@@ -87,6 +87,8 @@
                     `([literal-expr] :number ,(expt 10 n-expt)))))
 
     ;; import
+    (test-equal '([import-from-stmt] ({a} {b}) (({c} nil))) (ps "from a.b import c" t))
+    
     (test-equal '([import-from-stmt] ({sys}) (({path} nil))) (ps "from sys import path" t))
     (test-equal '([import-from-stmt] ({sys}) (({path} nil))) (ps "from sys import (path)" t))
     (test-equal '([import-from-stmt] ({sys}) (({path} nil))) (ps "from sys import (path,)" t))
@@ -103,6 +105,12 @@
     (test-equal '([import-from-stmt] ({sys}) (({path} nil) ({exit} {e}))) (ps "from sys import (path, exit as e,)" t))
     (test-error (ps "from sys import (path exit)" t) :condition-type '{SyntaxError})
 
+    (test-equal '([import-from-stmt] ([.]                ) (({b} nil))) (ps "from . import b" t))
+    (test-equal '([import-from-stmt] ([.] {a}            ) (({b} nil))) (ps "from .a import b" t))
+    (test-equal '([import-from-stmt] ([.] [.] {a}        ) (({b} nil))) (ps "from ..a import b" t))
+    (test-equal '([import-from-stmt] ([.] [.] [.] {a}    ) (({b} nil))) (ps "from ...a import b" t))
+    (test-equal '([import-from-stmt] ([.] [.] [.] {a} {b}) (({c} nil))) (ps "from ...a.b import c" t))
+    
     ;; suffix operations
     (test-equal '([attributeref-expr]
 		  ([call-expr]