diff options
Diffstat (limited to 'src/expressions')
| -rwxr-xr-x | src/expressions/eval_ref.ml | 79 |
1 files changed, 53 insertions, 26 deletions
diff --git a/src/expressions/eval_ref.ml b/src/expressions/eval_ref.ml index 8463f6c..99b35af 100755 --- a/src/expressions/eval_ref.ml +++ b/src/expressions/eval_ref.ml @@ -15,11 +15,22 @@ You should have received a copy of the GNU General Public License along with licht. If not, see <http://www.gnu.org/licenses/>.
*)
-type 'a range =
- | Single of 'a
- | Array1 of 'a list
- | Array2 of 'a list list
+(** Contain a valid value from the sheet. This value can be empty if it is not
+yet defined *)
+type value =
+ | V : 'a ScTypes.Type.t -> value
+ | Empty : value
+
+(** This is a snapshot from all the cells in the sheet, the values may be
+defined or not, and are not yet unified *)
+type range =
+ | Single : 'a ScTypes.Type.t -> range
+ | Array1 : value list -> range
+ | Array2 : value list list -> range
+
+(** Result from the computation, the list is unified and the type is now
+identified. The empty elements are defined with a default value. *)
type content =
| Value: 'a ScTypes.DataFormat.t * 'a -> content
| List: 'a ScTypes.DataFormat.t * 'a list -> content
@@ -33,12 +44,16 @@ type content = *)
type mapper = (int * int -> ScTypes.Result.t option)
-type 'a t = mapper -> ScTypes.Result.t option range
+type 'a t = mapper -> range
type 'a obs = mapper -> content
let cell t mapper = begin
- Single (mapper (Cell.to_pair t))
+ begin match mapper (Cell.to_pair t) with
+ | None -> raise Errors.TypeError
+ | Some (ScTypes.Result.Ok r) -> Single r
+ | Some (ScTypes.Result.Error x) -> raise x
+ end
end
let range fst snd mapper = begin
@@ -53,7 +68,11 @@ let range fst snd mapper = begin let elms = ref [] in
for x = min_x to max_x do
for y = min_y to max_y do
- elms := (mapper (x, y))::!elms
+ begin match mapper (x, y) with
+ | None -> elms := Empty::!elms
+ | Some (ScTypes.Result.Error x) -> raise x
+ | Some (ScTypes.Result.Ok r) -> elms := (V r)::!elms
+ end
done
done;
Array1 (!elms)
@@ -63,7 +82,11 @@ let range fst snd mapper = begin for x = min_x to max_x do
let elmy = ref [] in
for y = min_y to max_y do
- elmy := (mapper (x, y))::!elmy
+ begin match mapper (x, y) with
+ | None -> elmy := Empty::!elmy
+ | Some (ScTypes.Result.Error x) -> raise x
+ | Some (ScTypes.Result.Ok r) -> elmy := (V r)::!elmy
+ end
done;
elmx := !elmy::!elmx
done;
@@ -98,13 +121,11 @@ module M = ScTypes.Type.Eval(TypeContent) The function will raise Error.TypeError if the elements does not match
with the list type.
*)
-let add_elem: type a b. a ScTypes.DataFormat.t * a list -> ScTypes.Result.t option -> a ScTypes.DataFormat.t * a list =
+let add_elem: type a. a ScTypes.DataFormat.t * a list -> value -> a ScTypes.DataFormat.t * a list =
fun (format, elements) result ->
begin match result with
- | None -> format, (ScTypes.DataFormat.default_value_for format)::elements
- | Some (ScTypes.Result.Error x) -> raise x
- | Some (ScTypes.Result.Ok r) ->
-
+ | Empty -> format, (ScTypes.DataFormat.default_value_for format)::elements
+ | V r ->
let TypeContent.Value (format', element) = M.eval r in
let ScTypes.DataFormat.Eq = ScTypes.DataFormat.compare_format format format' in
let new_format = if (ScTypes.DataFormat.priority format) > (ScTypes.DataFormat.priority format') then
@@ -114,33 +135,37 @@ fun (format, elements) result -> new_format, element::elements
end
+(** Auxiliary type which does not handle Empty constructor *)
+type value' = V' : 'a ScTypes.Type.t -> value'
+
+let option_of_value v = begin match v with
+ | Empty -> None
+ | V x -> Some (V' x)
+end
+
(** extract the content from a range.
May raise Errors.TypeError if the range cannot be unified.
*)
let get_content = begin function
- | Single None -> raise Errors.TypeError
- | Single (Some (ScTypes.Result.Error x)) -> raise x
- | Single (Some (ScTypes.Result.Ok r)) ->
+ | Single r ->
let TypeContent.Value (format, element) = M.eval r in
Value (format, element)
| Array1 l ->
(* Get the first element in the list in order to get the format *)
- let TypeContent.Value (format, _) =
- begin match (Tools.List.find_map (fun x -> x) l) with
- | ScTypes.Result.Error x -> raise x
- | ScTypes.Result.Ok r -> M.eval r
- end in
+ let TypeContent.Value (format, _) = begin
+ let V' r = Tools.List.find_map option_of_value l in
+ M.eval r
+ end in
(* Then build an unified list (if we can) *)
let format, values = List.fold_left add_elem (format, []) l in
List(format, List.rev values)
| Array2 l ->
(* Get the first element in the list *)
- let TypeContent.Value (format, _) =
- begin match (Tools.List.find_map2 (fun x -> x) l) with
- | ScTypes.Result.Error x -> raise x
- | ScTypes.Result.Ok r -> M.eval r
- end in
+ let TypeContent.Value (format, _) = begin
+ let V' r = Tools.List.find_map2 option_of_value l in
+ M.eval r
+ end in
(* Then build an unified list *)
let format, values = List.fold_left (fun (format, result) elems ->
let format, elems = List.fold_left add_elem (format, []) elems in
@@ -149,5 +174,7 @@ let get_content = begin function Matrix(format, List.rev values)
end
+(** Collect the data from the references.
+If one of the values is an error, the error is thrown as an exception *)
let observe t mapper = get_content (t mapper)
|