Corrected some bugs.

Pascal J. Bourguignon [2013-06-28 18:31]
Corrected some bugs.
Filename
common-lisp/cesarum/utility.lisp
languages/linc/linc.lisp
diff --git a/common-lisp/cesarum/utility.lisp b/common-lisp/cesarum/utility.lisp
index 5416a87..012772d 100644
--- a/common-lisp/cesarum/utility.lisp
+++ b/common-lisp/cesarum/utility.lisp
@@ -538,6 +538,7 @@ DO:     Define a class implementing the structure API.
              conc-name constructors copier
              include initial-offset predicate
              print-function print-object)
+    (declare (ignorable initial-offset))
     (if (symbolp name-and-options)
         (setf name    name-and-options
               options nil)
@@ -838,6 +839,54 @@ RETURN: -1 if N is negative,
        (let ((,(car store-vars) (mod (- ,reader-form ,decrement) ,modulo)))
          ,writer-form))))

+;; (defun generate-distinct-float-type-typecase (operator expresion clauses)
+;;
+;;   )
+;;
+;; (defun type-equal-p (t1 t2)
+;;   (and (subtypep t1) (subtypep t2)))
+;;
+;; (defun distinct-float-types ()
+;;   "
+;;
+;; RETURN: a subset of (long-float double-float single-float short-float)
+;; that represents the partition of the float type for this
+;; implementation.
+;;
+;; There can be fewer than four internal representations for floats. If there are fewer distinct representations, the
+;; following rules apply:
+;;
+;;   • If there is only one, it is the type single-float. In this
+;;     representation, an object is simultaneously of types single-float,
+;;     double-float, short-float, and long-float.
+;;
+;;   • Two internal representations can be arranged in either of the
+;;     following ways:
+;;
+;;       □ Two types are provided: single-float and short-float. An
+;;         object is simultaneously of types single-float,  double-float,
+;;         and long-float.
+;;
+;;       □ Two types are provided: single-float and double-float. An
+;;         object is simultaneously of types single-float and
+;;         short-float, or double-float and long-float.
+;;
+;;   • Three internal representations can be arranged in either of the
+;;     following ways:
+;;
+;;       □ Three types are provided: short-float, single-float, and
+;;         double-float. An object can simultaneously be of  type
+;;         double-float and long-float.
+;;
+;;       □ Three types are provided: single-float, double-float, and
+;;         long-float. An object can simultaneously be of  types
+;;         single-float and short-float.
+;;
+;; "
+;;   ;; We process them in preference order
+;;   (loop :for type :in '(double-float single-float long-float short-float))
+;;
+;;   )

 (defun +epsilon (float)
   "Returns the float incremented by the smallest increment possible."
diff --git a/languages/linc/linc.lisp b/languages/linc/linc.lisp
index 11ba7ed..6ca7f4e 100644
--- a/languages/linc/linc.lisp
+++ b/languages/linc/linc.lisp
@@ -137,6 +137,8 @@


 (defgeneric generate-expression (expression))
+(defgeneric generate-statement (expression &key same-line))
+(defgeneric generate-identifier (expression))

 ;; (defun generate-expression (expr &key (level 99 levelp) (naked t))
 ;;   ;;   (+ a (* b c))    (10 16 (11 16 16))
@@ -760,29 +762,34 @@ RETURN:  A destructuring-lambda-list; a literal a-list ; a variable a-list.
       (let ((var (gensym)))
         (values var (list (cons var pattern)) nil))))))

-;; TODO: handle declarations.
 (defmacro pcond (expression &rest clauses)
+  ;; The pattern variable are declared ignorable since depending on
+  ;; the compiler, they may or may not used by potentially dead code.
   (let ((vexpression (gensym)))
     `(let ((,vexpression ,expression))
        (cond
          ,@(mapcar
             (lambda (clause)
-                (multiple-value-bind (dll sal val)
-                    (pcond-substitute-literals (first clause))
-                  `((let ,(mapcar (function cdr) val)
-                      (when (ignore-errors
-                              (destructuring-bind ,dll ,vexpression
-                                (when (and
-                                       ,@(mapcar
-                                          (lambda (binding)
+              (multiple-value-bind (docstrings declarations body) (parse-body :locally (rest clause))
+                (declare (ignore docstrings))
+                (multiple-value-bind (dll sal val) (pcond-substitute-literals (first clause))
+                  (let ((variables (mapcar (function cdr) val)))
+                    `((let ,variables
+                        (declare (ignorable ,@variables))
+                        ,@declarations
+                        (when (ignore-errors
+                                (destructuring-bind ,dll ,vexpression
+                                  (when (and
+                                         ,@(mapcar
+                                            (lambda (binding)
                                               `(equal ,(car binding) ',(cdr binding)))
-                                          sal))
-                                  (setf ,@(mapcan
-                                           (lambda (binding)
+                                            sal))
+                                    (setf ,@(mapcan
+                                             (lambda (binding)
                                                (list (cdr binding) (car binding)))
-                                           val))
-                                  t)))
-                        ,@(rest clause))))))
+                                             val))
+                                    t)))
+                          ,@body)))))))
             clauses)))))

 ;; ;;
@@ -946,7 +953,6 @@ RETURN:  A destructuring-lambda-list; a literal a-list ; a variable a-list.
      (emit :newline))

     ((&whole ?everything &rest ?anything)
-     (declare (ignore ?anything))
      (error "Not a declaration: ~S" ?everything))))

ViewGit