- (case state
- (0 ;; starting to parse
- (ecase (read-token t)
- (:colon (failure))
- (:question (setq state 7))
- (:hash (setq state 8))
- (:slash (setq state 3))
- (:string (setq state 1))
- (:end (setq state 9))))
- (1 ;; seen <token><special char>
- (let ((token tokval))
- (ecase (read-token t)
- (:colon (setq scheme token)
- (if* (equalp "urn" scheme)
- then (setq state 15)
- else (setq state 2)))
- (:question (push token path-components)
- (setq state 7))
- (:hash (push token path-components)
- (setq state 8))
- (:slash (push token path-components)
- (push "/" path-components)
- (setq state 6))
- (:string (failure))
- (:end (push token path-components)
- (setq state 9)))))
- (2 ;; seen <scheme>:
- (ecase (read-token t)
- (:colon (failure))
- (:question (setq state 7))
- (:hash (setq state 8))
- (:slash (setq state 3))
- (:string (setq state 10))
- (:end (setq state 9))))
- (10 ;; seen <scheme>:<token>
- (let ((token tokval))
- (ecase (read-token t)
- (:colon (failure))
- (:question (push token path-components)
- (setq state 7))
- (:hash (push token path-components)
- (setq state 8))
- (:slash (push token path-components)
- (setq state 6))
- (:string (failure))
- (:end (push token path-components)
- (setq state 9)))))
- (3 ;; seen / or <scheme>:/
- (ecase (read-token t)
- (:colon (failure))
- (:question (push "/" path-components)
- (setq state 7))
- (:hash (push "/" path-components)
- (setq state 8))
- (:slash (setq state 4))
- (:string (push "/" path-components)
- (push tokval path-components)
- (setq state 6))
- (:end (push "/" path-components)
- (setq state 9))))
- (4 ;; seen [<scheme>:]//
- (ecase (read-token t)
- (:colon (failure))
- (:question (failure))
- (:hash (failure))
- (:slash
- (if* (and (equalp "file" scheme)
- (null host))
- then ;; file:///...
- (push "/" path-components)
- (setq state 6)
- else (failure)))
- (:string (setq host tokval)
- (setq state 11))
- (:end (failure))))
- (11 ;; seen [<scheme>:]//<host>
- (ecase (read-token t)
- (:colon (setq state 5))
- (:question (setq state 7))
- (:hash (setq state 8))
- (:slash (push "/" path-components)
- (setq state 6))
- (:string (impossible))
- (:end (setq state 9))))
- (5 ;; seen [<scheme>:]//<host>:
- (ecase (read-token t)
- (:colon (failure))
- (:question (failure))
- (:hash (failure))
- (:slash (push "/" path-components)
- (setq state 6))
- (:string (setq port tokval)
- (setq state 12))
- (:end (failure))))
- (12 ;; seen [<scheme>:]//<host>:[<port>]
- (ecase (read-token t)
- (:colon (failure))
- (:question (setq state 7))
- (:hash (setq state 8))
- (:slash (push "/" path-components)
- (setq state 6))
- (:string (impossible))
- (:end (setq state 9))))
- (6 ;; seen /
- (ecase (read-token :path)
- (:question (setq state 7))
- (:hash (setq state 8))
- (:string (push tokval path-components)
- (setq state 13))
- (:end (setq state 9))))
- (13 ;; seen path
- (ecase (read-token :path)
- (:question (setq state 7))
- (:hash (setq state 8))
- (:string (impossible))
- (:end (setq state 9))))
- (7 ;; seen ?
- (setq illegal-chars
- (if* *strict-parse*
- then *strict-illegal-query-characters*
- else *illegal-query-characters*))
- (ecase (prog1 (read-token :query)
- (setq illegal-chars *illegal-characters*))
- (:hash (setq state 8))
- (:string (setq query tokval)
- (setq state 14))
- (:end (setq state 9))))
- (14 ;; query
- (ecase (read-token :query)
- (:hash (setq state 8))
- (:string (impossible))
- (:end (setq state 9))))
- (8 ;; seen #
- (ecase (read-token :rest)
- (:string (setq fragment tokval)
- (setq state 9))
- (:end (setq state 9))))
- (9 ;; done
- (return
- (values
- scheme host port
- (apply #'concatenate 'string (nreverse path-components))
- query fragment)))
- ;; URN parsing:
- (15 ;; seen urn:, read nid now
- (case (read-token :colon *valid-nid-characters*)
- (:string (setq nid tokval)
- (setq state 16))
- (t (failure "missing namespace identifier"))))
- (16 ;; seen urn:<nid>
- (case (read-token t)
- (:colon (setq state 17))
- (t (failure "missing namespace specific string"))))
- (17 ;; seen urn:<nid>:, rest is nss
- (return (values scheme
- nid
- nil
- (progn
- (setq illegal-chars *reserved-nss-characters*)
- (read-token :rest)
- tokval))))
- (t (.parse-error
- "internal error in parse engine, wrong state: ~s." state)))))))
+ (case state
+ (0 ;; starting to parse
+ (ecase (read-token t)
+ (:colon (failure))
+ (:question (setq state 7))
+ (:hash (setq state 8))
+ (:slash (setq state 3))
+ (:string (setq state 1))
+ (:end (setq state 9))))
+ (1 ;; seen <token><special char>
+ (let ((token tokval))
+ (ecase (read-token t)
+ (:colon (setq scheme token)
+ (if* (equalp "urn" scheme)
+ then (setq state 15)
+ else (setq state 2)))
+ (:question (push token path-components)
+ (setq state 7))
+ (:hash (push token path-components)
+ (setq state 8))
+ (:slash (push token path-components)
+ (push "/" path-components)
+ (setq state 6))
+ (:string (failure))
+ (:end (push token path-components)
+ (setq state 9)))))
+ (2 ;; seen <scheme>:
+ (ecase (read-token t)
+ (:colon (failure))
+ (:question (setq state 7))
+ (:hash (setq state 8))
+ (:slash (setq state 3))
+ (:string (setq state 10))
+ (:end (setq state 9))))
+ (10 ;; seen <scheme>:<token>
+ (let ((token tokval))
+ (ecase (read-token t)
+ (:colon (failure))
+ (:question (push token path-components)
+ (setq state 7))
+ (:hash (push token path-components)
+ (setq state 8))
+ (:slash (push token path-components)
+ (setq state 6))
+ (:string (failure))
+ (:end (push token path-components)
+ (setq state 9)))))
+ (3 ;; seen / or <scheme>:/
+ (ecase (read-token t)
+ (:colon (failure))
+ (:question (push "/" path-components)
+ (setq state 7))
+ (:hash (push "/" path-components)
+ (setq state 8))
+ (:slash (setq state 4))
+ (:string (push "/" path-components)
+ (push tokval path-components)
+ (setq state 6))
+ (:end (push "/" path-components)
+ (setq state 9))))
+ (4 ;; seen [<scheme>:]//
+ (ecase (read-token t)
+ (:colon (failure))
+ (:question (failure))
+ (:hash (failure))
+ (:slash
+ (if* (and (equalp "file" scheme)
+ (null host))
+ then ;; file:///...
+ (push "/" path-components)
+ (setq state 6)
+ else (failure)))
+ (:string (setq host tokval)
+ (setq state 11))
+ (:end (failure))))
+ (11 ;; seen [<scheme>:]//<host>
+ (ecase (read-token t)
+ (:colon (setq state 5))
+ (:question (setq state 7))
+ (:hash (setq state 8))
+ (:slash (push "/" path-components)
+ (setq state 6))
+ (:string (impossible))
+ (:end (setq state 9))))
+ (5 ;; seen [<scheme>:]//<host>:
+ (ecase (read-token t)
+ (:colon (failure))
+ (:question (failure))
+ (:hash (failure))
+ (:slash (push "/" path-components)
+ (setq state 6))
+ (:string (setq port tokval)
+ (setq state 12))
+ (:end (failure))))
+ (12 ;; seen [<scheme>:]//<host>:[<port>]
+ (ecase (read-token t)
+ (:colon (failure))
+ (:question (setq state 7))
+ (:hash (setq state 8))
+ (:slash (push "/" path-components)
+ (setq state 6))
+ (:string (impossible))
+ (:end (setq state 9))))
+ (6 ;; seen /
+ (ecase (read-token :path)
+ (:question (setq state 7))
+ (:hash (setq state 8))
+ (:string (push tokval path-components)
+ (setq state 13))
+ (:end (setq state 9))))
+ (13 ;; seen path
+ (ecase (read-token :path)
+ (:question (setq state 7))
+ (:hash (setq state 8))
+ (:string (impossible))
+ (:end (setq state 9))))
+ (7 ;; seen ?
+ (setq illegal-chars
+ (if* *strict-parse*
+ then *strict-illegal-query-characters*
+ else *illegal-query-characters*))
+ (ecase (prog1 (read-token :query)
+ (setq illegal-chars *illegal-characters*))
+ (:hash (setq state 8))
+ (:string (setq query tokval)
+ (setq state 14))
+ (:end (setq state 9))))
+ (14 ;; query
+ (ecase (read-token :query)
+ (:hash (setq state 8))
+ (:string (impossible))
+ (:end (setq state 9))))
+ (8 ;; seen #
+ (ecase (read-token :rest)
+ (:string (setq fragment tokval)
+ (setq state 9))
+ (:end (setq state 9))))
+ (9 ;; done
+ (return
+ (values
+ scheme host port
+ (apply #'concatenate 'string (nreverse path-components))
+ query fragment)))
+ ;; URN parsing:
+ (15 ;; seen urn:, read nid now
+ (case (read-token :colon *valid-nid-characters*)
+ (:string (setq nid tokval)
+ (setq state 16))
+ (t (failure "missing namespace identifier"))))
+ (16 ;; seen urn:<nid>
+ (case (read-token t)
+ (:colon (setq state 17))
+ (t (failure "missing namespace specific string"))))
+ (17 ;; seen urn:<nid>:, rest is nss
+ (return (values scheme
+ nid
+ nil
+ (progn
+ (setq illegal-chars *reserved-nss-characters*)
+ (read-token :rest)
+ tokval))))
+ (t (.parse-error
+ "internal error in parse engine, wrong state: ~s." state)))))))