export procedure-arguments from ice-9 session

* module/system/vm/program.scm (program-arguments): New function, used by
  procedure-arguments.

* module/ice-9/session.scm (procedure-arguments): New exported function,
  returns an alist describing the given procedure.

module/ice-9/session.scm

@@ -22,7 +22,7 @@
   :use-module (ice-9 rdelim)
   :export (help apropos apropos-internal apropos-fold
 	   apropos-fold-accessible apropos-fold-exported apropos-fold-all
-	   source arity))
+	   source arity procedure-arguments))
 
 
 
@@ -458,4 +458,25 @@ It is an image under the mapping EXTRACT."
 	      (display #\'))))))))
   (display ".\n"))
 
+
+(define (procedure-arguments proc)
+  "Return an alist describing the arguments that `proc' accepts, or `#f'
+if the information cannot be obtained.
+
+The alist keys that are currently defined are `required', `optional',
+`keyword', and `rest'."
+  (cond
+   ((procedure-property proc 'arglist)
+    => (lambda (arglist)
+         `((required . ,(car arglist))
+           (optional . ,(cadr arglist))
+           (keyword . ,(caddr arglist))
+           (rest . ,(car (cddddr arglist))))))
+   ((procedure-source proc)
+    => cadr)
+   (((@ (system vm program) program?) proc)
+    ((@ (system vm program) program-arguments) proc))
+   (else #f)))
+
+
 ;;; session.scm ends here

module/system/vm/program.scm

@@ -30,7 +30,7 @@
             source:addr source:line source:column source:file
             program-bindings program-sources program-source
             program-properties program-property program-documentation
-            program-name
+            program-name program-arguments
            
             program-arity program-external-set! program-meta
             program-objcode program? program-objects
@@ -66,6 +66,18 @@
 (define (program-documentation prog)
   (assq-ref (program-properties prog) 'documentation))
 
+(define (program-arguments prog)
+  (let ((bindings (program-bindings prog))
+        (nargs (arity:nargs (program-arity prog)))
+        (rest? (not (zero? (arity:nrest (program-arity prog))))))
+    (if bindings
+        (let ((args (map binding:name (list-head bindings nargs))))
+          (if rest?
+              `((required . ,(list-head args (1- (length args))))
+                (rest . ,(car (last-pair args))))
+              `((required . ,args))))
+        #f)))
+
 (define (program-bindings-as-lambda-list prog)
   (let ((bindings (program-bindings prog))
         (nargs (arity:nargs (program-arity prog)))