Completed the implementation of SI:SAFE-EVAL and SI:STRING-TO-OBJECT

parent a44854e1
......@@ -46,10 +46,10 @@ ECL 9.8.1:
to evaluate lisp forms in a safe way. If supplied three values, when an
error happens, it returns ERROR-VALUE; otherwise it will invoke a debugger.
- Two new functions, ecl_read_from_cstring(s) and ecl_read_from_cstring(s,v)
read an object from a C string (char *). The first one is unsafe and will
enter a debugger when there is a syntax error. The second one will return V
when an error happens.
- Two new functions, ecl_read_from_cstring(s) and
ecl_read_from_cstring_safe(s,v) read an object from a C string (char *). The
first one is unsafe and will enter a debugger when there is a syntax
error. The second one will return V when an error happens.
* Bugs fixed:
......
......@@ -35,9 +35,25 @@ cl_upgraded_array_element_type(cl_narg narg, cl_object type, ...)
}
extern cl_object
si_safe_eval(cl_narg arg, cl_object form, cl_object env, cl_object error_value, ...)
si_safe_eval(cl_narg narg, cl_object form, cl_object env, ...)
{
return cl_funcall(4, @'si::safe-eval', form, env, error_value);
if (narg == 3) {
va_list args; va_start(args, env);
cl_object err_value = va_arg(args, cl_object);
return cl_funcall(4, @'si::safe-eval', form, env, err_value);
}
return cl_funcall(3, @'si::safe-eval', form, env);
}
extern cl_object
si_string_to_object(cl_narg narg, cl_object string, ...)
{
if (narg == 2) {
va_list args; va_start(args, string);
cl_object err_value = va_arg(args, cl_object);
return cl_funcall(3, @'si::string-to-object', string, err_value);
}
return cl_funcall(2, @'si::string-to-object', string);
}
extern cl_object
......
......@@ -1185,7 +1185,7 @@ cl_symbols[] = {
{SYS_ "STANDARD-READTABLE", SI_ORDINARY, si_standard_readtable, 0, OBJNULL},
{SYS_ "STEPPER", SI_ORDINARY, OBJNULL, -1, OBJNULL},
{SYS_ "BASE-STRING-CONCATENATE", SI_ORDINARY, si_base_string_concatenate, -1, OBJNULL},
{SYS_ "STRING-TO-OBJECT", SI_ORDINARY, si_string_to_object, 1, OBJNULL},
{SYS_ "STRING-TO-OBJECT", SI_ORDINARY, ECL_NAME(si_string_to_object), -1, OBJNULL},
{SYS_ "STRUCTURE-NAME", SI_ORDINARY, si_structure_name, 1, OBJNULL},
{SYS_ "STRUCTURE-PRINT-FUNCTION", SI_ORDINARY, NULL, -1, OBJNULL},
{SYS_ "STRUCTURE-REF", SI_ORDINARY, si_structure_ref, 3, OBJNULL},
......
......@@ -1185,7 +1185,7 @@ cl_symbols[] = {
{SYS_ "STANDARD-READTABLE","si_standard_readtable"},
{SYS_ "STEPPER","OBJNULL"},
{SYS_ "BASE-STRING-CONCATENATE","si_base_string_concatenate"},
{SYS_ "STRING-TO-OBJECT","si_string_to_object"},
{SYS_ "STRING-TO-OBJECT","ECL_NAME(si_string_to_object)"},
{SYS_ "STRUCTURE-NAME","si_structure_name"},
{SYS_ "STRUCTURE-PRINT-FUNCTION",NULL},
{SYS_ "STRUCTURE-REF","si_structure_ref"},
......
......@@ -1197,7 +1197,7 @@
(proclaim-function make-dispatch-macro-character (*) t)
(proclaim-function set-dispatch-macro-character (*) t)
(proclaim-function get-dispatch-macro-character (*) t)
(proclaim-function si:string-to-object (t) t)
(proclaim-function si:string-to-object (t &optional t) t)
(proclaim-function si:standard-readtable (t) t)
(proclaim-function symbol-function (t) t)
(proclaim-function fboundp (symbol) t :predicate t)
......@@ -1528,7 +1528,7 @@
si::safe-eval
;; iolib.lsp
read-from-string write-to-string prin1-to-string princ-to-string
y-or-n-p yes-or-no-p
y-or-n-p yes-or-no-p string-to-object
;; listlib.lsp
union nunion intersection nintersection set-difference nset-difference
set-exclusive-or nset-exclusive-or subsetp rassoc-if rassoc-if-not
......
......@@ -1771,7 +1771,7 @@ extern ECL_API cl_object cl_prin1_to_string _ARGS((cl_narg narg, cl_object V1, .
extern ECL_API cl_object cl_princ_to_string _ARGS((cl_narg narg, cl_object V1, ...));
extern ECL_API cl_object cl_y_or_n_p _ARGS((cl_narg narg, ...));
extern ECL_API cl_object cl_yes_or_no_p _ARGS((cl_narg narg, ...));
extern ECL_API cl_object si_string_to_object _ARGS((cl_narg narg, cl_object str, ...);
extern ECL_API cl_object si_string_to_object _ARGS((cl_narg narg, cl_object str, ...));
/* listlib.lsp */
......
......@@ -76,8 +76,10 @@ object's representation."
(values (read stream eof-error-p eof-value)
(file-position stream)))))
(defun si::string-to-object (string &rest args)
(apply #'si::safe-eval `(read-from-string ,string) nil args))
(defun si::string-to-object (string &optional (err-value nil err-value-p))
(if err-value-p
(si::safe-eval `(read-from-string ,string) nil err-value)
(si::safe-eval `(read-from-string ,string) nil)))
(defun write-to-string (object &rest rest
&aux (stream (make-string-output-stream)))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment