Commits

Anonymous committed 1d23034

Reorganized by defining all classes as early as possible.

  • Participants
  • Parent commits fa80637

Comments (0)

Files changed (6)

 
 ;; Classes + types
 
-(defclass production ()
-  ((rule-name :initarg :rule)
-   (rhs :initarg :rhs)))
+;; printing
 
 (defmethod print-object ((obj production) stream)
   (print-unreadable-object (obj stream :type t :identity t)
     (with-slots (rule-name rhs) obj
       (format stream "Rule=~s RHS=~s" rule-name rhs))))
 
-(defclass lr1-item ()
-  ((position :initarg :position)
-   (lookahead :initarg :lookahead )
-   (production :initarg :production)))
-
-(defclass lr1-state ()
-  ((items :initarg :items :accessor items)
-   (exits :initform (make-hash-table) :accessor exits
-	  :documentation "Contains a mapping between symbols and integers representing the next state 
-                          after encountering the symbol")))
-
-(defclass lr-parse-table ()
-  ((number-of-states :initarg :states :accessor number-of-states)
-   (entries :initform (make-hash-table :test #'equal) :accessor entries))) 
-
 (defmethod print-object ((obj lr-parse-table) stream)
   (print-unreadable-object (obj stream :type t :identity t)
     (format stream "Max states=~a~%" (number-of-states obj))
 	    (loop for k being the hash-keys of (entries obj)
 		 append (list k (gethash k (entries obj)))))))
 
-(defclass lalr1-grammar ()
-  ((specification :initarg :specification :accessor specification)
-   (states :initarg :states :accessor states)
-   (actions :initarg :actions :accessor actions)
-   (gotos :initarg :gotos :accessor gotos)))
+(defmethod print-object ((obj lr1-item) stream)
+  (print-unreadable-object (obj stream :type t :identity t)
+    (with-slots (position lookahead production) obj
+      (format stream "Position=~a Lookahead=~s Production=~s" position lookahead production))))
+
+;; equality
 
 (defgeneric equal-items (left right)
   (:method ((left production) (right production))
   (:method ((left t) (right t))
     (equal left right)))
 
-(defmethod print-object ((obj lr1-item) stream)
-  (print-unreadable-object (obj stream :type t :identity t)
-    (with-slots (position lookahead production) obj
-      (format stream "Position=~a Lookahead=~s Production=~s" position lookahead production))))
+;; specifications
 
 (defun rule-productions (rule)
   (destructuring-bind (rule-name &rest rhss) rule
   :serial t
   :components (
                (:file "package-hh-parse")
+	       (:file "types")
 	       (:file "lexer")
 	       (:file "grammar")
 	       (:file "parser")
 
 ;; ---------------------------------------------------------------------------------------------------------------------
 ;;
-;;  Classes + types
+;;  Conditions
 ;;
 ;; ---------------------------------------------------------------------------------------------------------------------
 
-(defclass lexer ()
-  ((source :initarg :source :accessor source)
-   (position :initform (make-instance 'source-code-position) :initarg :position :accessor parse-position)
-   (state :initform :any :accessor state)))
-
 (define-condition lexer-error (error)
   ((lexer :initarg :lexer :accessor lexer)
    (unexpected-character :initform nil :initarg :character :accessor unexpected-character))
 ;; ---------------------------------------------------------------------------------------------------------------------
 ;; LALR(1) parser construction
 
-;; Classes + types
-
-(defclass lalr1-parser ()
-  ((grammar :initarg :grammar :accessor grammar)
-   (lexer :initarg :lexer :accessor lexer)
-   (stack :initform () :accessor stack)))
-
-
 ;; Source code helper
 (defmethod source-text ((parser lalr1-parser))
   (source-text (lexer parser)))
       (declare (ignore stack-state))
       stack-token)))
 
-(defun parse-input (parser)
+(defun parse-input (parser &optional input)
   (let ((lexer (lexer parser)))
+    (when input (setf (source-text lexer) input))
     (loop for result = (parse-token parser (next-token lexer))
        while (equal :continue result)
        finally (return (values result (get-parse-result parser))))))
 
 ;; =====================================================================================================================
 ;;
-;; Helpers
-;;
-;; =====================================================================================================================
-
-(defun make-lines ()
-  (make-array 0 :element-type 'source-code-line :adjustable t)
-  )
-
-;; =====================================================================================================================
-;;
-;; Types
-;;
-;; =====================================================================================================================
-
-(defclass source-code-line ()
-  ((parser :initform nil :initarg :parser :accessor parser-of
-	   :documentation "Parser positioned at end of the line")
-   (text :initform "" :initarg :text :accessor text-of)))
-
-(defclass source-code-position ()
-  ((line :initform 0 :initarg :line :accessor line-at)
-   (column :initform 0 :initarg :column :accessor column-at))
-  (:documentation "Represents a location within a file"))
-
-(defclass source-code-file ()
-  ((lines :initform (make-lines) :accessor lines-of)
-   (position :initform (make-instance 'source-code-position) :accessor current-position))
-  (:documentation "Represents the state of a file being edited or parsed"))
-
-;; =====================================================================================================================
-;;
 ;; Constants + globals
 ;;
 ;; =====================================================================================================================
 ;;
 ;; =====================================================================================================================
 
+(define-test source-text-tests 
+  (let ((text "<foo bar=1>borp whaple</foo>"))
+
+    (let ((lexer (make-instance 'html-lexer)))
+      (setf (source-text lexer) text)
+
+      (assert-equal (source-text (hh-parse::source lexer)) text))
+
+    (let* ((grammar (html-grammar))
+	   (lexer (make-instance 'html-lexer))
+	   (parser (make-parser lexer grammar)))
+      (setf (source-text parser) text)
+
+      (assert-equal (source-text (hh-parse::source (hh-parse::lexer parser))) text))
+
+    ))
+
 (define-test html-parsing-tests
     (let* ((grammar (html-grammar))
 	   (source (make-source "<foo bar=1>borp whaple</foo>"))