src/: Enhance `definst' to allow general BVL syntax.

Allow the `alt' argument for `if' to be &optional, and omit it when it's
not interesting.

Allow the `init' argument for `var' to be &optional, and omit it when
it's not interesting.

Make the `args' argument for `call' be &rest.  This isn't a win right
now, but it will be later.

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index 226ab387a3c090f2922753520ba29c2ca2c77b52..5ee51b38b6e18d5f779b8a1ce88f2afc281151a6 100644 (file)
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -320,30 +320,17 @@ classes.lisp
   sod-slot-type                                 generic
 
 codegen-impl.lisp
   sod-slot-type                                 generic
 
 codegen-impl.lisp

-  call-inst                                     class

   codegen                                       class
   codegen                                       class

-  do-while-inst                                 class
-  if-inst                                       class
-  inst-alt                                      generic
-  inst-args                                     generic
-  inst-body                                     generic
-  inst-cond                                     generic
-  inst-conseq                                   generic
-  inst-func                                     generic
-  make-call-inst                                function
-  make-do-while-inst                            function
-  make-if-inst                                  function
-  make-while-inst                               function

   temporary-argument                            class
   temporary-function                            function class
   temporary-variable                            class
   temporary-argument                            class
   temporary-function                            function class
   temporary-variable                            class

-  while-inst                                    class

 
 codegen-proto.lisp
   *sod-ap*                                      variable
   *sod-master-ap*                               variable
   block-inst                                    class
   break-inst                                    class
 
 codegen-proto.lisp
   *sod-ap*                                      variable
   *sod-master-ap*                               variable
   block-inst                                    class
   break-inst                                    class

+  call-inst                                     class

   codegen-add-function                          generic
   codegen-build-function                        function
   codegen-functions                             generic setf
   codegen-add-function                          generic
   codegen-build-function                        function
   codegen-functions                             generic setf


@@ -356,6 +343,7 @@ codegen-proto.lisp
   definst                                       macro
   deliver-call                                  function
   deliver-expr                                  function
   definst                                       macro
   deliver-call                                  function
   deliver-expr                                  function

+  do-while-inst                                 class

   emit-decl                                     generic
   emit-decls                                    generic
   emit-inst                                     generic
   emit-decl                                     generic
   emit-decls                                    generic
   emit-inst                                     generic


@@ -365,10 +353,16 @@ codegen-proto.lisp
   format-compound-statement                     macro
   format-temporary-name                         generic
   function-inst                                 class
   format-compound-statement                     macro
   format-temporary-name                         generic
   function-inst                                 class

+  if-inst                                       class

   inst                                          class
   inst                                          class

+  inst-alt                                      generic
+  inst-args                                     generic

   inst-body                                     generic
   inst-body                                     generic

+  inst-cond                                     generic
+  inst-conseq                                   generic

   inst-decls                                    generic
   inst-expr                                     generic
   inst-decls                                    generic
   inst-expr                                     generic

+  inst-func                                     generic

   inst-init                                     generic
   inst-metric                                   generic
   inst-name                                     generic
   inst-init                                     generic
   inst-metric                                   generic
   inst-name                                     generic


@@ -377,13 +371,17 @@ codegen-proto.lisp
   inst-var                                      generic
   make-block-inst                               function
   make-break-inst                               function
   inst-var                                      generic
   make-block-inst                               function
   make-break-inst                               function

+  make-call-inst                                function

   make-continue-inst                            function
   make-continue-inst                            function

+  make-do-while-inst                            function

   make-expr-inst                                function
   make-function-inst                            function
   make-expr-inst                                function
   make-function-inst                            function

+  make-if-inst                                  function

   make-return-inst                              function
   make-set-inst                                 function
   make-update-inst                              function
   make-var-inst                                 function
   make-return-inst                              function
   make-set-inst                                 function
   make-update-inst                              function
   make-var-inst                                 function

+  make-while-inst                               function

   return-inst                                   class
   set-inst                                      class
   temp-tag                                      generic
   return-inst                                   class
   set-inst                                      class
   temp-tag                                      generic


@@ -392,6 +390,7 @@ codegen-proto.lisp
   update-inst                                   class
   var-in-use-p                                  generic setf
   var-inst                                      class
   update-inst                                   class
   var-in-use-p                                  generic setf
   var-inst                                      class

+  while-inst                                    class

   with-temporary-var                            macro
 
 final.lisp
   with-temporary-var                            macro
 
 final.lisp

diff --git a/doc/clang.tex b/doc/clang.tex
index 58b8cd22e904d67dea1f71b46ac1d652d9fe849a..f5b16a87ca7fc4d33b905eb82880c5b0f925eb01 100644 (file)
--- a/doc/clang.tex
+++ b/doc/clang.tex
@@ -892,7 +892,8 @@ Temporary names are represented by objects which implement a simple protocol.
     \thd{Class name} &
     \thd{Arguments} &
     \thd{Output format}                                         \\ \hlx{vhv}
     \thd{Class name} &
     \thd{Arguments} &
     \thd{Output format}                                         \\ \hlx{vhv}

-    @|var|      & @<name> @<type> @<init>  & @<type> @<name> @[= @<init>@];
+    @|var|      & @<name> @<type> @|\&optional| @<init>
+                                           & @<type> @<name> @[= @<init>@];

                                                                 \\ \hlx{v}
     @|set|      & @<var> @<expr>           & @<var> = @<expr>;  \\ \hlx{v}
     @|update|   & @<var> @<op> @<expr>     & @<var> @<op>= @<expr>;
                                                                 \\ \hlx{v}
     @|set|      & @<var> @<expr>           & @<var> = @<expr>;  \\ \hlx{v}
     @|update|   & @<var> @<op> @<expr>     & @<var> @<op>= @<expr>;


@@ -902,21 +903,23 @@ Temporary names are represented by objects which implement a simple protocol.
     @|break|    & ---                      & break;             \\ \hlx{v}
     @|continue| & ---                      & continue;          \\ \hlx{v}
     @|expr|     & @<expr>                  & @<expr>;           \\ \hlx{v}
     @|break|    & ---                      & break;             \\ \hlx{v}
     @|continue| & ---                      & continue;          \\ \hlx{v}
     @|expr|     & @<expr>                  & @<expr>;           \\ \hlx{v}

-    @|call|     & @<func> @<args>          & @<func>(@<arg>_1,
+    @|call|     & @<func> @|\&rest| @<args>
+                                           & @<func>(@<arg>_1,

                                                      $\ldots$,
                                                      @<arg>_n)  \\ \hlx{vhv}
     @|block|    & @<decls> @<body>         & \{ @[@<decls>@] @<body> \}
                                                                 \\ \hlx{v}
                                                      $\ldots$,
                                                      @<arg>_n)  \\ \hlx{vhv}
     @|block|    & @<decls> @<body>         & \{ @[@<decls>@] @<body> \}
                                                                 \\ \hlx{v}

-    @|if|       & @<cond> @<conseq> @<alt> & if (@<cond>) @<conseq>
+    @|if|       & @<cond> @<conseq> @|\&optional| @<alt>
+                                           & if (@<cond>) @<conseq>

                                              @[else @<alt>@]    \\ \hlx{v}
     @|while|    & @<cond> @<body>          & while (@<cond>) @<body>
                                                                 \\ \hlx{v}
     @|do-while| & @<body> @<cond>          & do @<body> while (@<cond>);
                                                                 \\ \hlx{v}
     @|function| & @<name> @<type> @<body>  &
                                              @[else @<alt>@]    \\ \hlx{v}
     @|while|    & @<cond> @<body>          & while (@<cond>) @<body>
                                                                 \\ \hlx{v}
     @|do-while| & @<body> @<cond>          & do @<body> while (@<cond>);
                                                                 \\ \hlx{v}
     @|function| & @<name> @<type> @<body>  &

-      @<type>_0 @<name>(@<type>_1 @<arg>_1, $\ldots$,
-                             @<type>_n @<arg>_n @[, \dots@])
-        @<body>                                                 \\ \hlx*{vh}
+      \vtop{\hbox{\strut @<type>_0 @<name>(@<type>_1 @<arg>_1, $\ldots$,
+                                           @<type>_n @<arg>_n @[, \dots@])}
+            \hbox{\strut \quad @<body>}}                        \\ \hlx*{vh}

   \end{tabular}
   \caption{Instruction classes}
   \label{tab:codegen.codegen.insts}
   \end{tabular}
   \caption{Instruction classes}
   \label{tab:codegen.codegen.insts}

diff --git a/doc/list-exports.lisp b/doc/list-exports.lisp
index 598d1c748361db7c3e8ed2a5720e806b377c437e..34b149799ee8d116c6c2087ef6b95ca07c7749ef 100644 (file)
--- a/doc/list-exports.lisp
+++ b/doc/list-exports.lisp
@@ -28,8 +28,12 @@ (defmethod form-list-exports ((head (eql 'sod:definst)) tail)
     (and export
         (list* (symbolicate code '-inst)
                (symbolicate 'make- code '-inst)
     (and export
         (list* (symbolicate code '-inst)
                (symbolicate 'make- code '-inst)

-               (mapcar (lambda (arg)
-                         (symbolicate 'inst- arg))
+               (mapcan (lambda (arg)
+                         (let ((sym (if (listp arg) (car arg) arg)))
+                           (cond ((char= (char (symbol-name sym) 0) #\&)
+                                  nil)
+                                 (t
+                                  (list (symbolicate 'inst- sym))))))

                        args)))))
 
 (defmethod form-list-exports ((head (eql 'sod::define-tagged-type)) tail)
                        args)))))
 
 (defmethod form-list-exports ((head (eql 'sod::define-tagged-type)) tail)

diff --git a/src/codegen-impl.lisp b/src/codegen-impl.lisp
index 0dba2c17fac7824a877f8f3d56da3c7f03f6a9e0..84bdd1865ab82be51c303dad90bd3f405257789f 100644 (file)
--- a/src/codegen-impl.lisp
+++ b/src/codegen-impl.lisp
@@ -161,7 +161,7 @@ (defmethod temporary-var ((codegen basic-codegen) type)
                                    :in-use-p t
                                    :tag (prog1 temp-index
                                           (incf temp-index)))))
                                    :in-use-p t
                                    :tag (prog1 temp-index
                                           (incf temp-index)))))

-         (push (make-var-inst name type nil) vars)
+         (push (make-var-inst name type) vars)

          name))))
 
 ;;;----- That's all, folks --------------------------------------------------
          name))))
 
 ;;;----- That's all, folks --------------------------------------------------

diff --git a/src/codegen-proto.lisp b/src/codegen-proto.lisp
index 264fd03cb930084c0b632dab505ab69111ab820a..4bfaeca68a8c8df18112ae41a52342e5129c5d85 100644 (file)
--- a/src/codegen-proto.lisp
+++ b/src/codegen-proto.lisp
@@ -124,8 +124,8 @@ (defmacro definst (code (streamvar &key export) args &body body)
      * Instance slots named after the ARGS, with matching keyword initargs,
        and `inst-ARG' readers.
 
      * Instance slots named after the ARGS, with matching keyword initargs,
        and `inst-ARG' readers.
 

-     * A constructor `make-CODE-inst' which accepts the ARGS (in order, not
-       with keywords) as arguments and returns a fresh instance.
+     * A constructor `make-CODE-inst' which accepts the ARGS (as an ordinary
+       BVL) as arguments and returns a fresh instance.

 
      * A print method, which prints a diagnostic dump if `*print-escape*' is
        set, or invokes the BODY (with STREAMVAR bound to the output stream)
 
      * A print method, which prints a diagnostic dump if `*print-escape*' is
        set, or invokes the BODY (with STREAMVAR bound to the output stream)


@@ -135,32 +135,41 @@ (defmacro definst (code (streamvar &key export) args &body body)
    If EXPORT is non-nil, then export the `CODE-inst' and `make-CODE-inst'
    symbols."
 
    If EXPORT is non-nil, then export the `CODE-inst' and `make-CODE-inst'
    symbols."
 

-  (let ((inst-var (gensym "INST"))
-       (class-name (symbolicate code '-inst))
-       (constructor-name (symbolicate 'make- code '-inst))
-       (keys (mapcar (lambda (arg) (intern (symbol-name arg) :keyword))
-                     args)))
+  (let* ((inst-var (gensym "INST"))
+        (class-name (symbolicate code '-inst))
+        (constructor-name (symbolicate 'make- code '-inst))
+        (slots (mapcan (lambda (arg)
+                         (if (listp arg) (list (car arg))
+                             (let ((name (symbol-name arg)))
+                               (if (and (plusp (length name))
+                                        (char/= (char name 0) #\&))
+                                   (list arg)
+                                   nil))))
+                       args))
+        (keys (mapcar (lambda (arg) (intern (symbol-name arg) :keyword))
+                      slots)))

     `(progn
        (defclass ,class-name (inst)
     `(progn
        (defclass ,class-name (inst)

-        ,(mapcar (lambda (arg key)
-                   `(,arg :initarg ,key :reader ,(symbolicate 'inst- arg)))
-                 args keys))
+        ,(mapcar (lambda (slot key)
+                   `(,slot :initarg ,key
+                           :reader ,(symbolicate 'inst- slot)))
+                 slots keys))

        (defun ,constructor-name (,@args)
        (defun ,constructor-name (,@args)

-        (make-instance ',class-name ,@(mappend #'list keys args)))
+        (make-instance ',class-name ,@(mappend #'list keys slots)))

        (defmethod inst-metric ((,inst-var ,class-name))
        (defmethod inst-metric ((,inst-var ,class-name))

-        (with-slots (,@args) ,inst-var
-          (+ 1 ,@(mapcar (lambda (arg) `(inst-metric ,arg)) args))))
+        (with-slots (,@slots) ,inst-var
+          (+ 1 ,@(mapcar (lambda (slot) `(inst-metric ,slot)) slots))))

        (defmethod print-object ((,inst-var ,class-name) ,streamvar)
        (defmethod print-object ((,inst-var ,class-name) ,streamvar)

-        (with-slots (,@args) ,inst-var
+        (with-slots (,@slots) ,inst-var

           (if *print-escape*
               (print-unreadable-object (,inst-var ,streamvar :type t)
                 (format stream "~@<~@{~S ~@_~S~^ ~_~}~:>"
           (if *print-escape*
               (print-unreadable-object (,inst-var ,streamvar :type t)
                 (format stream "~@<~@{~S ~@_~S~^ ~_~}~:>"

-                        ,@(mappend #'list keys args)))
+                        ,@(mappend #'list keys slots)))

               (block ,code ,@body))))
        ,@(and export `((export '(,class-name ,constructor-name
               (block ,code ,@body))))
        ,@(and export `((export '(,class-name ,constructor-name

-                                ,@(mapcar (lambda (arg)
-                                            (symbolicate 'inst- arg))
-                                          args)))))
+                                ,@(mapcar (lambda (slot)
+                                            (symbolicate 'inst- slot))
+                                          slots)))))

        ',code)))
 
 ;; Formatting utilities.
        ',code)))
 
 ;; Formatting utilities.


@@ -204,7 +213,7 @@ (defmacro format-compound-statement
 ;; package or the `common-lisp' package.  Use gensyms for these slot names to
 ;; prevent them from leaking.
 
 ;; package or the `common-lisp' package.  Use gensyms for these slot names to
 ;; prevent them from leaking.
 

-(definst var (stream :export t) (name #1=#:type init)
+(definst var (stream :export t) (name #1=#:type &optional init)

   (pprint-c-type #1# stream name)
   (when init
     (format stream " = ~A" init))
   (pprint-c-type #1# stream name)
   (when init
     (format stream " = ~A" init))


@@ -225,7 +234,7 @@ (definst update (stream :export t) (var op #1=#:expr)
   (format stream "~@<~A ~A= ~@_~2I~A;~:>" var op #1#))
 
 ;; Special kinds of expressions.
   (format stream "~@<~A ~A= ~@_~2I~A;~:>" var op #1#))
 
 ;; Special kinds of expressions.

-(definst call (stream :export t) (#1=#:func args)
+(definst call (stream :export t) (#1=#:func &rest args)

   (format stream "~A(~@<~{~A~^, ~_~}~:>)" #1# args))
 
 ;; Simple statements.
   (format stream "~A(~@<~{~A~^, ~_~}~:>)" #1# args))
 
 ;; Simple statements.


@@ -242,7 +251,7 @@ (definst block (stream :export t) (decls body)
   (format stream "{~:@_~@<  ~2I~@[~{~A~:@_~}~:@_~]~{~A~^~:@_~}~:>~:@_}"
          decls body))
 
   (format stream "{~:@_~@<  ~2I~@[~{~A~:@_~}~:@_~]~{~A~^~:@_~}~:>~:@_}"
          decls body))
 

-(definst if (stream :export t) (#1=#:cond conseq alt)
+(definst if (stream :export t) (#1=#:cond conseq &optional alt)

   (format-compound-statement (stream conseq alt)
     (format stream "if (~A)" #1#))
   (when alt
   (format-compound-statement (stream conseq alt)
     (format stream "if (~A)" #1#))
   (when alt


@@ -437,6 +446,6 @@ (defun convert-stmts (codegen target type func)
 (export 'deliver-call)
 (defun deliver-call (codegen target func &rest args)
   "Emit a statement to call FUNC with ARGS and deliver the result to TARGET."
 (export 'deliver-call)
 (defun deliver-call (codegen target func &rest args)
   "Emit a statement to call FUNC with ARGS and deliver the result to TARGET."

-  (deliver-expr codegen target (make-call-inst func args)))
+  (deliver-expr codegen target (apply #'make-call-inst func args)))

 
 ;;;----- That's all, folks --------------------------------------------------
 
 ;;;----- That's all, folks --------------------------------------------------

diff --git a/src/codegen-test.lisp b/src/codegen-test.lisp
index da3763b94a229f8d721577726d6ac1bc53b17e4a..68210598e638aa5a415f3cd0b89403f8acb293dd 100644 (file)
--- a/src/codegen-test.lisp
+++ b/src/codegen-test.lisp
@@ -50,7 +50,7 @@ (defun make-gcd (codegen)
     (emit-insts codegen (list (make-set-inst "u" "v")
                              (make-set-inst "v" r))))
   (emit-inst codegen (make-while-inst "v" (codegen-pop-block codegen)))
     (emit-insts codegen (list (make-set-inst "u" "v")
                              (make-set-inst "v" r))))
   (emit-inst codegen (make-while-inst "v" (codegen-pop-block codegen)))

-  (emit-inst codegen (make-if-inst "a" (make-set-inst "*a" "aa") nil))
+  (emit-inst codegen (make-if-inst "a" (make-set-inst "*a" "aa")))

   (deliver-expr codegen :return "u")
   (codegen-pop-function codegen "gcd"
                        (c-type (fun int
   (deliver-expr codegen :return "u")
   (codegen-pop-function codegen "gcd"
                        (c-type (fun int


@@ -64,7 +64,7 @@ (defun make-gcd (codegen)
                             ("a"))
        do (ensure-var codegen name c-type-int init))
   (ensure-var codegen "g" c-type-int
                             ("a"))
        do (ensure-var codegen name c-type-int init))
   (ensure-var codegen "g" c-type-int

-             (make-call-inst "gcd" (list "u" "v" "&a")))
+             (make-call-inst "gcd" "u" "v" "&a"))

   (deliver-call codegen :void "printf"
                "\"%d*%d == %d (mod %d)\\n\"" "a" "u" "g" "v")
   (deliver-expr codegen :return 0)
   (deliver-call codegen :void "printf"
                "\"%d*%d == %d (mod %d)\\n\"" "a" "u" "g" "v")
   (deliver-expr codegen :return 0)

diff --git a/src/method-aggregate.lisp b/src/method-aggregate.lisp
index c8791affff2125030214eb43e7822517bda07ace..ec0a11920400f20148fabccf8ca8c87d839bdb21 100644 (file)
--- a/src/method-aggregate.lisp
+++ b/src/method-aggregate.lisp
@@ -379,7 +379,7 @@ (define-aggregating-method-combination :min ((acc val) :codegen codegen)
   :methods (lambda (invoke)
             (funcall invoke val)
             (emit-inst codegen (make-if-inst (format nil "~A > ~A" acc val)
   :methods (lambda (invoke)
             (funcall invoke val)
             (emit-inst codegen (make-if-inst (format nil "~A > ~A" acc val)

-                                             (make-set-inst acc val) nil))))
+                                             (make-set-inst acc val)))))

 
 (define-aggregating-method-combination :max ((acc val) :codegen codegen)
   :first-method (lambda (invoke)
 
 (define-aggregating-method-combination :max ((acc val) :codegen codegen)
   :first-method (lambda (invoke)


@@ -388,7 +388,7 @@ (define-aggregating-method-combination :max ((acc val) :codegen codegen)
   :methods (lambda (invoke)
             (funcall invoke val)
             (emit-inst codegen (make-if-inst (format nil "~A < ~A" acc val)
   :methods (lambda (invoke)
             (funcall invoke val)
             (emit-inst codegen (make-if-inst (format nil "~A < ~A" acc val)

-                                             (make-set-inst acc val) nil))))
+                                             (make-set-inst acc val)))))

 
 (define-aggregating-method-combination :and ((ret) :codegen codegen)
   :around (lambda (body)
 
 (define-aggregating-method-combination :and ((ret) :codegen codegen)
   :around (lambda (body)


@@ -399,7 +399,7 @@ (define-aggregating-method-combination :and ((ret) :codegen codegen)
   :methods (lambda (invoke)
             (funcall invoke ret)
             (emit-inst codegen (make-if-inst (format nil "!~A" ret)
   :methods (lambda (invoke)
             (funcall invoke ret)
             (emit-inst codegen (make-if-inst (format nil "!~A" ret)

-                                             (make-break-inst) nil))))
+                                             (make-break-inst)))))

 
 (define-aggregating-method-combination :or ((ret) :codegen codegen)
   :around (lambda (body)
 
 (define-aggregating-method-combination :or ((ret) :codegen codegen)
   :around (lambda (body)


@@ -409,7 +409,7 @@ (define-aggregating-method-combination :or ((ret) :codegen codegen)
                       (make-do-while-inst (codegen-pop-block codegen) 0)))
   :methods (lambda (invoke)
             (funcall invoke ret)
                       (make-do-while-inst (codegen-pop-block codegen) 0)))
   :methods (lambda (invoke)
             (funcall invoke ret)

-            (emit-inst codegen (make-if-inst ret (make-break-inst) nil))))
+            (emit-inst codegen (make-if-inst ret (make-break-inst)))))

 
 ;;;--------------------------------------------------------------------------
 ;;; A customizable aggregating method combination.
 
 ;;;--------------------------------------------------------------------------
 ;;; A customizable aggregating method combination.

diff --git a/src/method-impl.lisp b/src/method-impl.lisp
index 366d1dcd8e053a3594f14e036fbf2c2b74766f76..8501a021bd9edc579f6f6108a712fdbb0e2340dd 100644 (file)
--- a/src/method-impl.lisp
+++ b/src/method-impl.lisp
@@ -443,10 +443,8 @@ (defmethod compute-method-entry-functions ((method basic-effective-method))
               ;; If this is a varargs method then we've made the
               ;; `:valist' role.  Also make the `nil' role.
               (when parm-n
               ;; If this is a varargs method then we've made the
               ;; `:valist' role.  Also make the `nil' role.
               (when parm-n

-                (let ((call (make-call-inst name
-                                            (cons "me"
-                                                  (mapcar #'argument-name
-                                                          entry-args))))
+                (let ((call (apply #'make-call-inst name "me"
+                                   (mapcar #'argument-name entry-args)))

                       (main (method-entry-function-name method head nil))
                       (main-type (c-type (fun (lisp return-type)
                                               ("me" (* (class tail)))
                       (main (method-entry-function-name method head nil))
                       (main-type (c-type (fun (lisp return-type)
                                               ("me" (* (class tail)))


@@ -496,9 +494,8 @@ (defmethod compute-method-entry-functions ((method basic-effective-method))
                  (nconc insts (and result
                                    (list (make-return-inst result)))))
 
                  (nconc insts (and result
                                    (list (make-return-inst result)))))
 

-                (let ((call (make-call-inst emf-name
-                             (cons "sod__obj" (mapcar #'argument-name
-                                                      emf-arg-tail)))))
+                (let ((call (apply #'make-call-inst emf-name "sod__obj"
+                                   (mapcar #'argument-name emf-arg-tail))))

                   (dolist (tail chain-tails)
                     (setup-entry tail)
                     (deliver-expr codegen entry-target call)
                   (dolist (tail chain-tails)
                     (setup-entry tail)
                     (deliver-expr codegen entry-target call)