rcl/high-level.lisp

   1 ;; Copyright (c) 2006-2007 Carlos Ungil
   2
   3 ;; Permission is hereby granted, free of charge, to any person obtaining
   4 ;; a copy of this software and associated documentation files (the
   5 ;; "Software"), to deal in the Software without restriction, including
   6 ;; without limitation the rights to use, copy, modify, merge, publish,
   7 ;; distribute, sublicense, and/or sell copies of the Software, and to
   8 ;; permit persons to whom the Software is furnished to do so, subject to
   9 ;; the following conditions:
  10
  11 ;; The above copyright notice and this permission notice shall be
  12 ;; included in all copies or substantial portions of the Software.
  13
  14 ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  15 ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  16 ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  17 ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
  18 ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
  19 ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
  20 ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
  21
  22 (in-package :rcl)
  23
  24 ;; with-r-streams is more robust, but closes all the existing connections
  25
  26 (defun r%-parse-eval (string)
  27   "Parse and evaluate the string in the R environment (returns r-pointer)"
  28   ;;(with-r-message () (with-r-output () (r-funcall "eval" (r-funcall "parse" :text string)))))
  29   (with-r-streams () (r-funcall "eval" (r-funcall "parse" :text string))))
  30
  31 (defun r-parse-eval (string)
  32   "Call r%-parse-eval and decode the result"
  33   (r-obj-decode (r%-parse-eval string)))
  34
  35 (defun r% (&rest args)
  36   "Apply the first argument to rest in the R environment (returns r-pointer)"
  37   ;;(with-r-message () (with-r-output () (apply #'r-funcall args))))
  38   (with-r-streams () (apply #'r-funcall args)))
  39
  40 (defun r (&rest args)
  41   "Call r% and decode the result"
  42   (r-obj-decode (apply #'r% args)))
  43
  44 (defun r%-values (&rest args)
  45   "Like r%, but returning output and messages as additional value"
  46   (let ((output (make-string-output-stream))
  47         (message (make-string-output-stream)))
  48      (values (with-r-message (message "")
  49                (with-r-output (output "")
  50                  (apply #'r-funcall args)))
  51              (get-output-stream-string output)
  52              (get-output-stream-string message))))
  53
  54 ;;FIXME this won't work if decoding produces values!
  55 (defun r-values (&rest args)
  56   "Call r%-values and decode the principal value"
  57   (let ((output (make-string-output-stream))
  58         (message (make-string-output-stream)))
  59     (values (r-obj-decode (with-r-message (message "")
  60                             (with-r-output (output "")
  61                               (apply #'r-funcall args))))
  62              (get-output-stream-string output)
  63              (get-output-stream-string message))))
  64
  65