Corrections.

Pascal J. Bourguignon [2013-06-25 20:06]
Corrections.
Filename
common-lisp/data-encoding/data-encoding.lisp
rdp/example-lisp.lisp
rdp/rdp-basic-gen.lisp
diff --git a/common-lisp/data-encoding/data-encoding.lisp b/common-lisp/data-encoding/data-encoding.lisp
index 96a7e5b..fe23e5c 100644
--- a/common-lisp/data-encoding/data-encoding.lisp
+++ b/common-lisp/data-encoding/data-encoding.lisp
@@ -322,18 +322,18 @@ License:
   (:documentation "A binary-coded-decimal signed integer type."))


-((defmethod initialize-instance ((self binary-coded-decimal-integer-enctype) &rest args)
-     (declare (ignore args))
-   (call-next-method)
-   (setf (modulo self) (expt 10 (number-of-digit self)))
-   self) ;;initialize-instance
+(defmethod initialize-instance ((self binary-coded-decimal-integer-enctype) &rest args)
+  (declare (ignore args))
+  (call-next-method)
+  (setf (modulo self) (expt 10 (number-of-digit self)))
+  self) ;;initialize-instance



- defmethod print-object ((self binary-coded-decimal-integer-enctype) out)
- (print-unreadable-object (self out :type t)
-   (format out "~D-DIGITS, ~A-ENDIAN" (number-of-digit self) (endian self)))
- self)
+(defmethod print-object ((self binary-coded-decimal-integer-enctype) out)
+  (print-unreadable-object (self out :type t)
+    (format out "~D-DIGITS, ~A-ENDIAN" (number-of-digit self) (endian self)))
+  self)


 (defmethod to-lisp-type    ((self binary-coded-decimal-integer-enctype))
diff --git a/rdp/example-lisp.lisp b/rdp/example-lisp.lisp
index 27480c0..b1ac2b0 100644
--- a/rdp/example-lisp.lisp
+++ b/rdp/example-lisp.lisp
@@ -111,8 +111,9 @@



-(assert (equal (com.informatimago.rdp.example:parse-example
-                "
+(assert (equal
+         (com.informatimago.rdp.example:parse-example
+          "
     const abc = 123,
           pi=3.141592e+0;
     var a,b,c;
@@ -130,19 +131,20 @@ begin
     call gcd
 end.")

-               '(block (((ident "abc" 14) (integer "123" 20)) ((ident "pi" 13) (real "3.141592e+0" 25)))
-                 ((ident "a" 10) (ident "b" 12) (ident "c" 14))
-                 ((procedure (ident "gcd" 18)
-                   (block nil
-                     nil
-                     nil
-                     ((((while ((#1="#" #1# 18) (+ ((ident "a" 16))) (+ ((ident "b" 20))))
-                          ((((if ((#2="<" #2# 19) (+ ((ident "a" 18))) (+ ((ident "b" 20))))
-                                 ((setf (ident "b" 27) (+ ((ident "b" 30)) ((#3="-" #3# 31) ((ident "a" 32))))))))
-                            ((if ((#4=">" #4# 19) (+ ((ident "a" 18))) (+ ((ident "b" 20))))
-                                 ((setf (ident "a" 27) (+ ((ident "a" 30)) ((#5="-" #5# 31) ((ident "b" 32)))))))))))))))))
-                 ((((setf (ident "a" 6) (+ ((integer "42" 10))))) ((setf (ident "b" 6) (+ ((real "30.0" 12)))))
-                   ((call (ident "gcd" 13))))))))
+
+         '(block (((ident "abc" 14) (integer "123" 20)) ((ident "pi" 13) (real "3.141592e+0" 25)))
+           ((ident "a" 10) (ident "b" 12) (ident "c" 14))
+           ((procedure (ident "gcd" 18)
+             (block nil
+               nil
+               nil
+               ((((while ((#1="#" #1# 18) (+ ((ident "a" 16))) (+ ((ident "b" 20))))
+                    ((((if ((#2="<" #2# 19) (+ ((ident "a" 18))) (+ ((ident "b" 20))))
+                           ((setf (ident "b" 27) (+ ((ident "b" 30)) ((#3="-" #3# 31) ((ident "a" 32))))))))
+                      ((if ((#4=">" #4# 19) (+ ((ident "a" 18))) (+ ((ident "b" 20))))
+                           ((setf (ident "a" 27) (+ ((ident "a" 30)) ((#5="-" #5# 31) ((ident "b" 32)))))))))))))))))
+           ((((setf (ident "a" 6) (+ ((integer "42" 10))))) ((setf (ident "b" 6) (+ ((real "30.0" 12)))))
+             ((call (ident "gcd" 13))))))))



@@ -209,62 +211,64 @@ begin
     b:=30.0;
     call gcd
 end.")
+

                '(program
                  (block
-                     (("const" "const" 5) (ident "abc" 11) ("=" "=" 15) (number (integer "123" 17))
-                      ((("," "," 20) (ident "pi" 32) ("=" "=" 34) (number (real "3.141592e+0" 35)))) (";" ";" 46))
-                   (("var" "var" 53) (ident "a" 57) ((("," "," 58) (ident "b" 59)) (("," "," 60) (ident "c" 61)))
-                    (";" ";" 62))
-                   ((("procedure" "procedure" 69) (ident "gcd" 79) (";" ";" 82)
+                     ((#1="const" #1# 10) (ident "abc" 14) (#2="=" #2# 16) (number (integer "123" 20))
+                      (((#3="," #3# 21) (ident "pi" 13) (#4="=" #4# 14) (number (real "3.141592e+0" 25)))) (#5=";" #5# 26))
+                   ((#6="var" #6# 8) (ident "a" 10) (((#7="," #7# 11) (ident "b" 12)) ((#8="," #8# 13) (ident "c" 14)))
+                    (#9=";" #9# 15))
+                   (((#10="procedure" #10# 14) (ident "gcd" 18) (#11=";" #11# 19)
                      (block nil
                        nil
                        nil
                        (statement
-                        (("begin" "begin" 89)
-                         (statement
-                          (("while" "while" 104)
-                           (condition
-                            ((expression nil (term (factor (ident "a" 110)) nil) nil) ("#" "#" 112)
-                             (expression nil (term (factor (ident "b" 114)) nil) nil)))
-                           ("do" "do" 116)
-                           (statement
-                            (("begin" "begin" 128)
+                        (((#12="begin" #12# 10)
+                          (statement
+                           (((#13="while" #13# 14)
+                             (condition
+                              ((expression nil (term (factor (ident "a" 16)) nil) nil) (#14="#" #14# 18)
+                               (expression nil (term (factor (ident "b" 20)) nil) nil)))
+                             (#15="do" #15# 23)
                              (statement
-                              (("if" "if" 147)
-                               (condition
-                                ((expression nil (term (factor (ident "a" 150)) nil) nil) ("<" "<" 151)
-                                 (expression nil (term (factor (ident "b" 152)) nil) nil)))
-                               ("then" "then" 154)
-                               (statement
-                                ((ident "b" 159) (":=" ":=" 160)
-                                 (expression nil (term (factor (ident "b" 162)) nil)
-                                             ((("-" "-" 163) (term (factor (ident "a" 164)) nil))))))))
-                             (((";" ";" 166)
-                               (statement
-                                (("if" "if" 182)
-                                 (condition
-                                  ((expression nil (term (factor (ident "a" 185)) nil) nil) (">" ">" 186)
-                                   (expression nil (term (factor (ident "b" 187)) nil) nil)))
-                                 ("then" "then" 189)
-                                 (statement
-                                  ((ident "a" 194) (":=" ":=" 195)
-                                   (expression nil (term (factor (ident "a" 197)) nil)
-                                               ((("-" "-" 198) (term (factor (ident "b" 199)) nil))))))))))
-                             ("end" "end" 210)))))
-                         nil ("end" "end" 219))))
-                     (";" ";" 222)))
+                              (((#16="begin" #16# 14)
+                                (statement
+                                 (((#17="if" #17# 16)
+                                   (condition
+                                    ((expression nil (term (factor (ident "a" 18)) nil) nil) (#18="<" #18# 19)
+                                     (expression nil (term (factor (ident "b" 20)) nil) nil)))
+                                   (#19="then" #19# 25)
+                                   (statement
+                                    (((ident "b" 27) (#20=":=" #20# 29)
+                                      (expression nil (term (factor (ident "b" 30)) nil)
+                                                  (((#21="-" #21# 31) (term (factor (ident "a" 32)) nil))))))))))
+                                (((#22=";" #22# 34)
+                                  (statement
+                                   (((#23="if" #23# 16)
+                                     (condition
+                                      ((expression nil (term (factor (ident "a" 18)) nil) nil) (#24=">" #24# 19)
+                                       (expression nil (term (factor (ident "b" 20)) nil) nil)))
+                                     (#25="then" #25# 25)
+                                     (statement
+                                      (((ident "a" 27) (#26=":=" #26# 29)
+                                        (expression nil (term (factor (ident "a" 30)) nil)
+                                                    (((#27="-" #27# 31) (term (factor (ident "b" 32)) nil))))))))))))
+                                (#28="end" #28# 12)))))))
+                          nil (#29="end" #29# 8)))))
+                     (#30=";" #30# 9)))
                    (statement
-                    (("begin" "begin" 224)
-                     (statement
-                      ((ident "a" 235) (":=" ":=" 236) (expression nil (term (factor (number (integer "42" 238))) nil) nil)))
-                     (((";" ";" 240)
-                       (statement
-                        ((ident "b" 246) (":=" ":=" 247)
-                         (expression nil (term (factor (number (real "30.0" 249))) nil) nil))))
-                      ((";" ";" 253) (statement (("call" "call" 259) (ident "gcd" 264)))))
-                     ("end" "end" 268))))
-                 ("." "." 271))))
+                    (((#31="begin" #31# 6)
+                      (statement
+                       (((ident "a" 6) (#32=":=" #32# 8)
+                         (expression nil (term (factor (number (integer "42" 10))) nil) nil))))
+                      (((#33=";" #33# 11)
+                        (statement
+                         (((ident "b" 6) (#34=":=" #34# 8)
+                           (expression nil (term (factor (number (real "30.0" 12))) nil) nil)))))
+                       ((#35=";" #35# 13) (statement (((#36="call" #36# 9) (ident "gcd" 13))))))
+                      (#37="end" #37# 4)))))
+                 (#38="." #38# 5))))


 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/rdp/rdp-basic-gen.lisp b/rdp/rdp-basic-gen.lisp
index be07068..167029b 100644
--- a/rdp/rdp-basic-gen.lisp
+++ b/rdp/rdp-basic-gen.lisp
@@ -192,7 +192,7 @@
   (if (atom item)
       (if (terminalp grammar item)
           `(emit "TOKEN$=~S : CALL ACCEPT" ',(string item))
-          (let* ((firsts (first-rhs grammar item))
+          (let* ((firsts (first-set grammar item))
                  (emptyp (member nil firsts)))
             `(progn
                (emit "IF ~A THEN" ',(gen-in-firsts target (remove nil firsts)))
@@ -227,7 +227,7 @@
            `(progn
               (emit "L~DRES=NIL" ,lex)
               (emit "WHILE ~A"
-                    ',(gen-in-firsts target (first-rhs grammar (second item))))
+                    ',(gen-in-firsts target (first-set grammar (second item))))
               ,(gen-parsing-statement target grammar (second item))
               (emit "NCAR=RET:NCDR=L~DRES:CALL CONS:L~DRES=RES" ,lex ,lex)
               (emit "ENDWHILE")
@@ -237,7 +237,7 @@
            `(progn
               (emit "L~DRES=NIL" ,lex)
               (emit "IF ~A THEN"
-                    ',(gen-in-firsts target (first-rhs grammar (second item))))
+                    ',(gen-in-firsts target (first-set grammar (second item))))
               ,(gen-parsing-statement target grammar (second item))
               (emit "ELSE")
               (emit "  RES=NIL")
@@ -250,8 +250,7 @@
                            (emit "STOP"))
                         `(progn
                            (emit "IF ~A THEN"
-                                 ',(gen-in-firsts target
-                                                  (first-rhs grammar (car items))))
+                                 ',(gen-in-firsts target (first-set grammar (car items))))
                            ,(gen-parsing-statement target grammar (car items))
                            (emit "ELSE")
                            ,(gen (cdr items))
ViewGit