[m-rev.] diff: convert some more modules to four space indentation
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Sep 19 14:37:40 AEST 2005
compiler/base_typeclass_info.m:
Fix overlong lines.
compiler/goal_util.m:
Minor style fix.
compiler/lambda.m:
Convert to four-space indentation. Other style fixes.
compiler/deconstruct.m:
compiler/io.m:
compiler/string.m:
compiler/term.m:
compiler/term_io.m:
compiler/type_desc.m:
Convert to four-space indentation. Other style fixes.
library/construct.m:
Minor style fix.
Zoltan.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/base_typeclass_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/base_typeclass_info.m,v
retrieving revision 1.36
diff -u -b -r1.36 base_typeclass_info.m
--- compiler/base_typeclass_info.m 12 Sep 2005 05:24:02 -0000 1.36
+++ compiler/base_typeclass_info.m 18 Sep 2005 14:11:21 -0000
@@ -57,37 +57,32 @@
%---------------------------------------------------------------------------%
-base_typeclass_info__generate_rtti(ModuleInfo, RttiDataList) :-
+generate_rtti(ModuleInfo, RttiDataList) :-
module_info_name(ModuleInfo, ModuleName),
module_info_instances(ModuleInfo, InstanceTable),
map__to_assoc_list(InstanceTable, AllInstances),
- base_typeclass_info__gen_infos_for_classes(AllInstances, ModuleName,
- ModuleInfo, [], RttiDataList).
+ gen_infos_for_classes(AllInstances, ModuleName, ModuleInfo,
+ [], RttiDataList).
-:- pred base_typeclass_info__gen_infos_for_classes(
+:- pred gen_infos_for_classes(
assoc_list(class_id, list(hlds_instance_defn))::in, module_name::in,
module_info::in, list(rtti_data)::in, list(rtti_data)::out) is det.
-base_typeclass_info__gen_infos_for_classes([], _ModuleName, _ModuleInfo,
- RttiDataList, RttiDataList).
-base_typeclass_info__gen_infos_for_classes([C|Cs], ModuleName, ModuleInfo,
- RttiDataList0, RttiDataList) :-
- base_typeclass_info__gen_infos_for_instance_list(C, ModuleName,
- ModuleInfo, RttiDataList0, RttiDataList1),
- base_typeclass_info__gen_infos_for_classes(Cs, ModuleName,
- ModuleInfo, RttiDataList1, RttiDataList).
+gen_infos_for_classes([], _ModuleName, _ModuleInfo, !RttiDataList).
+gen_infos_for_classes([C|Cs], ModuleName, ModuleInfo, !RttiDataList) :-
+ gen_infos_for_instance_list(C, ModuleName, ModuleInfo, !RttiDataList),
+ gen_infos_for_classes(Cs, ModuleName, ModuleInfo, !RttiDataList).
% XXX make it use an accumulator
-:- pred base_typeclass_info__gen_infos_for_instance_list(
+:- pred gen_infos_for_instance_list(
pair(class_id, list(hlds_instance_defn))::in, module_name::in,
module_info::in, list(rtti_data)::in, list(rtti_data)::out) is det.
-base_typeclass_info__gen_infos_for_instance_list(_ - [], _, _,
- RttiDataList, RttiDataList).
-base_typeclass_info__gen_infos_for_instance_list(ClassId - [InstanceDefn|Is],
- ModuleName, ModuleInfo, RttiDataList0, RttiDataList) :-
- base_typeclass_info__gen_infos_for_instance_list(ClassId - Is,
- ModuleName, ModuleInfo, RttiDataList0, RttiDataList1),
+gen_infos_for_instance_list(_ - [], _, _, !RttiDataList).
+gen_infos_for_instance_list(ClassId - [InstanceDefn | Is], ModuleName,
+ ModuleInfo, !RttiDataList) :-
+ gen_infos_for_instance_list(ClassId - Is, ModuleName, ModuleInfo,
+ !RttiDataList),
InstanceDefn = hlds_instance_defn(InstanceModule, ImportStatus,
_TermContext, InstanceConstraints, InstanceTypes, Body,
PredProcIds, _Varset, _SuperClassProofs),
@@ -98,29 +93,28 @@
status_defined_in_this_module(ImportStatus, yes)
->
make_instance_string(InstanceTypes, InstanceString),
- base_typeclass_info__gen_body(PredProcIds,
- InstanceTypes, InstanceConstraints, ModuleInfo,
- ClassId, BaseTypeClassInfo),
+ gen_body(PredProcIds, InstanceTypes, InstanceConstraints,
+ ModuleInfo, ClassId, BaseTypeClassInfo),
TCName = generate_class_name(ClassId),
RttiData = base_typeclass_info(TCName, InstanceModule,
InstanceString, BaseTypeClassInfo),
- RttiDataList = [RttiData | RttiDataList1]
+ !:RttiDataList = [RttiData | !.RttiDataList]
;
% The instance decl is from another module,
% or is abstract, so we don't bother including it.
- RttiDataList = RttiDataList1
+ true
).
%----------------------------------------------------------------------------%
-:- pred base_typeclass_info__gen_body(maybe(list(hlds_class_proc))::in,
- list(type)::in, list(prog_constraint)::in, module_info::in,
- class_id::in, base_typeclass_info::out) is det.
+:- pred gen_body(maybe(list(hlds_class_proc))::in, list(type)::in,
+ list(prog_constraint)::in, module_info::in, class_id::in,
+ base_typeclass_info::out) is det.
-base_typeclass_info__gen_body(no, _, _, _, _, _) :-
+gen_body(no, _, _, _, _, _) :-
error("pred_proc_ids should have been filled in by check_typeclass.m").
-base_typeclass_info__gen_body(yes(PredProcIds0), Types, Constraints,
- ModuleInfo, ClassId, BaseTypeClassInfo) :-
+gen_body(yes(PredProcIds0), Types, Constraints, ModuleInfo, ClassId,
+ BaseTypeClassInfo) :-
prog_type__vars_list(Types, TypeVars),
get_unconstrained_tvars(TypeVars, Constraints, Unconstrained),
list__length(Constraints, NumConstraints),
@@ -132,31 +126,29 @@
PredProc = proc(PredId, ProcId)
)),
list__map(ExtractPredProcId, PredProcIds0, PredProcIds),
- base_typeclass_info__construct_proc_labels(PredProcIds, ModuleInfo,
+ construct_proc_labels(PredProcIds, ModuleInfo,
ProcLabels),
- base_typeclass_info__gen_superclass_count(ClassId, ModuleInfo,
+ gen_superclass_count(ClassId, ModuleInfo,
SuperClassCount, ClassArity),
list__length(ProcLabels, NumMethods),
BaseTypeClassInfo = base_typeclass_info(NumExtra, NumConstraints,
SuperClassCount, ClassArity, NumMethods, ProcLabels).
-:- pred base_typeclass_info__construct_proc_labels(list(pred_proc_id)::in,
+:- pred construct_proc_labels(list(pred_proc_id)::in,
module_info::in, list(rtti_proc_label)::out) is det.
-base_typeclass_info__construct_proc_labels([], _, []).
-base_typeclass_info__construct_proc_labels([proc(PredId, ProcId) | Procs],
- ModuleInfo, [ProcLabel | ProcLabels]) :-
+construct_proc_labels([], _, []).
+construct_proc_labels([proc(PredId, ProcId) | Procs], ModuleInfo,
+ [ProcLabel | ProcLabels]) :-
ProcLabel = rtti__make_rtti_proc_label(ModuleInfo, PredId, ProcId),
- base_typeclass_info__construct_proc_labels(Procs, ModuleInfo,
- ProcLabels).
+ construct_proc_labels(Procs, ModuleInfo, ProcLabels).
%----------------------------------------------------------------------------%
-:- pred base_typeclass_info__gen_superclass_count(class_id::in, module_info::in,
+:- pred gen_superclass_count(class_id::in, module_info::in,
int::out, int::out) is det.
-base_typeclass_info__gen_superclass_count(ClassId, ModuleInfo,
- NumSuperClasses, ClassArity) :-
+gen_superclass_count(ClassId, ModuleInfo, NumSuperClasses, ClassArity) :-
module_info_classes(ModuleInfo, ClassTable),
map__lookup(ClassTable, ClassId, ClassDefn),
list__length(ClassDefn ^ class_supers, NumSuperClasses),
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.114
diff -u -b -r1.114 goal_util.m
--- compiler/goal_util.m 13 Sep 2005 04:56:01 -0000 1.114
+++ compiler/goal_util.m 18 Sep 2005 14:12:10 -0000
@@ -951,7 +951,8 @@
% include all typeclass_infos that constrain a type variable
% that is non-local in the above sense.
%
- solutions_set((pred(Var::out) is nondet :-
+ solutions_set(
+ (pred(Var::out) is nondet :-
% Search through all arguments of all constraints
% that the goal could have used.
rtti_varmaps_reusable_constraints(RttiVarMaps, Constraints),
@@ -960,8 +961,8 @@
type_list_contains_var(ArgTypes, TypeVar),
set__member(TypeVar, NonLocalTypeVars),
- % We found a constraint that is non-local. Include
- % the variable holding its typeclass_info.
+ % We found a constraint that is non-local. Include the variable
+ % holding its typeclass_info.
rtti_lookup_typeclass_info_var(RttiVarMaps, Constraint, Var)
), NonLocalTypeClassInfoVars),
NonLocalTypeInfos = set__union(NonLocalTypeInfoVars,
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.103
diff -u -b -r1.103 lambda.m
--- compiler/lambda.m 13 Sep 2005 04:56:05 -0000 1.103
+++ compiler/lambda.m 18 Sep 2005 14:15:27 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1995-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -14,7 +16,7 @@
%
% :- pred p(int::in) is det.
% p(X) :-
-% V__1 = lambda([Y::out] is nondet, q(Y, X))),
+% V__1 = (pred(Y::out) is nondet :- q(Y, X)),
% solutions(V__1, List),
% ...
% :- pred q(int::out, int::in) is nondet.
@@ -72,10 +74,9 @@
:- import_module hlds__hlds_module.
:- import_module hlds__hlds_pred.
-:- pred lambda__process_module(module_info::in, module_info::out) is det.
+:- pred process_module(module_info::in, module_info::out) is det.
-:- pred lambda__process_pred(pred_id::in, module_info::in, module_info::out)
- is det.
+:- pred process_pred(pred_id::in, module_info::in, module_info::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -83,6 +84,7 @@
:- implementation.
% Parse tree modules
+:- import_module parse_tree__error_util.
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_mode.
:- import_module parse_tree__prog_util.
@@ -114,8 +116,8 @@
:- import_module term.
:- import_module varset.
-:- type lambda_info --->
- lambda_info(
+:- type lambda_info
+ ---> lambda_info(
prog_varset, % from the proc_info
map(prog_var, type), % from the proc_info
prog_constraints, % from the pred_info
@@ -127,51 +129,35 @@
string, % pred/func name
aditi_owner,
module_info,
- bool % true iff we need to recompute the nonlocals
+ bool % true iff we need to recompute
+ % the nonlocals
).
%-----------------------------------------------------------------------------%
% This whole section just traverses the module structure.
-lambda__process_module(ModuleInfo0, ModuleInfo) :-
- module_info_predids(ModuleInfo0, PredIds),
- lambda__process_preds(PredIds, ModuleInfo0, ModuleInfo1),
+process_module(!ModuleInfo) :-
+ module_info_predids(!.ModuleInfo, PredIds),
+ list__foldl(process_pred, PredIds, !ModuleInfo),
% Need update the dependency graph to include the lambda predicates.
- module_info_clobber_dependency_info(ModuleInfo1, ModuleInfo).
-
-:- pred lambda__process_preds(list(pred_id)::in,
- module_info::in, module_info::out) is det.
-
-lambda__process_preds([], ModuleInfo, ModuleInfo).
-lambda__process_preds([PredId | PredIds], ModuleInfo0, ModuleInfo) :-
- lambda__process_pred(PredId, ModuleInfo0, ModuleInfo1),
- lambda__process_preds(PredIds, ModuleInfo1, ModuleInfo).
+ module_info_clobber_dependency_info(!ModuleInfo).
-lambda__process_pred(PredId, ModuleInfo0, ModuleInfo) :-
- module_info_pred_info(ModuleInfo0, PredId, PredInfo),
+process_pred(PredId, !ModuleInfo) :-
+ module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
ProcIds = pred_info_procids(PredInfo),
- lambda__process_procs(PredId, ProcIds, ModuleInfo0, ModuleInfo).
-
-:- pred lambda__process_procs(pred_id::in, list(proc_id)::in,
- module_info::in, module_info::out) is det.
-
-lambda__process_procs(_PredId, [], ModuleInfo, ModuleInfo).
-lambda__process_procs(PredId, [ProcId | ProcIds], ModuleInfo0, ModuleInfo) :-
- lambda__process_proc(PredId, ProcId, ModuleInfo0, ModuleInfo1),
- lambda__process_procs(PredId, ProcIds, ModuleInfo1, ModuleInfo).
+ list__foldl(process_proc(PredId), ProcIds, !ModuleInfo).
-:- pred lambda__process_proc(pred_id::in, proc_id::in,
+:- pred process_proc(pred_id::in, proc_id::in,
module_info::in, module_info::out) is det.
-lambda__process_proc(PredId, ProcId, !ModuleInfo) :-
+process_proc(PredId, ProcId, !ModuleInfo) :-
module_info_preds(!.ModuleInfo, PredTable0),
map__lookup(PredTable0, PredId, PredInfo0),
pred_info_procedures(PredInfo0, ProcTable0),
map__lookup(ProcTable0, ProcId, ProcInfo0),
- lambda__process_proc_2(ProcInfo0, ProcInfo, PredInfo0, PredInfo1,
- !ModuleInfo),
+ process_proc_2(ProcInfo0, ProcInfo, PredInfo0, PredInfo1, !ModuleInfo),
pred_info_procedures(PredInfo1, ProcTable1),
map__det_update(ProcTable1, ProcId, ProcInfo, ProcTable),
@@ -180,11 +166,10 @@
map__det_update(PredTable1, PredId, PredInfo, PredTable),
module_info_set_preds(PredTable, !ModuleInfo).
-:- pred lambda__process_proc_2(proc_info::in, proc_info::out,
- pred_info::in, pred_info::out, module_info::in, module_info::out)
- is det.
+:- pred process_proc_2(proc_info::in, proc_info::out,
+ pred_info::in, pred_info::out, module_info::in, module_info::out) is det.
-lambda__process_proc_2(!ProcInfo, !PredInfo, !ModuleInfo) :-
+process_proc_2(!ProcInfo, !PredInfo, !ModuleInfo) :-
% grab the appropriate fields from the pred_info and proc_info
PredName = pred_info_name(!.PredInfo),
PredOrFunc = pred_info_is_pred_or_func(!.PredInfo),
@@ -200,26 +185,28 @@
proc_info_inst_varset(!.ProcInfo, InstVarSet0),
MustRecomputeNonLocals0 = no,
- % process the goal
+ % Process the goal.
Info0 = lambda_info(VarSet0, VarTypes0, Constraints0, TypeVarSet0,
InstVarSet0, RttiVarMaps0, Markers, PredOrFunc,
PredName, Owner, !.ModuleInfo, MustRecomputeNonLocals0),
- lambda__process_goal(Goal0, Goal1, Info0, Info1),
+ process_goal(Goal0, Goal1, Info0, Info1),
Info1 = lambda_info(VarSet1, VarTypes1, Constraints, TypeVarSet,
_, RttiVarMaps, _, _, _, _, !:ModuleInfo,
MustRecomputeNonLocals),
- % check if we need to requantify
- ( MustRecomputeNonLocals = yes ->
+ % Check if we need to requantify.
+ (
+ MustRecomputeNonLocals = yes,
implicitly_quantify_clause_body(HeadVars, _Warnings,
Goal1, Goal, VarSet1, VarSet, VarTypes1, VarTypes)
;
+ MustRecomputeNonLocals = no,
Goal = Goal1,
VarSet = VarSet1,
VarTypes = VarTypes1
),
- % set the new values of the fields in proc_info and pred_info
+ % Set the new values of the fields in proc_info and pred_info.
proc_info_set_goal(Goal, !ProcInfo),
proc_info_set_varset(VarSet, !ProcInfo),
proc_info_set_vartypes(VarTypes, !ProcInfo),
@@ -227,113 +214,126 @@
pred_info_set_typevarset(TypeVarSet, !PredInfo),
pred_info_set_class_context(Constraints, !PredInfo).
-:- pred lambda__process_goal(hlds_goal::in, hlds_goal::out,
+ % The job of process_goal is to traverse the goal, processing each
+ % unification with process_unify_goal.
+ %
+:- pred process_goal(hlds_goal::in, hlds_goal::out,
lambda_info::in, lambda_info::out) is det.
-lambda__process_goal(Goal0 - GoalInfo0, Goal, !Info) :-
- lambda__process_goal_2(Goal0, GoalInfo0, Goal, !Info).
-
-:- pred lambda__process_goal_2(hlds_goal_expr::in, hlds_goal_info::in,
- hlds_goal::out, lambda_info::in, lambda_info::out) is det.
-
-lambda__process_goal_2(unify(XVar, Y, Mode, Unification, Context), GoalInfo,
- Unify - GoalInfo, !Info) :-
+process_goal(GoalExpr0 - GoalInfo, GoalExpr - GoalInfo, !Info) :-
(
- Y = lambda_goal(Purity, PredOrFunc, EvalMethod, _,
- NonLocalVars, Vars, Modes, Det, LambdaGoal0)
- ->
- % first, process the lambda goal recursively, in case it
- % contains some nested lambda expressions.
- lambda__process_goal(LambdaGoal0, LambdaGoal1, !Info),
-
- % then, convert the lambda expression into a new predicate
- lambda__process_lambda(Purity, PredOrFunc, EvalMethod, Vars,
- Modes, Det, NonLocalVars, LambdaGoal1,
- Unification, Y1, Unification1, !Info),
- Unify = unify(XVar, Y1, Mode, Unification1, Context)
+ GoalExpr0 = unify(XVar, Y, Mode, Unification, Context),
+ process_unify_goal(XVar, Y, Mode, Unification, Context,
+ GoalExpr, !Info)
;
- % ordinary unifications are left unchanged
- Unify = unify(XVar, Y, Mode, Unification, Context)
+ GoalExpr0 = conj(Goals0),
+ process_goal_list(Goals0, Goals, !Info),
+ GoalExpr = conj(Goals)
+ ;
+ GoalExpr0 = par_conj(Goals0),
+ process_goal_list(Goals0, Goals, !Info),
+ GoalExpr = par_conj(Goals)
+ ;
+ GoalExpr0 = disj(Goals0),
+ process_goal_list(Goals0, Goals, !Info),
+ GoalExpr = disj(Goals)
+ ;
+ GoalExpr0 = not(Goal0),
+ process_goal(Goal0, Goal, !Info),
+ GoalExpr = not(Goal)
+ ;
+ GoalExpr0 = switch(Var, CanFail, Cases0),
+ process_cases(Cases0, Cases, !Info),
+ GoalExpr = switch(Var, CanFail, Cases)
+ ;
+ GoalExpr0 = scope(Reason, Goal0),
+ process_goal(Goal0, Goal, !Info),
+ GoalExpr = scope(Reason, Goal)
+ ;
+ GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
+ process_goal(Cond0, Cond, !Info),
+ process_goal(Then0, Then, !Info),
+ process_goal(Else0, Else, !Info),
+ GoalExpr = if_then_else(Vars, Cond, Then, Else)
+ ;
+ GoalExpr0 = generic_call(_, _, _, _),
+ GoalExpr = GoalExpr0
+ ;
+ GoalExpr0 = call(_, _, _, _, _, _),
+ GoalExpr = GoalExpr0
+ ;
+ GoalExpr0 = foreign_proc(_, _, _, _, _, _),
+ GoalExpr = GoalExpr0
+ ;
+ GoalExpr0 = shorthand(_),
+ % These should have been expanded out by now.
+ unexpected(this_file, "process_goal_2: unexpected shorthand")
).
- % the rest of the clauses just process goals recursively
+:- pred process_goal_list(list(hlds_goal)::in, list(hlds_goal)::out,
+ lambda_info::in, lambda_info::out) is det.
-lambda__process_goal_2(conj(Goals0), GoalInfo, conj(Goals) - GoalInfo,
- !Info) :-
- lambda__process_goal_list(Goals0, Goals, !Info).
-lambda__process_goal_2(par_conj(Goals0), GoalInfo,
- par_conj(Goals) - GoalInfo, !Info) :-
- lambda__process_goal_list(Goals0, Goals, !Info).
-lambda__process_goal_2(disj(Goals0), GoalInfo, disj(Goals) - GoalInfo,
- !Info) :-
- lambda__process_goal_list(Goals0, Goals, !Info).
-lambda__process_goal_2(not(Goal0), GoalInfo, not(Goal) - GoalInfo, !Info) :-
- lambda__process_goal(Goal0, Goal, !Info).
-lambda__process_goal_2(switch(Var, CanFail, Cases0), GoalInfo,
- switch(Var, CanFail, Cases) - GoalInfo, !Info) :-
- lambda__process_cases(Cases0, Cases, !Info).
-lambda__process_goal_2(scope(Reason, Goal0), GoalInfo,
- scope(Reason, Goal) - GoalInfo, !Info) :-
- lambda__process_goal(Goal0, Goal, !Info).
-lambda__process_goal_2(if_then_else(Vars, Cond0, Then0, Else0), GoalInfo,
- if_then_else(Vars, Cond, Then, Else) - GoalInfo, !Info) :-
- lambda__process_goal(Cond0, Cond, !Info),
- lambda__process_goal(Then0, Then, !Info),
- lambda__process_goal(Else0, Else, !Info).
-lambda__process_goal_2(Goal @ generic_call(_, _, _, _), GoalInfo,
- Goal - GoalInfo, !Info).
-lambda__process_goal_2(Goal @ call(_, _, _, _, _, _), GoalInfo,
- Goal - GoalInfo, !Info).
-lambda__process_goal_2(Goal @ foreign_proc(_, _, _, _, _, _), GoalInfo,
- Goal - GoalInfo, !Info).
-lambda__process_goal_2(shorthand(_), _, _, !Info) :-
- % these should have been expanded out by now
- error("lambda__process_goal_2: unexpected shorthand").
+process_goal_list([], [], !Info).
+process_goal_list([Goal0 | Goals0], [Goal | Goals], !Info) :-
+ process_goal(Goal0, Goal, !Info),
+ process_goal_list(Goals0, Goals, !Info).
-:- pred lambda__process_goal_list(list(hlds_goal)::in, list(hlds_goal)::out,
+:- pred process_cases(list(case)::in, list(case)::out,
lambda_info::in, lambda_info::out) is det.
-lambda__process_goal_list([], [], !Info).
-lambda__process_goal_list([Goal0 | Goals0], [Goal | Goals], !Info) :-
- lambda__process_goal(Goal0, Goal, !Info),
- lambda__process_goal_list(Goals0, Goals, !Info).
+process_cases([], [], !Info).
+process_cases([case(ConsId, Goal0) | Cases0], [case(ConsId, Goal) | Cases],
+ !Info) :-
+ process_goal(Goal0, Goal, !Info),
+ process_cases(Cases0, Cases, !Info).
-:- pred lambda__process_cases(list(case)::in, list(case)::out,
+:- pred process_unify_goal(prog_var::in, unify_rhs::in, unify_mode::in,
+ unification::in, unify_context::in, hlds_goal_expr::out,
lambda_info::in, lambda_info::out) is det.
-lambda__process_cases([], [], !Info).
-lambda__process_cases([case(ConsId, Goal0) | Cases0],
- [case(ConsId, Goal) | Cases], !Info) :-
- lambda__process_goal(Goal0, Goal, !Info),
- lambda__process_cases(Cases0, Cases, !Info).
-
-:- pred lambda__process_lambda(purity::in, pred_or_func::in,
- lambda_eval_method::in, list(prog_var)::in, list(mode)::in,
- determinism::in, list(prog_var)::in, hlds_goal::in, unification::in,
- unify_rhs::out, unification::out, lambda_info::in, lambda_info::out)
- is det.
+process_unify_goal(XVar, Y0, Mode, Unification0, Context, GoalExpr, !Info) :-
+ (
+ Y0 = lambda_goal(Purity, PredOrFunc, EvalMethod, _,
+ NonLocalVars, Vars, Modes, Det, LambdaGoal0)
+ ->
+ % First, process the lambda goal recursively, in case it contains
+ % some nested lambda expressions.
+ process_goal(LambdaGoal0, LambdaGoal, !Info),
+
+ % Then, convert the lambda expression into a new predicate.
+ process_lambda(Purity, PredOrFunc, EvalMethod, Vars, Modes, Det,
+ NonLocalVars, LambdaGoal, Unification0, Y, Unification, !Info),
+ GoalExpr = unify(XVar, Y, Mode, Unification, Context)
+ ;
+ % Ordinary unifications are left unchanged.
+ GoalExpr = unify(XVar, Y0, Mode, Unification0, Context)
+ ).
-lambda__process_lambda(Purity, PredOrFunc, EvalMethod, Vars, Modes, Detism,
+:- pred process_lambda(purity::in, pred_or_func::in, lambda_eval_method::in,
+ list(prog_var)::in, list(mode)::in, determinism::in, list(prog_var)::in,
+ hlds_goal::in, unification::in, unify_rhs::out, unification::out,
+ lambda_info::in, lambda_info::out) is det.
+
+process_lambda(Purity, PredOrFunc, EvalMethod, Vars, Modes, Detism,
OrigNonLocals0, LambdaGoal, Unification0, Functor,
Unification, LambdaInfo0, LambdaInfo) :-
LambdaInfo0 = lambda_info(VarSet, VarTypes, _PredConstraints, TVarSet,
InstVarSet, RttiVarMaps, Markers, POF, OrigPredName,
Owner, ModuleInfo0, MustRecomputeNonLocals0),
- % Calculate the constraints which apply to this lambda
- % expression.
- % Note currently we only allow lambda expressions
- % to have universally quantified constraints.
+ % Calculate the constraints which apply to this lambda expression.
+ % Note currently we only allow lambda expressions to have universally
+ % quantified constraints.
rtti_varmaps_reusable_constraints(RttiVarMaps, AllConstraints),
map__apply_to_list(Vars, VarTypes, LambdaVarTypes),
list__map(prog_type__vars, LambdaVarTypes, LambdaTypeVarsList),
list__condense(LambdaTypeVarsList, LambdaTypeVars),
- list__filter(lambda__constraint_contains_vars(LambdaTypeVars),
+ list__filter(constraint_contains_vars(LambdaTypeVars),
AllConstraints, UnivConstraints),
Constraints = constraints(UnivConstraints, []),
- % existentially typed lambda expressions are not yet supported
- % (see the documentation at top of this file)
+ % Existentially typed lambda expressions are not yet supported
+ % (see the documentation at top of this file).
ExistQVars = [],
LambdaGoal = _ - LambdaGoalInfo,
goal_info_get_nonlocals(LambdaGoalInfo, LambdaGoalNonLocals),
@@ -342,13 +342,11 @@
LambdaNonLocals, ExtraTypeInfos),
OrigVars = OrigNonLocals0,
- (
- Unification0 = construct(Var0, _, _, UniModes0, _, _, _)
- ->
+ ( Unification0 = construct(Var0, _, _, UniModes0, _, _, _) ->
Var = Var0,
UniModes1 = UniModes0
;
- error("lambda__transform_lambda: weird unification")
+ unexpected(this_file, "transform_lambda: weird unification")
),
set__delete_list(LambdaGoalNonLocals, Vars, NonLocals1),
@@ -358,9 +356,8 @@
NewTypeInfos = ExtraTypeInfos `set__difference` NonLocals1,
NonLocals = NonLocals1 `set__union` NewTypeInfos,
- % If we added variables to the nonlocals of the lambda goal,
- % then we need to recompute the nonlocals for the procedure
- % that contains it.
+ % If we added variables to the nonlocals of the lambda goal, then
+ % we need to recompute the nonlocals for the procedure that contains it.
( \+ set__empty(NewTypeInfos) ->
MustRecomputeNonLocals = yes
;
@@ -371,20 +368,19 @@
(
% Optimize a special case: replace
- % `lambda([Y1, Y2, ...] is Detism,
+ % `(pred(Y1, Y2, ...) is Detism :-
% p(X1, X2, ..., Y1, Y2, ...))'
% where `p' has determinism `Detism' with
% `p(X1, X2, ...)'
%
- % This optimization is only valid if the modes of the Xi are
- % input, since only input arguments can be curried.
- % It's also only valid if all the inputs in the Yi precede the
- % outputs. It's also not valid if any of the Xi are in the Yi.
+ % This optimization is only valid if the modes of the Xi are input,
+ % since only input arguments can be curried. It's also only valid
+ % if all the inputs in the Yi precede the outputs. It's also not valid
+ % if any of the Xi are in the Yi.
LambdaGoal = call(PredId0, ProcId0, CallVars, _, _, _) - _,
module_info_pred_proc_info(ModuleInfo0, PredId0, ProcId0,
Call_PredInfo, Call_ProcInfo),
-
(
EvalMethod = (aditi_bottom_up),
pred_info_get_markers(Call_PredInfo, Call_Markers),
@@ -401,40 +397,39 @@
list__member(InitialVar, Vars)
),
- % Check that the code models are compatible.
- % Note that det is not compatible with semidet,
- % and semidet is not compatible with nondet,
- % since the calling conventions are different.
- % If we're using the LLDS back-end
- % (i.e. not --high-level-code),
- % det is compatible with nondet.
- % If we're using the MLDS back-end,
- % then predicates and functions have different
- % calling conventions.
+ % Check that the code models are compatible. Note that det is not
+ % compatible with semidet, and semidet is not compatible with nondet,
+ % since the calling conventions are different. If we're using the LLDS
+ % back-end (i.e. not --high-level-code), det is compatible with nondet.
+ % If we're using the MLDS back-end, then predicates and functions have
+ % different calling conventions.
proc_info_interface_code_model(Call_ProcInfo, Call_CodeModel),
determinism_to_code_model(Detism, CodeModel),
module_info_globals(ModuleInfo0, Globals),
- globals__lookup_bool_option(Globals, highlevel_code,
- HighLevelCode),
+ globals__lookup_bool_option(Globals, highlevel_code, HighLevelCode),
(
HighLevelCode = no,
- ( CodeModel = Call_CodeModel
- ; CodeModel = model_non, Call_CodeModel = model_det
+ (
+ CodeModel = Call_CodeModel
+ ;
+ CodeModel = model_non,
+ Call_CodeModel = model_det
)
;
HighLevelCode = yes,
- Call_PredOrFunc =
- pred_info_is_pred_or_func(Call_PredInfo),
+ Call_PredOrFunc = pred_info_is_pred_or_func(Call_PredInfo),
PredOrFunc = Call_PredOrFunc,
CodeModel = Call_CodeModel
),
- % check that the curried arguments are all input
+ % Check that the curried arguments are all input.
proc_info_argmodes(Call_ProcInfo, Call_ArgModes),
list__length(InitialVars, NumInitialVars),
list__take(NumInitialVars, Call_ArgModes, CurriedArgModes),
- \+ ( list__member(Mode, CurriedArgModes),
- \+ mode_is_input(ModuleInfo0, Mode)
+ (
+ list__member(Mode, CurriedArgModes)
+ =>
+ mode_is_input(ModuleInfo0, Mode)
)
->
ArgVars = InitialVars,
@@ -442,20 +437,16 @@
ProcId = ProcId0,
mode_util__modes_to_uni_modes(ModuleInfo0,
CurriedArgModes, CurriedArgModes, UniModes),
- %
- % we need to mark the procedure as having had its
- % address taken
- %
+ % We must mark the procedure as having had its address taken.
proc_info_set_address_taken(address_is_taken,
Call_ProcInfo, Call_NewProcInfo),
module_info_set_pred_proc_info(PredId, ProcId,
Call_PredInfo, Call_NewProcInfo,
ModuleInfo0, ModuleInfo)
;
- % Prepare to create a new predicate for the lambda
- % expression: work out the arguments, module name, predicate
- % name, arity, arg types, determinism,
- % context, status, etc. for the new predicate.
+ % Prepare to create a new predicate for the lambda expression:
+ % work out the arguments, module name, predicate name, arity,
+ % arg types, determinism, context, status, etc. for the new predicate.
ArgVars = put_typeinfo_vars_first(ArgVars1, VarTypes),
list__append(ArgVars, Vars, AllArgVars),
@@ -467,51 +458,44 @@
module_info_next_lambda_count(OrigContext, LambdaCount,
ModuleInfo0, ModuleInfo1),
make_pred_name_with_context(ModuleName, "IntroducedFrom",
- PredOrFunc, OrigPredName, OrigLine,
- LambdaCount, PredName),
+ PredOrFunc, OrigPredName, OrigLine, LambdaCount, PredName),
goal_info_get_context(LambdaGoalInfo, LambdaContext),
% The TVarSet is a superset of what it really ought be,
% but that shouldn't matter.
% Existentially typed lambda expressions are not
% yet supported (see the documentation at top of this file)
ExistQVars = [],
- lambda__uni_modes_to_modes(UniModes1, OrigArgModes),
+ uni_modes_to_modes(UniModes1, OrigArgModes),
- % We have to jump through hoops to work out the mode
- % of the lambda predicate. For introduced
- % type_info arguments, we use the mode "in". For the original
- % non-local vars, we use the modes from `UniModes1'.
- % For the lambda var arguments at the end,
- % we use the mode in the lambda expression.
+ % We have to jump through hoops to work out the mode of the lambda
+ % predicate. For introduced type_info arguments, we use the mode "in".
+ % For the original non-local vars, we use the modes from `UniModes1'.
+ % For the lambda var arguments at the end, we use the mode in the
+ % lambda expression.
list__length(ArgVars, NumArgVars),
in_mode(In),
list__duplicate(NumArgVars, In, InModes),
- map__from_corresponding_lists(ArgVars, InModes,
- ArgModesMap),
+ map__from_corresponding_lists(ArgVars, InModes, ArgModesMap),
- map__from_corresponding_lists(OrigVars, OrigArgModes,
- OrigArgModesMap),
+ map__from_corresponding_lists(OrigVars, OrigArgModes, OrigArgModesMap),
map__overlay(ArgModesMap, OrigArgModesMap, ArgModesMap1),
map__apply_to_list(ArgVars, ArgModesMap1, ArgModes1),
% Recompute the uni_modes.
- mode_util__modes_to_uni_modes(ModuleInfo1,
- ArgModes1, ArgModes1, UniModes),
+ mode_util__modes_to_uni_modes(ModuleInfo1, ArgModes1, ArgModes1,
+ UniModes),
list__append(ArgModes1, Modes, AllArgModes),
map__apply_to_list(AllArgVars, VarTypes, ArgTypes),
purity_to_markers(Purity, LambdaMarkers0),
(
- % Pass through the aditi markers for
- % aggregate query closures.
- % XXX we should differentiate between normal
- % top-down closures and aggregate query closures,
- % possibly by using a different type for aggregate
- % queries. Currently all nondet lambda expressions
- % within Aditi predicates are treated as aggregate
- % inputs.
+ % Pass through the aditi markers for aggregate query closures.
+ % XXX we should differentiate between normal top-down closures
+ % and aggregate query closures, possibly by using a different type
+ % for aggregate queries. Currently all nondet lambda expressions
+ % within Aditi predicates are treated as aggregate inputs.
% EvalMethod = (aditi_bottom_up),
determinism_components(Detism, _, at_most_many),
check_marker(Markers, aditi)
@@ -519,10 +503,9 @@
markers_to_marker_list(Markers, MarkerList0),
list__filter(
(pred(Marker::in) is semidet :-
- % Pass through only Aditi markers.
- % Don't pass through `context' markers, since
- % they are useless for non-recursive predicates
- % such as the created predicate.
+ % Pass through only Aditi markers. Don't pass through
+ % `context' markers, since they are useless for
+ % non-recursive predicates such as the created predicate.
( Marker = aditi
; Marker = dnf
; Marker = psn
@@ -532,8 +515,7 @@
; Marker = aditi_no_memo
)),
MarkerList0, MarkerList),
- list__foldl(add_marker, MarkerList,
- LambdaMarkers0, LambdaMarkers)
+ list__foldl(add_marker, MarkerList, LambdaMarkers0, LambdaMarkers)
;
EvalMethod = (aditi_bottom_up)
->
@@ -542,9 +524,8 @@
LambdaMarkers = LambdaMarkers0
),
- % Now construct the proc_info and pred_info for the new
- % single-mode predicate, using the information computed above
-
+ % Now construct the proc_info and pred_info for the new single-mode
+ % predicate, using the information computed above.
proc_info_create(LambdaContext, VarSet, VarTypes,
AllArgVars, InstVarSet, AllArgModes, Detism,
LambdaGoal, RttiVarMaps, address_is_taken, ProcInfo0),
@@ -562,17 +543,13 @@
MustRecomputeNonLocals0 = no,
ProcInfo = ProcInfo1
),
-
set__init(Assertions),
+ pred_info_create(ModuleName, PredName, PredOrFunc, LambdaContext,
+ lambda(OrigFile, OrigLine, LambdaCount), local, LambdaMarkers,
+ ArgTypes, TVarSet, ExistQVars, Constraints, Assertions, Owner,
+ ProcInfo, ProcId, PredInfo),
- pred_info_create(ModuleName, PredName, PredOrFunc,
- LambdaContext, lambda(OrigFile, OrigLine, LambdaCount),
- local, LambdaMarkers, ArgTypes, TVarSet, ExistQVars,
- Constraints, Assertions, Owner, ProcInfo, ProcId,
- PredInfo),
-
- % save the new predicate in the predicate table
-
+ % Save the new predicate in the predicate table.
module_info_get_predicate_table(ModuleInfo1, PredicateTable0),
predicate_table_insert(PredInfo, PredId,
PredicateTable0, PredicateTable),
@@ -589,31 +566,35 @@
InstVarSet, RttiVarMaps, Markers, POF, OrigPredName, Owner,
ModuleInfo, MustRecomputeNonLocals).
-:- pred lambda__constraint_contains_vars(list(tvar)::in, prog_constraint::in)
+:- pred constraint_contains_vars(list(tvar)::in, prog_constraint::in)
is semidet.
-lambda__constraint_contains_vars(LambdaVars, ClassConstraint) :-
+constraint_contains_vars(LambdaVars, ClassConstraint) :-
ClassConstraint = constraint(_, ConstraintTypes),
list__map(prog_type__vars, ConstraintTypes, ConstraintVarsList),
list__condense(ConstraintVarsList, ConstraintVars),
- % Probably not the most efficient way of doing it, but I
- % wouldn't think that it matters.
+ % Probably not the most efficient way of doing it, but I wouldn't think
+ % that it matters.
set__list_to_set(LambdaVars, LambdaVarsSet),
set__list_to_set(ConstraintVars, ConstraintVarsSet),
set__subset(ConstraintVarsSet, LambdaVarsSet).
-:- pred lambda__uni_modes_to_modes(list(uni_mode)::in, list(mode)::out)
- is det.
-
- % This predicate works out the modes of the original non-local
- % variables of a lambda expression based on the list of uni_mode
- % in the unify_info for the lambda unification.
+ % This predicate works out the modes of the original non-local variables
+ % of a lambda expression based on the list of uni_mode in the unify_info
+ % for the lambda unification.
+ %
+:- pred uni_modes_to_modes(list(uni_mode)::in, list(mode)::out) is det.
-lambda__uni_modes_to_modes([], []).
-lambda__uni_modes_to_modes([UniMode | UniModes], [Mode | Modes]) :-
+uni_modes_to_modes([], []).
+uni_modes_to_modes([UniMode | UniModes], [Mode | Modes]) :-
UniMode = ((_Initial0 - Initial1) -> (_Final0 - _Final1)),
Mode = (Initial1 -> Initial1),
- lambda__uni_modes_to_modes(UniModes, Modes).
+ uni_modes_to_modes(UniModes, Modes).
%---------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "lambda.m".
+
%---------------------------------------------------------------------------%
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/construct.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/construct.m,v
retrieving revision 1.21
diff -u -b -r1.21 construct.m
--- library/construct.m 1 Sep 2005 07:36:13 -0000 1.21
+++ library/construct.m 18 Sep 2005 10:41:49 -0000
@@ -1,3 +1,4 @@
+%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2002-2005 The University of Melbourne.
Index: library/deconstruct.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/deconstruct.m,v
retrieving revision 1.30
diff -u -b -r1.30 deconstruct.m
--- library/deconstruct.m 16 Jun 2005 04:08:00 -0000 1.30
+++ library/deconstruct.m 18 Sep 2005 10:51:11 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 2002-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
@@ -101,9 +103,8 @@
% functor(Data, NonCanon, Functor, Arity)
%
- % Given a data item (Data), binds Functor to a string
- % representation of the functor and Arity to the arity of this
- % data item.
+ % Given a data item (Data), binds Functor to a string representation
+ % of the functor and Arity to the arity of this data item.
%
:- pred functor(T, noncanon_handling, string, int).
:- mode functor(in, in(do_not_allow), out, out) is det.
@@ -128,9 +129,8 @@
:- mode arg(in, in(canonicalize), in, out) is semidet.
:- mode arg(in, in(canonicalize_or_do_not_allow), in, out) is semidet.
- % arg_cc/3 is similar to arg/4, except that it
- % handles arguments with non-canonical types.
- % See the documentation of std_util__arg_cc.
+ % arg_cc/3 is similar to arg/4, except that it handles arguments with
+ % non-canonical types. See the documentation of std_util__arg_cc.
%
:- pred arg_cc(T::in, int::in, std_util__maybe_arg::out) is cc_multi.
@@ -145,15 +145,15 @@
:- mode named_arg(in, in(canonicalize), in, out) is semidet.
:- mode named_arg(in, in(canonicalize_or_do_not_allow), in, out) is semidet.
- % named_arg_cc/3 is similar to named_arg/4, except that it
- % handles arguments with non-canonical types.
+ % named_arg_cc/3 is similar to named_arg/4, except that it handles
+ % arguments with non-canonical types.
%
:- pred named_arg_cc(T::in, string::in, std_util__maybe_arg::out) is cc_multi.
% det_arg(Data, NonCanon, Index, Argument)
%
- % Same as arg/4, except that for cases where
- % arg/4 would fail, det_arg/4 will abort.
+ % Same as arg/4, except that for cases where arg/4 would fail,
+ % det_arg/4 will abort.
%
:- some [ArgT] pred det_arg(T, noncanon_handling, int, ArgT).
:- mode det_arg(in, in(do_not_allow), in, out) is det.
@@ -163,8 +163,8 @@
% det_named_arg(Data, NonCanon, Name, Argument)
%
- % Same as named_arg/4, except that for cases where
- % named_arg/4 would fail, det_named_arg/4 will abort.
+ % Same as named_arg/4, except that for cases where named_arg/4 would fail,
+ % det_named_arg/4 will abort.
%
:- some [ArgT] pred det_named_arg(T, noncanon_handling, string, ArgT).
:- mode det_named_arg(in, in(do_not_allow), in, out) is det.
@@ -174,10 +174,10 @@
% deconstruct(Data, NonCanon, Functor, Arity, Arguments)
%
- % Given a data item (Data), binds Functor to a string
- % representation of the functor, Arity to the arity of this data
- % item, and Arguments to a list of arguments of the functor.
- % The arguments in the list are each of type univ.
+ % Given a data item (Data), binds Functor to a string representation
+ % of the functor, Arity to the arity of this data item, and Arguments
+ % to a list of arguments of the functor. The arguments in the list
+ % are each of type univ.
%
% The cost of calling deconstruct depends greatly on how many arguments
% Data has. If Data is an array, then each element of the array is
@@ -243,6 +243,7 @@
% to represent procedure bodies for ordinary procedures. For the time
% being, these are procedures that do not involve higher order code
% or tabling.
+ %
:- pred get_functor_info(univ::in, functor_tag_info::out) is semidet.
%-----------------------------------------------------------------------------%
@@ -339,28 +340,31 @@
MaybeArg = std_util__no_arg
).
- % This is a dummy value of type `univ'.
- % It is used only to ensure that the C interface procedure
- % univ_named_arg_idcc doesn't return an uninitialized
- % (or otherwise bogus) univ value.
+ % This is a dummy value of type `univ'. It is used only to ensure that
+ % the C interface procedure univ_named_arg_idcc doesn't return an
+ % uninitialized (or otherwise bogus) univ value.
+ %
:- func dummy_univ = univ.
dummy_univ = univ(0).
det_arg(Term, NonCanon, Index, Argument) :-
- ( NonCanon = do_not_allow,
+ (
+ NonCanon = do_not_allow,
( univ_arg_dna(Term, Index, Univ0) ->
Univ = Univ0
;
error("det_arg: argument number out of range")
)
- ; NonCanon = canonicalize,
+ ;
+ NonCanon = canonicalize,
( univ_arg_can(Term, Index, Univ0) ->
Univ = Univ0
;
error("det_arg: argument number out of range")
)
- ; NonCanon = include_details_cc,
+ ;
+ NonCanon = include_details_cc,
univ_arg_idcc(Term, Index, dummy_univ, Univ0, Success),
( Success \= 0 ->
Univ = Univ0
@@ -380,13 +384,11 @@
univ_named_arg_can(Term, Name, Univ)
;
NonCanon = include_details_cc,
- univ_named_arg_idcc(Term, Name, dummy_univ, Univ0,
- Success),
+ univ_named_arg_idcc(Term, Name, dummy_univ, Univ0, Success),
( Success \= 0 ->
Univ = Univ0
;
- error("det_named_arg: " ++
- "no argument with that name")
+ error("det_named_arg: no argument with that name")
)
)
->
@@ -410,12 +412,10 @@
limited_deconstruct(Term, NonCanon, MaxArity, Functor, Arity, Arguments) :-
(
NonCanon = do_not_allow,
- limited_deconstruct_dna(Term, MaxArity,
- Functor, Arity, Arguments)
+ limited_deconstruct_dna(Term, MaxArity, Functor, Arity, Arguments)
;
NonCanon = canonicalize,
- limited_deconstruct_can(Term, MaxArity,
- Functor, Arity, Arguments)
+ limited_deconstruct_can(Term, MaxArity, Functor, Arity, Arguments)
;
NonCanon = include_details_cc,
error("limited_deconstruct called with include_details_cc")
@@ -508,10 +508,11 @@
:- pred univ_arg_can(T::in, int::in, univ::out) is semidet.
% univ_arg_idcc(Term, N, DummyUniv, Argument, Success):
- % Attempt to extract the Nth field of (the current
- % representation of) Term. If there is such a field,
- % return Success=1 and return the field in Argument.
- % If there is not, return Success=0 and Argument=DummyUniv.
+ %
+ % Attempt to extract the Nth field of (the current representation of) Term.
+ % If there is such a field, return Success=1 and return the field in
+ % Argument. If there is not, return Success=0 and Argument=DummyUniv.
+ %
:- pred univ_arg_idcc(T::in, int::in, univ::in, univ::out, int::out)
is cc_multi.
@@ -519,10 +520,11 @@
:- pred univ_named_arg_can(T::in, string::in, univ::out) is semidet.
% univ_named_arg_idcc(Term, Name, DummyUniv, Univ, Success):
- % Attempt to extract the field of (the current representation of)
- % Term specified by Name. If there is such a field,
- % return Success=1 and return the field in Univ.
- % If there is not, return Success=0 and Univ=DummyUniv.
+ %
+ % Attempt to extract the field of (the current representation of) Term
+ % specified by Name. If there is such a field, return Success=1 and return
+ % the field in Univ. If there is not, return Success=0 and Univ=DummyUniv.
+ %
:- pred univ_named_arg_idcc(T::in, string::in, univ::in, univ::out, int::out)
is cc_multi.
@@ -671,23 +673,22 @@
}").
-% XXX These Mercury implementations are all inefficient,
-% since they unnecessarily construct the list of univs
-% for all the arguments, rather than just constructing
-% one univ for the argument selected.
+% XXX These Mercury implementations are all inefficient, since they
+% unnecessarily construct the list of univs for all the arguments, rather than
+% just constructing one univ for the argument selected.
univ_arg_dna(Term::in, Index::in, Arg::out) :-
- rtti_implementation__deconstruct(Term,
- do_not_allow, _Functor, _Arity, Arguments),
+ rtti_implementation__deconstruct(Term, do_not_allow,
+ _Functor, _Arity, Arguments),
list__index0(Arguments, Index, Arg).
univ_arg_can(Term::in, Index::in, Arg::out) :-
- rtti_implementation__deconstruct(Term,
- canonicalize, _Functor, _Arity, Arguments),
+ rtti_implementation__deconstruct(Term, canonicalize,
+ _Functor, _Arity, Arguments),
list__index0(Arguments, Index, Arg).
univ_arg_idcc(Term::in, Index::in, DummyUniv::in, Argument::out,
Success::out) :-
- rtti_implementation__deconstruct(Term,
- include_details_cc, _Functor, _Arity, Arguments),
+ rtti_implementation__deconstruct(Term, include_details_cc,
+ _Functor, _Arity, Arguments),
( list__index0(Arguments, Index, Arg) ->
Argument = Arg,
Success = 1
@@ -862,10 +863,9 @@
if (!success) {
/*
- ** Fill in some dummy values, to ensure that we don't
- ** try to return uninitialized memory to Mercury.
- ** It doesn't matter what we put here, except that
- ** we must have Arity > MaxArity. The casts cast away
+ ** Fill in some dummy values, to ensure that we don't try to return
+ ** uninitialized memory to Mercury. It doesn't matter what we put here,
+ ** except that we must have Arity > MaxArity. The casts cast away
** const.
*/
@@ -876,33 +876,33 @@
}").
deconstruct_dna(Term::in, Functor::out, Arity::out, Arguments::out) :-
- rtti_implementation__deconstruct(Term,
- do_not_allow, Functor, Arity, Arguments).
+ rtti_implementation__deconstruct(Term, do_not_allow,
+ Functor, Arity, Arguments).
deconstruct_can(Term::in, Functor::out, Arity::out, Arguments::out) :-
- rtti_implementation__deconstruct(Term,
- canonicalize, Functor, Arity, Arguments).
+ rtti_implementation__deconstruct(Term, canonicalize,
+ Functor, Arity, Arguments).
deconstruct_idcc(Term::in, Functor::out, Arity::out, Arguments::out) :-
- rtti_implementation__deconstruct(Term,
- include_details_cc, Functor, Arity, Arguments).
+ rtti_implementation__deconstruct(Term, include_details_cc,
+ Functor, Arity, Arguments).
% XXX The Mercury implementations of all of these limited_* procedures
- % are inefficient -- they construct Functor and Arguments even in
- % the case when Arity > MaxArity.
+ % are inefficient -- they construct Functor and Arguments even in the case
+ % when Arity > MaxArity.
limited_deconstruct_dna(Term::in, MaxArity::in,
Functor::out, Arity::out, Arguments::out) :-
- rtti_implementation__deconstruct(Term,
- do_not_allow, Functor, Arity, Arguments),
+ rtti_implementation__deconstruct(Term, do_not_allow,
+ Functor, Arity, Arguments),
Arity =< MaxArity.
limited_deconstruct_can(Term::in, MaxArity::in,
Functor::out, Arity::out, Arguments::out) :-
- rtti_implementation__deconstruct(Term,
- canonicalize, Functor, Arity, Arguments),
+ rtti_implementation__deconstruct(Term, canonicalize,
+ Functor, Arity, Arguments),
Arity =< MaxArity.
limited_deconstruct_idcc(Term::in, _MaxArity::in,
Functor::out, Arity::out, Arguments::out) :-
% For this one, the caller checks Arity =< MaxArity.
- rtti_implementation__deconstruct(Term,
- include_details_cc, Functor, Arity, Arguments).
+ rtti_implementation__deconstruct(Term, include_details_cc,
+ Functor, Arity, Arguments).
%-----------------------------------------------------------------------------%
@@ -916,7 +916,7 @@
; get_enum_functor_info(Univ, Enum) ->
FunctorInfo = functor_enum(Enum)
%
- % XXX we should handle reserved_addr types here
+ % XXX We should handle reserved_addr types here.
%
; get_du_functor_info(Univ, Where, Ptag, Sectag, Args) ->
( Where = 0 ->
@@ -937,6 +937,7 @@
% Given a value of an arbitrary type, succeed if its type is defined
% as a notag type, and return a univ which bundles up the value
% with the type of the single function symbol of the notag type.
+ %
:- pred get_notag_functor_info(univ::in, univ::out) is semidet.
:- pragma foreign_proc("C",
@@ -955,8 +956,7 @@
case MR_TYPECTOR_REP_NOTAG:
case MR_TYPECTOR_REP_NOTAG_USEREQ:
- functor_desc = MR_type_ctor_functors(type_ctor_info).
- MR_functors_notag;
+ functor_desc = MR_type_ctor_functors(type_ctor_info).MR_functors_notag;
exp_type_info = MR_pseudo_type_info_is_ground(
functor_desc->MR_notag_functor_arg_type);
MR_new_univ_on_hp(ExpUniv, exp_type_info, value);
@@ -965,11 +965,9 @@
case MR_TYPECTOR_REP_NOTAG_GROUND:
case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
- functor_desc = MR_type_ctor_functors(type_ctor_info).
- MR_functors_notag;
+ functor_desc = MR_type_ctor_functors(type_ctor_info).MR_functors_notag;
exp_type_info = MR_create_type_info(
- MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(
- type_info),
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
functor_desc->MR_notag_functor_arg_type);
MR_new_univ_on_hp(ExpUniv, exp_type_info, value);
SUCCESS_INDICATOR = MR_TRUE;
@@ -986,6 +984,7 @@
% as an equivalence type, and return a univ which bundles up the value
% with the equivalent type. (I.e. this removes one layer of equivalence
% from the type stored in the univ.)
+ %
:- pred get_equiv_functor_info(univ::in, univ::out) is semidet.
:- pragma foreign_proc("C",
@@ -1025,6 +1024,7 @@
% Given a value of an arbitrary type, succeed if it is an enum type,
% and return the integer value corresponding to the value.
+ %
:- pred get_enum_functor_info(univ::in, int::out) is semidet.
:- pragma foreign_proc("C",
@@ -1052,14 +1052,14 @@
}
}").
- % Given a value of an arbitrary type, succeed if it is a general du
- % type (i.e. non-enum, non-notag du type), and return the top function
- % symbol's arguments as well as its tag information: an indication of
- % where the secondary tag is (-1 for local secondary tag, 0 for
- % nonexistent secondary tag, and 1 for remote secondary tag),
- % as well as the primary and secondary tags themselves (the secondary
- % tag argument will be meaningful only if the secondary tag exists,
- % of course).
+ % Given a value of an arbitrary type, succeed if it is a general du type
+ % (i.e. non-enum, non-notag du type), and return the top function symbol's
+ % arguments as well as its tag information: an indication of where the
+ % secondary tag is (-1 for local secondary tag, 0 for nonexistent secondary
+ % tag, and 1 for remote secondary tag), as well as the primary and
+ % secondary tags themselves (the secondary tag argument will be meaningful
+ % only if the secondary tag exists, of course).
+ %
:- pred get_du_functor_info(univ::in, int::out, int::out, int::out,
list(univ)::out) is semidet.
@@ -1086,8 +1086,7 @@
SUCCESS_INDICATOR = MR_TRUE;
Ptag = MR_tag(value);
- ptag_layout = &MR_type_ctor_layout(type_ctor_info).
- MR_layout_du[Ptag];
+ ptag_layout = &MR_type_ctor_layout(type_ctor_info).MR_layout_du[Ptag];
switch(ptag_layout->MR_sectag_locn) {
@@ -1122,13 +1121,12 @@
break;
case MR_SECTAG_VARIABLE:
- MR_fatal_error(
- ""get_du_functor_info: unexpected variable"");
+ MR_fatal_error(""get_du_functor_info: unexpected variable"");
default:
- MR_fatal_error(
- ""get_du_functor_info: unknown sectag locn"");
+ MR_fatal_error(""get_du_functor_info: unknown sectag locn"");
}
+
break;
default:
@@ -1141,8 +1139,8 @@
:- pragma foreign_code("C", "
/*
-** MR_make_arg_list is called from only one place above. If this changes, we
-** will need a mechanism to charge the memory we allocate here to the
+** MR_make_arg_list is called from only one place above. If this changes,
+** we will need a mechanism to charge the memory we allocate here to the
** right caller.
*/
@@ -1160,8 +1158,7 @@
if (MR_arg_type_may_contain_var(functor_desc, i)) {
arg_type_info = MR_create_type_info_maybe_existq(
- MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(
- type_info),
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
functor_desc->MR_du_functor_arg_types[i],
arg_vector, functor_desc);
} else {
Index: library/io.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.332
diff -u -b -r1.332 io.m
--- library/io.m 14 Jun 2005 17:32:29 -0000 1.332
+++ library/io.m 18 Sep 2005 10:24:32 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------r
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%-----------------------------------------------------------------------------r
% Copyright (C) 1993-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
@@ -117,6 +119,7 @@
%
% Text input predicates.
%
+
% Reads a character from the current input stream.
%
:- pred io__read_char(io__result(char)::out, io::di, io::uo) is det.
@@ -125,13 +128,13 @@
%
:- pred io__read_word(io__result(list(char))::out, io::di, io::uo) is det.
- % Reads a line from the current input stream, returns the
- % the result as a list of chars.
+ % Reads a line from the current input stream, returns the the result
+ % as a list of chars.
%
:- pred io__read_line(io__result(list(char))::out, io::di, io::uo) is det.
- % Reads a line from the current input stream, returns the
- % result as a string.
+ % Reads a line from the current input stream, returns the result
+ % as a string.
%
:- pred io__read_line_as_string(io__result(string)::out, io::di, io::uo)
is det.
@@ -178,9 +181,9 @@
:- mode io__input_stream_foldl2_io((pred(in, in, out, di, uo) is cc_multi),
in, out, di, uo) is cc_multi.
- % Applies the given closure to each character read from
- % the input stream in turn, until eof or error, or the
- % closure returns `no' as its second argument.
+ % Applies the given closure to each character read from the input stream
+ % in turn, until eof or error, or the closure returns `no' as its
+ % second argument.
%
:- pred io__input_stream_foldl2_io_maybe_stop(
pred(char, bool, T, T, io, io),
@@ -197,8 +200,7 @@
% You can even put back something that you didn't actually read.
% Note: `io__putback_char' uses the C library function ungetc().
% On some systems only one character of pushback is guaranteed.
- % `io__putback_char' will throw an io__error exception
- % if ungetc() fails.
+ % `io__putback_char' will throw an io__error exception if ungetc() fails.
%
:- pred io__putback_char(char::in, io::di, io::uo) is det.
@@ -230,9 +232,8 @@
:- pred io__read_file(io__input_stream::in,
io__maybe_partial_res(list(char))::out, io::di, io::uo) is det.
- % Reads all the characters from the given input stream until
- % eof or error. Returns the result as a string rather than
- % as a list of char.
+ % Reads all the characters from the given input stream until eof or error.
+ % Returns the result as a string rather than as a list of char.
%
:- pred io__read_file_as_string(io__input_stream::in,
io__maybe_partial_res(string)::out, io::di, io::uo) is det.
@@ -270,9 +271,9 @@
in(pred(in, in, out, di, uo) is cc_multi),
in, out, di, uo) is cc_multi.
- % Applies the given closure to each character read from
- % the input stream in turn, until eof or error, or the
- % closure returns `no' as its second argument.
+ % Applies the given closure to each character read from the input stream
+ % in turn, until eof or error, or the closure returns `no' as its
+ % second argument.
%
:- pred io__input_stream_foldl2_io_maybe_stop(io__input_stream,
pred(char, bool, T, T, io, io),
@@ -289,33 +290,28 @@
% You can even put back something that you didn't actually read.
% Note: `io__putback_char' uses the C library function ungetc().
% On some systems only one character of pushback is guaranteed.
- % `io__putback_char' will throw an io__error exception
- % if ungetc() fails.
+ % `io__putback_char' will throw an io__error exception if ungetc() fails.
%
:- pred io__putback_char(io__input_stream::in, char::in, io::di, io::uo)
is det.
- % Reads a ground term of any type, written using standard
- % Mercury syntax, from the current or specified input stream.
- % The type of the term read is determined by the context
- % in which `io__read' is used.
- %
- % First, the input stream is read until an end-of-term token,
- % end-of-file, or I/O error is reached. (An end-of-term
- % token consists of a `.' followed by whitespace.
- % The trailing whitespace is left in the input stream.)
- %
- % Then, the result is determined according to the tokens read.
- % If there were no non-whitespace characters before the
- % end of file, then `io__read' returns `eof'.
- % If the tokens read formed a syntactically correct ground term
- % of the correct type, followed by an end-of-term token,
- % then it returns `ok(Term)'. If characters read from
- % the input stream did not form a syntactically
- % correct term, or if the term read is not a ground term,
- % or if the term is not a valid term of the appropriate type,
- % or if an I/O error is encountered, then it returns
- % `error(Message, LineNumber)'.
+ % Reads a ground term of any type, written using standard Mercury syntax,
+ % from the current or specified input stream. The type of the term read
+ % is determined by the context in which `io__read' is used.
+ %
+ % First, the input stream is read until an end-of-term token, end-of-file,
+ % or I/O error is reached. (An end-of-term token consists of a `.'
+ % followed by whitespace. The trailing whitespace is left in the input
+ % stream.)
+ %
+ % Then, the result is determined according to the tokens read. If there
+ % were no non-whitespace characters before the end of file, then `io__read'
+ % returns `eof'. If the tokens read formed a syntactically correct ground
+ % term of the correct type, followed by an end-of-term token, then it
+ % returns `ok(Term)'. If characters read from the input stream did not form
+ % a syntactically correct term, or if the term read is not a ground term,
+ % or if the term is not a valid term of the appropriate type, or if an
+ % I/O error is encountered, then it returns `error(Message, LineNumber)'.
%
:- pred io__read(io__read_result(T)::out, io::di, io::uo) is det.
:- pred io__read(io__input_stream::in, io__read_result(T)::out, io::di, io::uo)
@@ -324,24 +320,21 @@
% The type `posn' represents a position within a string.
:- type posn
---> posn(int, int, int).
- % line number, offset of start of line, current offset
- % (the first two are used only for the purposes of
- % computing term_contexts, for use e.g. in error messages).
- % Offsets start at zero.
+ % line number, offset of start of line, current offset (the first
+ % two are used only for the purposes of computing term_contexts,
+ % for use e.g. in error messages). Offsets start at zero.
% io__read_from_string(FileName, String, MaxPos, Result, Posn0, Posn):
- % Same as io__read/4 except that it reads from
- % a string rather than from a stream.
+ % Same as io__read/4 except that it reads from a string rather than
+ % from a stream.
% FileName is the name of the source (for use in error messages).
% String is the string to be parsed.
% Posn0 is the position to start parsing from.
% Posn is the position one past where the term read in ends.
- % MaxPos is the offset in the string which should be
- % considered the end-of-stream -- this is the upper bound
- % for Posn. (In the usual case, MaxPos is just the length
- % of the String.)
- % WARNING: if MaxPos > length of String then the behaviour
- % is UNDEFINED.
+ % MaxPos is the offset in the string which should be considered the
+ % end-of-stream -- this is the upper bound for Posn. (In the usual case,
+ % MaxPos is just the length of the String.)
+ % WARNING: if MaxPos > length of String then the behaviour is UNDEFINED.
%
:- pred io__read_from_string(string::in, string::in, int::in,
io__read_result(T)::out, posn::in, posn::out) is det.
@@ -363,35 +356,32 @@
% These will all throw an io__error exception if an I/O error occurs.
% io__print/3 writes its argument to the standard output stream.
- % io__print/4 writes its second argument to the output stream
- % specified in its first argument.
- % In all cases, the argument to output can be of any type.
- % It is output in a format that is intended to be human readable.
- %
- % If the argument is just a single string or character, it
- % will be printed out exactly as is (unquoted).
- % If the argument is of type univ, then it will print out
- % the value stored in the univ, but not the type.
- %
- % io__print/5 is the same as io__print/4 except that it allows
- % the caller to specify how non-canonical types should be handled.
- % io__print/3 and io__print/4 implicitly specify `canonicalize'
- % as the method for handling non-canonical types. This means
- % that for higher-order types, or types with user-defined
- % equality axioms, or types defined using the foreign language
- % interface (i.e. c_pointer type or pragma foreign_type),
- % the text output will only describe the type that is being
- % printed, not the value.
- %
- % io__print_cc/3 is the same as io__print/3 except that it
- % specifies `include_details_cc' rather than `canonicalize'.
- % This means that it will print the details of non-canonical
- % types. However, it has determinism `cc_multi'.
- %
- % Note that even if `include_details_cc' is specified,
- % some implementations may not be able to print all the details
- % for higher-order types or types defined using the foreign
- % language interface.
+ % io__print/4 writes its second argument to the output stream specified
+ % in its first argument. In all cases, the argument to output can be
+ % of any type. It is output in a format that is intended to be human
+ % readable.
+ %
+ % If the argument is just a single string or character, it will be printed
+ % out exactly as is (unquoted). If the argument is of type univ, then
+ % it will print out the value stored in the univ, but not the type.
+ %
+ % io__print/5 is the same as io__print/4 except that it allows the caller
+ % to specify how non-canonical types should be handled. io__print/3 and
+ % io__print/4 implicitly specify `canonicalize' as the method for handling
+ % non-canonical types. This means that for higher-order types, or types
+ % with user-defined equality axioms, or types defined using the foreign
+ % language interface (i.e. c_pointer type or pragma foreign_type),
+ % the text output will only describe the type that is being printed,
+ % not the value.
+ %
+ % io__print_cc/3 is the same as io__print/3 except that it specifies
+ % `include_details_cc' rather than `canonicalize'. This means that it will
+ % print the details of non-canonical types. However, it has determinism
+ % `cc_multi'.
+ %
+ % Note that even if `include_details_cc' is specified, some implementations
+ % may not be able to print all the details for higher-order types or types
+ % defined using the foreign language interface.
%
:- pred io__print(T::in, io::di, io::uo) is det.
@@ -407,29 +397,26 @@
:- pred io__print_cc(T::in, io::di, io::uo) is cc_multi.
% io__write/3 writes its argument to the current output stream.
- % io__write/4 writes its second argument to the output stream
- % specified in its first argument.
- % In all cases, the argument to output may be of any type.
- % The argument is written in a format that is intended to
+ % io__write/4 writes its second argument to the output stream specified
+ % in its first argument. In all cases, the argument to output may be
+ % of any type. The argument is written in a format that is intended to
% be valid Mercury syntax whenever possible.
%
- % Strings and characters are always printed out in quotes,
- % using backslash escapes if necessary.
- % For higher-order types, or for types defined using the
- % foreign language interface (pragma foreign_code), the text
- % output will only describe the type that is being printed, not
- % the value, and the result may not be parsable by `io__read'.
- % For the types containing existential quantifiers,
- % the type `type_desc' and closure types, the result may not be
- % parsable by `io__read', either. But in all other cases the
- % format used is standard Mercury syntax, and if you append a
- % period and newline (".\n"), then the results can be read in
- % again using `io__read'.
- %
- % io__write/5 is the same as io__write/4 except that it allows
- % the caller to specify how non-canonical types should be handled.
- % io__write_cc/3 is the same as io__write/3 except that it
- % specifies `include_details_cc' rather than `canonicalize'.
+ % Strings and characters are always printed out in quotes, using backslash
+ % escapes if necessary. For higher-order types, or for types defined
+ % using the foreign language interface (pragma foreign_code), the text
+ % output will only describe the type that is being printed, not the value,
+ % and the result may not be parsable by `io__read'. For the types
+ % containing existential quantifiers, the type `type_desc' and closure
+ % types, the result may not be parsable by `io__read', either. But in all
+ % other cases the format used is standard Mercury syntax, and if you append
+ % a period and newline (".\n"), then the results can be read in again
+ % using `io__read'.
+ %
+ % io__write/5 is the same as io__write/4 except that it allows the caller
+ % to specify how non-canonical types should be handled. io__write_cc/3
+ % is the same as io__write/3 except that it specifies `include_details_cc'
+ % rather than `canonicalize'.
%
:- pred io__write(T::in, io::di, io::uo) is det.
@@ -558,8 +545,7 @@
% Closes the current input stream.
% The current input stream reverts to standard input.
- % This will throw an io__error exception
- % if an I/O error occurs.
+ % This will throw an io__error exception if an I/O error occurs.
%
:- pred io__seen(io::di, io::uo) is det.
@@ -569,14 +555,12 @@
:- pred io__open_input(string::in, io__res(io__input_stream)::out,
io::di, io::uo) is det.
- % Closes an open input stream.
- % This will throw an io__error exception
+ % Closes an open input stream. This will throw an io__error exception
% if an I/O error occurs.
%
:- pred io__close_input(io__input_stream::in, io::di, io::uo) is det.
- % Retrieves the current input stream.
- % Does not modify the IO state.
+ % Retrieves the current input stream. Does not modify the IO state.
%
:- pred io__input_stream(io__input_stream::out, io::di, io::uo) is det.
@@ -587,35 +571,32 @@
:- pred io__set_input_stream(io__input_stream::in, io__input_stream::out,
io::di, io::uo) is det.
- % Retrieves the standard input stream.
- % Does not modify the IO state.
+ % Retrieves the standard input stream. Does not modify the IO state.
%
:- pred io__stdin_stream(io__input_stream::out, io::di, io::uo) is det.
% Retrieves the human-readable name associated with the current input
- % stream.
- % For file streams, this is the filename.
- % For stdin this is the string "<standard input>".
+ % stream. For file streams, this is the filename. For stdin,
+ % this is the string "<standard input>".
%
:- pred io__input_stream_name(string::out, io::di, io::uo) is det.
% Retrieves the human-readable name associated with the specified input
- % stream.
- % For file streams, this is the filename.
- % For stdin this is the string "<standard input>".
+ % stream. For file streams, this is the filename. For stdin,
+ % this is the string "<standard input>".
%
:- pred io__input_stream_name(io__input_stream::in, string::out,
io::di, io::uo) is det.
- % Return the line number of the current input stream.
- % Lines are normally numbered starting at 1
- % (but this can be overridden by calling io__set_line_number).
+ % Return the line number of the current input stream. Lines are normally
+ % numbered starting at 1, but this can be overridden by calling
+ % io__set_line_number.
%
:- pred io__get_line_number(int::out, io::di, io::uo) is det.
- % Return the line number of the specified input stream.
- % Lines are normally numbered starting at 1
- % (but this can be overridden by calling io__set_line_number).
+ % Return the line number of the specified input stream. Lines are normally
+ % numbered starting at 1, but this can be overridden by calling
+ % io__set_line_number.
%
:- pred io__get_line_number(io__input_stream::in, int::out, io::di, io::uo)
is det.
@@ -633,15 +614,16 @@
%
% Output text stream predicates.
%
- % Attempts to open a file for output, and if successful
- % sets the current output stream to the newly opened stream.
- % As per Prolog tell/1. Result is either 'ok' or 'error(ErrCode)'.
+
+ % Attempts to open a file for output, and if successful sets the current
+ % output stream to the newly opened stream. As per Prolog tell/1.
+ % Result is either 'ok' or 'error(ErrCode)'.
%
:- pred io__tell(string::in, io__res::out, io::di, io::uo) is det.
- % Closes the current output stream; the default output stream
- % reverts to standard output. As per Prolog told/0.
- % This will throw an io__error exception if an I/O error occurs.
+ % Closes the current output stream; the default output stream reverts
+ % to standard output. As per Prolog told/0. This will throw an
+ % io__error exception if an I/O error occurs.
%
:- pred io__told(io::di, io::uo) is det.
@@ -662,25 +644,21 @@
%
:- pred io__close_output(io__output_stream::in, io::di, io::uo) is det.
- % Retrieves the current output stream.
- % Does not modify the IO state.
+ % Retrieves the current output stream. Does not modify the IO state.
%
:- pred io__output_stream(io__output_stream::out, io::di, io::uo) is det.
- % io__set_output_stream(NewStream, OldStream, !IO):
% Changes the current output stream to the stream specified.
% Returns the previous stream.
%
:- pred io__set_output_stream(io__output_stream::in, io__output_stream::out,
io::di, io::uo) is det.
- % Retrieves the standard output stream.
- % Does not modify the IO state.
+ % Retrieves the standard output stream. Does not modify the IO state.
%
:- pred io__stdout_stream(io__output_stream::out, io::di, io::uo) is det.
- % Retrieves the standard error stream.
- % Does not modify the IO state.
+ % Retrieves the standard error stream. Does not modify the IO state.
%
:- pred io__stderr_stream(io__output_stream::out, io::di, io::uo) is det.
@@ -692,8 +670,7 @@
%
:- pred io__output_stream_name(string::out, io::di, io::uo) is det.
- % Retrieves the human-readable name associated with the specified
- % stream.
+ % Retrieves the human-readable name associated with the specified stream.
% For file streams, this is the filename.
% For stdout this is the string "<standard output>".
% For stderr this is the string "<standard error>".
@@ -701,15 +678,15 @@
:- pred io__output_stream_name(io__output_stream::in, string::out,
io::di, io::uo) is det.
- % Return the line number of the current output stream.
- % Lines are normally numbered starting at 1
- % (but this can be overridden by calling io__set_output_line_number).
+ % Return the line number of the current output stream. Lines are normally
+ % numbered starting at 1, but this can be overridden by calling
+ % io__set_output_line_number.
%
:- pred io__get_output_line_number(int::out, io::di, io::uo) is det.
- % Return the line number of the specified output stream.
- % Lines are normally numbered starting at 1
- % (but this can be overridden by calling io__set_output_line_number).
+ % Return the line number of the specified output stream. Lines are normally
+ % numbered starting at 1, but this can be overridden by calling
+ % io__set_output_line_number.
%
:- pred io__get_output_line_number(io__output_stream::in, int::out,
io::di, io::uo) is det.
@@ -728,19 +705,19 @@
% Binary input predicates.
%
- % Reads a binary representation of a term of type T
- % from the current binary input stream.
+ % Reads a binary representation of a term of type T from the current
+ % binary input stream.
%
:- pred io__read_binary(io__result(T)::out, io::di, io::uo) is det.
- % Reads a binary representation of a term of type T
- % from the specified binary input stream.
+ % Reads a binary representation of a term of type T from the specified
+ % binary input stream.
%
- % Note: if you attempt to read a binary representation written
- % by a different program, or a different version of the same
- % program, then the results are not guaranteed to be meaningful.
- % Another caveat is that higher-order types cannot be read.
- % (If you try, you will get a runtime error.)
+ % Note: if you attempt to read a binary representation written by a
+ % different program, or a different version of the same program,
+ % then the results are not guaranteed to be meaningful. Another caveat
+ % is that higher-order types cannot be read. (If you try, you will get
+ % a runtime error.)
%
% XXX Note also that due to the current implementation,
% io__read_binary will not work for the Java back-end.
@@ -769,8 +746,8 @@
:- pred io__read_binary_file(io__input_stream::in, io__result(list(int))::out,
io::di, io::uo) is det.
- % Applies the given closure to each byte read from the
- % current binary input stream in turn, until eof or error.
+ % Applies the given closure to each byte read from the current binary
+ % input stream in turn, until eof or error.
%
:- pred io__binary_input_stream_foldl(pred(int, T, T),
T, io__maybe_partial_res(T), io, io).
@@ -779,8 +756,8 @@
:- mode io__binary_input_stream_foldl((pred(in, in, out) is cc_multi),
in, out, di, uo) is cc_multi.
- % Applies the given closure to each byte read from the
- % current binary input stream in turn, until eof or error.
+ % Applies the given closure to each byte read from the current binary
+ % input stream in turn, until eof or error.
%
:- pred io__binary_input_stream_foldl_io(pred(int, io, io),
io__res, io, io).
@@ -789,35 +766,29 @@
:- mode io__binary_input_stream_foldl_io((pred(in, di, uo) is cc_multi),
out, di, uo) is cc_multi.
- % Applies the given closure to each byte read from the
- % current binary input stream in turn, until eof or error.
+ % Applies the given closure to each byte read from the current binary
+ % input stream in turn, until eof or error.
%
:- pred io__binary_input_stream_foldl2_io(
- pred(int, T, T, io, io),
- T, io__maybe_partial_res(T), io, io).
+ pred(int, T, T, io, io), T, io__maybe_partial_res(T), io, io).
:- mode io__binary_input_stream_foldl2_io(
- in(pred(in, in, out, di, uo) is det),
- in, out, di, uo) is det.
+ in(pred(in, in, out, di, uo) is det), in, out, di, uo) is det.
:- mode io__binary_input_stream_foldl2_io(
- in(pred(in, in, out, di, uo) is cc_multi),
- in, out, di, uo) is cc_multi.
+ in(pred(in, in, out, di, uo) is cc_multi), in, out, di, uo) is cc_multi.
- % Applies the given closure to each byte read from the
- % current binary input stream in turn, until eof or error,
- % or the closure returns `no' as its second argument.
+ % Applies the given closure to each byte read from the current binary
+ % input stream in turn, until eof or error, or the closure returns `no'
+ % as its second argument.
%
:- pred io__binary_input_stream_foldl2_io_maybe_stop(
- pred(int, bool, T, T, io, io),
- T, io__maybe_partial_res(T), io, io).
+ pred(int, bool, T, T, io, io), T, io__maybe_partial_res(T), io, io).
:- mode io__binary_input_stream_foldl2_io_maybe_stop(
- (pred(in, out, in, out, di, uo) is det),
- in, out, di, uo) is det.
+ (pred(in, out, in, out, di, uo) is det), in, out, di, uo) is det.
:- mode io__binary_input_stream_foldl2_io_maybe_stop(
- (pred(in, out, in, out, di, uo) is cc_multi),
- in, out, di, uo) is cc_multi.
+ (pred(in, out, in, out, di, uo) is cc_multi), in, out, di, uo) is cc_multi.
- % Applies the given closure to each byte read from the
- % given binary input stream in turn, until eof or error.
+ % Applies the given closure to each byte read from the given binary
+ % input stream in turn, until eof or error.
%
:- pred io__binary_input_stream_foldl(io__binary_input_stream,
pred(int, T, T), T, io__maybe_partial_res(T), io, io).
@@ -826,8 +797,8 @@
:- mode io__binary_input_stream_foldl(in, in(pred(in, in, out) is cc_multi),
in, out, di, uo) is cc_multi.
- % Applies the given closure to each byte read from the
- % given binary input stream in turn, until eof or error.
+ % Applies the given closure to each byte read from the given binary
+ % input stream in turn, until eof or error.
%
:- pred io__binary_input_stream_foldl_io(io__binary_input_stream,
pred(int, io, io), io__res, io, io).
@@ -836,33 +807,26 @@
:- mode io__binary_input_stream_foldl_io(in, in(pred(in, di, uo) is cc_multi),
out, di, uo) is cc_multi.
- % Applies the given closure to each byte read from the
- % given binary input stream in turn, until eof or error.
+ % Applies the given closure to each byte read from the given binary
+ % input stream in turn, until eof or error.
%
:- pred io__binary_input_stream_foldl2_io(io__binary_input_stream,
- pred(int, T, T, io, io),
- T, io__maybe_partial_res(T), io, io).
+ pred(int, T, T, io, io), T, io__maybe_partial_res(T), io, io).
:- mode io__binary_input_stream_foldl2_io(in,
- (pred(in, in, out, di, uo) is det),
- in, out, di, uo) is det.
+ (pred(in, in, out, di, uo) is det), in, out, di, uo) is det.
:- mode io__binary_input_stream_foldl2_io(in,
- (pred(in, in, out, di, uo) is cc_multi),
- in, out, di, uo) is cc_multi.
+ (pred(in, in, out, di, uo) is cc_multi), in, out, di, uo) is cc_multi.
% Applies the given closure to each byte read from the
% given binary input stream in turn, until eof or error,
% or the closure returns `no' as its second argument.
%
-:- pred io__binary_input_stream_foldl2_io_maybe_stop(
- io__binary_input_stream,
- pred(int, bool, T, T, io, io),
- T, io__maybe_partial_res(T), io, io).
+:- pred io__binary_input_stream_foldl2_io_maybe_stop(io__binary_input_stream,
+ pred(int, bool, T, T, io, io), T, io__maybe_partial_res(T), io, io).
:- mode io__binary_input_stream_foldl2_io_maybe_stop(in,
- (pred(in, out, in, out, di, uo) is det),
- in, out, di, uo) is det.
+ (pred(in, out, in, out, di, uo) is det), in, out, di, uo) is det.
:- mode io__binary_input_stream_foldl2_io_maybe_stop(in,
- (pred(in, out, in, out, di, uo) is cc_multi),
- in, out, di, uo) is cc_multi.
+ (pred(in, out, in, out, di, uo) is cc_multi), in, out, di, uo) is cc_multi.
% Un-reads a byte from the current binary input stream.
% You can put back as many bytes as you like.
@@ -870,8 +834,7 @@
% The byte is taken from the bottom 8 bits of an integer.
% Note: `io__putback_byte' uses the C library function ungetc().
% On some systems only one byte of pushback is guaranteed.
- % `io__putback_byte' will throw an io__error exception
- % if ungetc() fails.
+ % `io__putback_byte' will throw an io__error exception if ungetc() fails.
%
:- pred io__putback_byte(int::in, io::di, io::uo) is det.
@@ -881,8 +844,7 @@
% The byte is returned in the bottom 8 bits of an integer.
% Note: `io__putback_byte' uses the C library function ungetc().
% On some systems only one byte of pushback is guaranteed.
- % `io__putback_byte' will throw an io__error exception
- % if ungetc() fails.
+ % `io__putback_byte' will throw an io__error exception if ungetc() fails.
%
:- pred io__putback_byte(io__binary_input_stream::in, int::in,
io::di, io::uo) is det.
@@ -895,18 +857,16 @@
% These will all throw an io__error exception if an I/O error occurs.
% XXX what about wide characters?
- % Writes a binary representation of a term to the current
- % binary output stream, in a format suitable for reading
- % in again with io__read_binary.
+ % Writes a binary representation of a term to the current binary output
+ % stream, in a format suitable for reading in again with io__read_binary.
%
:- pred io__write_binary(T::in, io::di, io::uo) is det.
- % Writes a binary representation of a term to the specified
- % binary output stream, in a format suitable for reading
- % in again with io__read_binary.
+ % Writes a binary representation of a term to the specified binary output
+ % stream, in a format suitable for reading in again with io__read_binary.
%
- % XXX Note that due to the current implementation,
- % io__write_binary will not work for the Java back-end.
+ % XXX Note that due to the current implementation, io__write_binary
+ % will not work for the Java back-end.
%
:- pred io__write_binary(io__binary_output_stream::in, T::in, io::di, io::uo)
is det.
@@ -959,16 +919,15 @@
% Binary input stream predicates.
%
- % Attempts to open a file for binary input, and if successful
- % sets the current binary input stream to the newly opened stream.
+ % Attempts to open a file for binary input, and if successful sets
+ % the current binary input stream to the newly opened stream.
% Result is either 'ok' or 'error'.
%
:- pred io__see_binary(string::in, io__res::out, io::di, io::uo) is det.
- % Closes the current input stream.
- % The current input stream reverts to standard input.
- % This will throw an io__error exception
- % if an I/O error occurs.
+ % Closes the current input stream. The current input stream reverts
+ % to standard input. This will throw an io__error exception if
+ % an I/O error occurs.
%
:- pred io__seen_binary(io::di, io::uo) is det.
@@ -978,9 +937,8 @@
:- pred io__open_binary_input(string::in,
io__res(io__binary_input_stream)::out, io::di, io::uo) is det.
- % Closes an open binary input stream.
- % This will throw an io__error exception
- % if an I/O error occurs.
+ % Closes an open binary input stream. This will throw an io__error
+ % exception if an I/O error occurs.
%
:- pred io__close_binary_input(io__binary_input_stream::in,
io::di, io::uo) is det.
@@ -991,7 +949,6 @@
:- pred io__binary_input_stream(io__binary_input_stream::out,
io::di, io::uo) is det.
- % io__set_binary_input_stream(NewStream, OldStream, !IO):
% Changes the current input stream to the stream specified.
% Returns the previous stream.
%
@@ -1020,18 +977,15 @@
% Binary output stream predicates.
%
- % Attempts to open a file for binary output, and if successful
- % sets the current binary output stream to the newly opened
- % stream. As per Prolog tell/1. Result is either 'ok' or
- % 'error(ErrCode)'.
+ % Attempts to open a file for binary output, and if successful sets
+ % the current binary output stream to the newly opened stream.
+ % As per Prolog tell/1. Result is either 'ok' or 'error(ErrCode)'.
%
:- pred io__tell_binary(string::in, io__res::out, io::di, io::uo) is det.
- % Closes the current binary output stream.
- % The default binary output stream reverts to standard output.
- % As per Prolog told/0.
- % This will throw an io__error exception
- % if an I/O error occurs.
+ % Closes the current binary output stream. The default binary output
+ % stream reverts to standard output. As per Prolog told/0. This will
+ % throw an io__error exception if an I/O error occurs.
%
:- pred io__told_binary(io::di, io::uo) is det.
@@ -1066,16 +1020,14 @@
:- pred io__stdout_binary_stream(io__binary_output_stream::out,
io::di, io::uo) is det.
- % io__set_binary_output_stream(NewStream, OldStream, !IO):
- % Changes the current binary output stream to the stream
- % specified. Returns the previous stream.
+ % Changes the current binary output stream to the stream specified.
+ % Returns the previous stream.
%
:- pred io__set_binary_output_stream(io__binary_output_stream::in,
io__binary_output_stream::out, io::di, io::uo) is det.
% Retrieves the human-readable name associated with the current
- % binary output stream.
- % For file streams, this is the filename.
+ % binary output stream. For file streams, this is the filename.
%
:- pred io__binary_output_stream_name(string::out, io::di, io::uo) is det.
@@ -1091,6 +1043,7 @@
%
% io__progname(DefaultProgname, Progname):
+ %
% Returns the name that the program was invoked with, if available,
% or DefaultProgname if the name is not available.
% Does not modify the IO state.
@@ -1098,21 +1051,21 @@
:- pred io__progname(string::in, string::out, io::di, io::uo) is det.
% io__progname_base(DefaultProgname, Progname):
+ %
% Like `io__progname', except that it strips off any path name
% preceding the program name. Useful for error messages.
%
:- pred io__progname_base(string::in, string::out, io::di, io::uo) is det.
% Returns the arguments that the program was invoked with,
- % if available, otherwise an empty list.
- % Does not modify the IO state.
+ % if available, otherwise an empty list. Does not modify the IO state.
%
:- pred io__command_line_arguments(list(string)::out, io::di, io::uo) is det.
% The io__state contains an integer used to record the program's exit
% status. When the program finishes, it will return this exit status
- % to the operating system. The following predicates can be used
- % to get and set the exit status.
+ % to the operating system. The following predicates can be used to get
+ % and set the exit status.
%
:- pred io__get_exit_status(int::out, io::di, io::uo) is det.
@@ -1120,9 +1073,8 @@
% The io__state includes a `globals' field which is not used by the I/O
% library, but can be used by the application. The globals field is
- % of type `univ' so that the application can store any data it wants
- % there. The following predicates can be used to access this global
- % state.
+ % of type `univ' so that the application can store any data it wants there.
+ % The following predicates can be used to access this global state.
%
% Doesn't modify the io__state.
%
@@ -1130,22 +1082,20 @@
:- pred io__set_globals(univ::di, io::di, io::uo) is det.
- % The following predicates provide an interface to the environment
- % list. Do not attempt to put spaces or '=' signs in the names of
- % environment variables, or bad things may result!
- %
- % First argument is the name of the environment variable.
- % Returns yes(Value) if the variable was set (Value will
- % be set to the value of the variable) and no if the
- % variable was not set.
+ % The following predicates provide an interface to the environment list.
+ % Do not attempt to put spaces or '=' signs in the names of environment
+ % variables, or bad things may result!
+ %
+ % First argument is the name of the environment variable. Returns
+ % yes(Value) if the variable was set (Value will be set to the value
+ % of the variable) and no if the variable was not set.
%
:- pred io__get_environment_var(string::in, maybe(string)::out,
io::di, io::uo) is det.
- % First argument is the name of the environment variable,
- % second argument is the value to be assigned to that
- % variable. Will throw an exception if the system runs
- % out of environment space.
+ % First argument is the name of the environment variable, second argument
+ % is the value to be assigned to that variable. Will throw an exception
+ % if the system runs out of environment space.
%
:- pred io__set_environment_var(string::in, string::in, io::di, io::uo) is det.
@@ -1154,10 +1104,10 @@
% File handling predicates
%
- % io__make_temp(Name, !IO) creates an empty file whose name
- % is different to the name of any existing file. Name is bound
- % to the name of the file. It is the responsibility of the program
- % to delete the file when it is no longer needed.
+ % io__make_temp(Name, !IO) creates an empty file whose name is different
+ % to the name of any existing file. Name is bound to the name of the file.
+ % It is the responsibility of the program to delete the file when it is
+ % no longer needed.
%
% The file will reside in an implementation-dependent directory.
% For current Mercury implementations, it is determined as follows:
@@ -1176,34 +1126,32 @@
%
:- pred io__make_temp(string::out, io::di, io::uo) is det.
- % io__mktemp(Dir, Prefix, Name, IO0, IO) creates an empty
- % file whose name is different to the name of any existing file.
- % The file will reside in the directory specified by `Dir' and will
- % have a prefix using up to the first 5 characters of `Prefix'.
- % Name is bound to the name of the file.
- % It is the responsibility of the program to delete the file
+ % io__mktemp(Dir, Prefix, Name, IO0, IO) creates an empty file whose name
+ % is different to the name of any existing file. The file will reside
+ % in the directory specified by `Dir' and will have a prefix using up to
+ % the first 5 characters of `Prefix'. Name is bound to the name of the
+ % file. It is the responsibility of the program to delete the file
% when it is no longer needed.
%
:- pred io__make_temp(string::in, string::in, string::out,
io::di, io::uo) is det.
- % io__remove_file(FileName, Result, !IO) attempts to remove the
- % file `FileName', binding Result to ok/0 if it succeeds, or
- % error/1 if it fails.
- % If `FileName' names a file that is currently open,
- % the behaviour is implementation-dependent.
+ % io__remove_file(FileName, Result, !IO) attempts to remove the file
+ % `FileName', binding Result to ok/0 if it succeeds, or error/1 if it
+ % fails. If `FileName' names a file that is currently open, the behaviour
+ % is implementation-dependent.
%
:- pred io__remove_file(string::in, io__res::out, io::di, io::uo) is det.
- % io__rename_file(OldFileName, NewFileName, Result, !IO)
- % attempts to rename the file `OldFileName' as `NewFileName',
- % binding Result to ok/0 if it succeeds, or error/1 if it fails.
- % If `OldFileName' names a file that is currently open,
- % the behaviour is implementation-dependent.
- % If `NewFileName' names a file that already exists
- % the behaviour is also implementation-dependent;
- % on some systems, the file previously named `NewFileName' will be
- % deleted and replaced with the file previously named `OldFileName'.
+ % io__rename_file(OldFileName, NewFileName, Result, !IO):
+ %
+ % Attempts to rename the file `OldFileName' as `NewFileName', binding
+ % Result to ok/0 if it succeeds, or error/1 if it fails. If `OldFileName'
+ % names a file that is currently open, the behaviour is
+ % implementation-dependent. If `NewFileName' names a file that already
+ % exists the behaviour is also implementation-dependent; on some systems,
+ % the file previously named `NewFileName' will be deleted and replaced
+ % with the file previously named `OldFileName'.
%
:- pred io__rename_file(string::in, string::in, io__res::out,
io::di, io::uo) is det.
@@ -1212,20 +1160,20 @@
%
:- pred io__have_symlinks is semidet.
- % io__make_symlink(FileName, LinkFileName, Result, !IO)
- % attempts to make `LinkFileName' be a symbolic link to `FileName'.
+ % io__make_symlink(FileName, LinkFileName, Result, !IO):
+ %
+ % Attempts to make `LinkFileName' be a symbolic link to `FileName'.
% If `FileName' is a relative path, it is interpreted relative
% to the directory containing `LinkFileName'.
%
:- pred io__make_symlink(string::in, string::in, io__res::out,
io::di, io::uo) is det.
- % io__read_symlink(FileName, Result, !IO) returns
- % `ok(LinkTarget)' if `FileName' is a symbolic link pointing
- % to `LinkTarget', and `error(Error)' otherwise.
- % If `LinkTarget' is a relative path, it should be interpreted
- % relative the directory containing `FileName', not the current
- % directory.
+ % io__read_symlink(FileName, Result, !IO) returns `ok(LinkTarget)'
+ % if `FileName' is a symbolic link pointing to `LinkTarget', and
+ % `error(Error)' otherwise. If `LinkTarget' is a relative path,
+ % it should be interpreted relative the directory containing `FileName',
+ % not the current directory.
%
:- pred io__read_symlink(string::in, io__res(string)::out, io::di, io::uo)
is det.
@@ -1235,11 +1183,12 @@
; write
; execute.
- % io__check_file_accessibility(FileName, AccessTypes, Result)
- % Check whether the current process can perform the operations
- % given in `AccessTypes' on `FileName'.
- % XXX When using the .NET CLI, this predicate will sometimes
- % report that a directory is writable when in fact it is not.
+ % io__check_file_accessibility(FileName, AccessTypes, Result):
+ %
+ % Check whether the current process can perform the operations given
+ % in `AccessTypes' on `FileName'.
+ % XXX When using the .NET CLI, this predicate will sometimes report
+ % that a directory is writable when in fact it is not.
%
:- pred io__check_file_accessibility(string::in, list(access_type)::in,
io__res::out, io::di, io::uo) is det.
@@ -1285,16 +1234,17 @@
%
% The Melbourne implementation supports the following selectors:
%
- % "standard" Writes memory/time usage statistics.
+ % "standard"
+ % Writes memory/time usage statistics.
%
- % "full_memory_stats" Writes complete memory usage statistics,
- % including information about all procedures
- % and types. Requires compilation with
- % memory profiling enabled.
- %
- % "tabling" Writes statistics about the internals
- % of the tabling system. Requires the runtime
- % to have been compiled with the macro
+ % "full_memory_stats"
+ % Writes complete memory usage statistics, including information
+ % about all procedures and types. Requires compilation with memory
+ % profiling enabled.
+ %
+ % "tabling"
+ % Writes statistics about the internals of the tabling system.
+ % Requires the runtime to have been compiled with the macro
% MR_TABLE_STATISTICS defined.
%
:- pred io__report_stats(string::in, io::di, io::uo) is det.
@@ -1304,12 +1254,11 @@
% Miscellaneous predicates
%
- % Invokes the operating system shell with the specified
- % Command. Result is either `ok(ExitStatus)', if it was
- % possible to invoke the command, or `error(ErrorCode)' if not.
- % The ExitStatus will be 0 if the command completed
- % successfully or the return value of the system call. If a
- % signal kills the system call, then Result will be an error
+ % Invokes the operating system shell with the specified Command.
+ % Result is either `ok(ExitStatus)', if it was possible to invoke
+ % the command, or `error(ErrorCode)' if not. The ExitStatus will be 0
+ % if the command completed successfully or the return value of the system
+ % call. If a signal kills the system call, then Result will be an error
% indicating which signal occurred.
%
:- pred io__call_system(string::in, io__res(int)::out, io::di, io::uo) is det.
@@ -1318,16 +1267,16 @@
---> exited(int)
; signalled(int).
- % call_system_return_signal(Command, Result, !IO).
- % Invokes the operating system shell with the specified
- % Command. Result is either `ok(ExitStatus)' if it was
- % possible to invoke the command or `error(Error)' if the command
- % could not be executed. If the command could be executed then
- % ExitStatus is either `exited(ExitCode)' if the command ran to
- % completion or `signalled(SignalNum)' if the command was killed by
- % a signal. If the command ran to completion then ExitCode will be 0
- % if the command ran successfully and the return value of the command
- % otherwise.
+ % call_system_return_signal(Command, Result, !IO):
+ %
+ % Invokes the operating system shell with the specified Command.
+ % Result is either `ok(ExitStatus)' if it was possible to invoke
+ % the command or `error(Error)' if the command could not be executed.
+ % If the command could be executed then ExitStatus is either
+ % `exited(ExitCode)' if the command ran to completion or
+ % `signalled(SignalNum)' if the command was killed by a signal.
+ % If the command ran to completion then ExitCode will be 0 if the command
+ % ran successfully and the return value of the command otherwise.
%
:- pred io__call_system_return_signal(string::in,
io__res(io__system_result)::out, io::di, io::uo) is det.
@@ -1349,21 +1298,21 @@
% Do not use these in new programs!
% They may be deleted in the next release.
- % use io__input_stream/3 instead -- it has identical semantics
+ % Use io__input_stream/3 instead -- it has identical semantics.
:- pragma obsolete(io__current_input_stream/3).
:- pred io__current_input_stream(io__input_stream::out, io::di, io::uo) is det.
- % use io__output_stream/3 instead -- it has identical semantics
+ % Use io__output_stream/3 instead -- it has identical semantics.
:- pragma obsolete(io__current_output_stream/3).
:- pred io__current_output_stream(io__output_stream::out, io::di, io::uo)
is det.
- % use io__binary_input_stream/3 instead -- it has identical semantics
+ % Use io__binary_input_stream/3 instead -- it has identical semantics.
:- pragma obsolete(io__current_binary_input_stream/3).
:- pred io__current_binary_input_stream(io__binary_input_stream::out,
io::di, io::uo) is det.
- % use io__binary_output_stream/3 instead -- it has identical semantics
+ % Use io__binary_output_stream/3 instead -- it has identical semantics.
:- pragma obsolete(io__current_binary_output_stream/3).
:- pred io__current_binary_output_stream(io__binary_output_stream::out,
io::di, io::uo) is det.
@@ -1374,6 +1323,7 @@
% is not set, or in the directory specified by TMPDIR if it is set.
% Use of this predicate is deprecated, because it may
% result in race conditions. Use io__make_temp/3 instead.
+ %
:- pragma obsolete(io__tmpnam/3). % use io__make_temp/3 instead
:- pred io__tmpnam(string::out, io::di, io::uo) is det.
@@ -1384,6 +1334,7 @@
% of `Prefix'.
% Use of this predicate is deprecated, because it may
% result in race conditions. Use io__make_temp/5 instead.
+ %
:- pragma obsolete(io__tmpnam/5). % use io__make_temp/5 instead
:- pred io__tmpnam(string::in, string::in, string::out, io::di, io::uo) is det.
@@ -1393,6 +1344,7 @@
%
% OBSOLETE: call io__report_stats/3 instead, with the first argument
% specified as "full_memory_stats".
+ %
:- pragma obsolete(io__report_full_memory_stats/2).
:- pred io__report_full_memory_stats(io::di, io::uo) is det.
@@ -1408,9 +1360,9 @@
:- interface.
- %
- % For use by dir.m:
- %
+%
+% For use by dir.m:
+%
% A system-dependent error indication.
% For C, this is the value of errno.
@@ -1424,53 +1376,62 @@
% `Message' is an error message obtained by looking up the
% message for the given errno value and prepending
% `MessagePrefix'.
+ %
:- pred io__make_err_msg(io__system_error::in, string::in, string::out,
io::di, io::uo) is det.
-% Succeeds iff the Win32 API is available.
+ % Succeeds iff the Win32 API is available.
+ %
:- pred have_win32 is semidet.
-% Succeeds iff the current process was compiled against the Cygwin library.
+ % Succeeds iff the current process was compiled against the Cygwin library.
+ %
:- pred have_cygwin is semidet.
-% Succeeds iff the .NET class library is available.
+ % Succeeds iff the .NET class library is available.
+ %
:- pred have_dotnet is semidet.
% io__make_win32_err_msg(Error, MessagePrefix, Message):
+ %
% `Message' is an error message obtained by looking up the
% error message for the given Win32 error number and prepending
% `MessagePrefix'.
% This will abort if called on a system which does not support
% the Win32 API.
+ %
:- pred io__make_win32_err_msg(io__system_error::in,
string::in, string::out, io::di, io::uo) is det.
% io__make_maybe_win32_err_msg(Error, MessagePrefix, Message):
+ %
% `Message' is an error message obtained by looking up the
% last Win32 error message and prepending `MessagePrefix'.
% On non-Win32 systems, the message corresponding to the
% current value of errno will be used.
+ %
:- pred io__make_maybe_win32_err_msg(io__system_error::in,
string::in, string::out, io::di, io::uo) is det.
% Return a unique identifier for the given file (after following
% symlinks in FileName).
% XXX On Cygwin sometimes two files will have the same file_id.
- % This is because MS-Windows does not use inodes, so Cygwin
- % hashes the absolute file name.
- % On Windows without Cygwin this will always return error(_).
- % That doesn't matter, because this function is only used for
- % checking for symlink loops in dir.foldl2, but plain Windows
+ % This is because MS-Windows does not use inodes, so Cygwin hashes
+ % the absolute file name. On Windows without Cygwin this will always
+ % return error(_). That doesn't matter, because this function is only used
+ % for checking for symlink loops in dir.foldl2, but plain Windows
% doesn't support symlinks.
+ %
:- type file_id.
:- pred io__file_id(string::in, io__res(file_id)::out, io::di, io::uo) is det.
% Succeeds if io__file_id is implemented on this platform.
+ %
:- pred io__have_file_ids is semidet.
- %
- % For use by term_io.m:
- %
+%
+% For use by term_io.m:
+%
:- import_module ops.
@@ -1484,11 +1445,11 @@
:- pred maybe_write_paren(char::in, ops__priority::in, ops__priority::in,
io::di, io::uo) is det.
- %
- % For use by browser/browse.m:
- %
+%
+% For use by browser/browse.m:
+%
- % Types and predicates for managing the stream info database.
+% Types and predicates for managing the stream info database.
:- type io__stream_db == map(io__stream_id, stream_info).
@@ -1527,30 +1488,35 @@
% Retrieves the database mapping streams to the information we have
% about those streams.
+ %
:- pred io__get_stream_db(io__stream_db::out, io__state::di, io__state::uo)
is det.
% Returns the information associated with the specified input
% stream in the given stream database.
+ %
:- func io__input_stream_info(io__stream_db, io__input_stream)
= io__maybe_stream_info.
% Returns the information associated with the specified output
% stream in the given stream database.
+ %
:- func io__output_stream_info(io__stream_db, io__output_stream)
= io__maybe_stream_info.
% Returns the information associated with the specified binary input
% stream in the given stream database.
+ %
:- func io__binary_input_stream_info(io__stream_db, io__binary_input_stream)
= io__maybe_stream_info.
% Returns the information associated with the specified binary output
% stream in the given stream database.
+ %
:- func io__binary_output_stream_info(io__stream_db, io__binary_output_stream)
= io__maybe_stream_info.
-% Predicates for writing out univs
+% Predicates for writing out univs.
:- pred io__write_univ(univ, io__state, io__state).
:- mode io__write_univ(in, di, uo) is det.
@@ -1559,29 +1525,31 @@
:- mode io__write_univ(in, in, di, uo) is det.
:- pred io__write_univ(io__output_stream, deconstruct__noncanon_handling, univ,
- io__state, io__state).
+ io, io).
:- mode io__write_univ(in, in(do_not_allow), in, di, uo) is det.
:- mode io__write_univ(in, in(canonicalize), in, di, uo) is det.
:- mode io__write_univ(in, in(include_details_cc), in, di, uo) is cc_multi.
:- mode io__write_univ(in, in, in, di, uo) is cc_multi.
- %
- % For use by extras/aditi/aditi.m
- %
+%
+% For use by extras/aditi/aditi.m.
+%
% This is the same as io__read_from_string, except that an integer
% is allowed where a character is expected. This is needed because
% Aditi does not have a builtin character type. This also allows an
% integer where a float is expected.
+ %
:- pred io__read_from_string_with_int_instead_of_char(string::in, string::in,
int::in, io__read_result(T)::out, posn::in, posn::out) is det.
- %
- % For use by compiler/process_util.m:
- %
+%
+% For use by compiler/process_util.m:
+%
% Interpret the child process exit status returned by
% system() or wait().
+ %
:- func io__handle_system_command_exit_status(int) =
io__res(io__system_result).
@@ -1693,45 +1661,50 @@
% we don't want the C/Java/etc code to depend on how Mercury stores
% its discriminated union data types.
- % Reads a character from specified stream,
- % and returns the numerical value for that character
- % (as from char__to_int).
- % This may involve converting external character encodings
- % into Mercury's internal character repesentation
- % and (for text streams) converting OS line indicators,
- % e.g. CR-LF for Windows, to '\n' characters.
- % Returns -1 if at EOF, -2 if an error occurs.
+ % Reads a character from specified stream, and returns the numerical value
+ % for that character (as from char__to_int). This may involve converting
+ % external character encodings into Mercury's internal character
+ % repesentation and (for text streams) converting OS line indicators,
+ % e.g. CR-LF for Windows, to '\n' characters. Returns -1 if at EOF,
+ % -2 if an error occurs.
+ %
:- pred io__read_char_code(io__input_stream::in, int::out, io::di, io::uo)
is det.
% Reads a byte from specified stream.
% Returns -1 if at EOF, -2 if an error occurs.
+ %
:- pred io__read_byte_val(io__input_stream::in, int::out,
io::di, io::uo) is det.
% io__call_system_code(Command, Status, Message, !IO):
- % Invokes the operating system shell with the specified
- % Command. Returns Status = 127 and Message on failure.
- % Otherwise returns the raw exit status from the system()
- % call.
+ %
+ % Invokes the operating system shell with the specified Command.
+ % Returns Status = 127 and Message on failure. Otherwise returns
+ % the raw exit status from the system() call.
+ %
:- pred io__call_system_code(string::in, int::out, string::out,
io::di, io::uo) is det.
% io__getenv(Var, Value):
- % Gets the value Value associated with the environment
- % variable Var. Fails if the variable was not set.
+ %
+ % Gets the value Value associated with the environment variable Var.
+ % Fails if the variable was not set.
+ %
:- semipure pred io__getenv(string::in, string::out) is semidet.
% io__setenv(NameString,ValueString):
- % Sets the named environment variable to the specified
- % value. Fails if the operation does not work.
+ %
+ % Sets the named environment variable to the specified value.
+ % Fails if the operation does not work.
+ %
:- impure pred io__setenv(string::in, string::in) is semidet.
%-----------------------------------------------------------------------------%
% input predicates
-% we want to inline these, to allow deforestation
+% We want to inline these, to allow deforestation.
:- pragma inline(io__read_char/3).
:- pragma inline(io__read_char/4).
@@ -1750,7 +1723,7 @@
Result = error(io_error(Msg))
).
-% we want to inline these, to allow deforestation
+% We want to inline these, to allow deforestation.
:- pragma inline(io__read_byte/3).
:- pragma inline(io__read_byte/4).
@@ -1909,13 +1882,12 @@
/* Grow the read buffer */
read_buf_size = ML_IO_READ_LINE_GROW(read_buf_size);
if (read_buffer == initial_read_buffer) {
- read_buffer = MR_NEW_ARRAY(MR_Char,
- read_buf_size);
+ read_buffer = MR_NEW_ARRAY(MR_Char, read_buf_size);
MR_memcpy(read_buffer, initial_read_buffer,
ML_IO_READ_LINE_START);
} else {
- read_buffer = MR_RESIZE_ARRAY(read_buffer,
- MR_Char, read_buf_size);
+ read_buffer = MR_RESIZE_ARRAY(read_buffer, MR_Char,
+ read_buf_size);
}
}
}
@@ -1923,15 +1895,14 @@
MR_Word ret_string_word;
MR_offset_incr_hp_atomic_msg(ret_string_word,
0, ML_IO_BYTES_TO_WORDS((i + 1) * sizeof(MR_Char)),
- MR_PROC_LABEL, ""string:string/0"");
+ MR_PROC_LABEL, ""string.string/0"");
RetString = (MR_String) ret_string_word;
MR_memcpy(RetString, read_buffer, i * sizeof(MR_Char));
RetString[i] = '\\0';
} else {
/*
- ** We can't just return NULL here, because
- ** otherwise mdb will break when it tries to
- ** print the string.
+ ** We can't just return NULL here, because otherwise mdb will break
+ ** when it tries to print the string.
*/
RetString = MR_make_string_const("""");
}
@@ -1941,9 +1912,9 @@
MR_update_io(IO0, IO);
").
+io__read_line_as_string_2(Stream, FirstCall, Res, String, !IO) :-
% XXX This is terribly inefficient, a better approach would be to
% use a buffer like what is done for io__read_file_as_string.
-io__read_line_as_string_2(Stream, FirstCall, Res, String, !IO) :-
io__read_char(Stream, Result, !IO),
(
Result = ok(Char),
@@ -1951,16 +1922,17 @@
Res = 0,
String = "\n"
;
- io__read_line_as_string_2(Stream, no, Res, String0,
- !IO),
+ io__read_line_as_string_2(Stream, no, Res, String0, !IO),
string__first_char(String, Char, String0)
)
;
Result = eof,
- ( FirstCall = yes ->
+ (
+ FirstCall = yes,
String = "",
Res = -1
;
+ FirstCall = no,
String = "",
Res = 0
)
@@ -2000,13 +1972,9 @@
io__read_file_as_string(Stream, Result, !IO).
io__read_file_as_string(Stream, Result, !IO) :-
- %
- % check if the stream is a regular file;
- % if so, allocate a buffer according to the
- % size of the file. Otherwise, just use
- % a default buffer size of 4k minus a bit
- % (to give malloc some room).
- %
+ % Check if the stream is a regular file; if so, allocate a buffer
+ % according to the size of the file. Otherwise, just use a default buffer
+ % size of 4k minus a bit (to give malloc some room).
io__stream_file_size(Stream, FileSize, !IO),
( FileSize >= 0 ->
BufferSize0 = FileSize + 1
@@ -2015,10 +1983,8 @@
),
io__alloc_buffer(BufferSize0, Buffer0),
- %
% Read the file into the buffer (resizing it as we go if necessary),
% convert the buffer into a string, and see if anything went wrong.
- %
io__clear_err(Stream, !IO),
Pos0 = 0,
io__read_file_as_string_2(Stream, Buffer0, Buffer, Pos0, Pos,
@@ -2035,18 +2001,18 @@
).
:- pred io__read_file_as_string_2(io__input_stream::in, buffer::buffer_di,
- buffer::buffer_uo, int::in, int::out, int::in, int::out,
- io::di, io::uo) is det.
+ buffer::buffer_uo, int::in, int::out, int::in, int::out, io::di, io::uo)
+ is det.
io__read_file_as_string_2(Stream, !Buffer, !Pos, !Size, !IO) :-
Pos0 = !.Pos,
Size0 = !.Size,
io__read_into_buffer(Stream, !Buffer, !Pos, !.Size, !IO),
( !.Pos =< Pos0 ->
- % end-of-file or error
+ % End-of-file or error.
true
; !.Pos = Size0 ->
- % full buffer
+ % Full buffer.
!:Size = Size0 * 2,
io__resize_buffer(Size0, !.Size, !Buffer),
io__read_file_as_string_2(Stream, !Buffer, !Pos, !Size, !IO)
@@ -2124,8 +2090,7 @@
Res = ok(T1)
;
Continue = yes,
- io__input_stream_foldl2_io_maybe_stop(Stream,
- Pred, T1, Res, !IO)
+ io__input_stream_foldl2_io_maybe_stop(Stream, Pred, T1, Res, !IO)
)
;
CharResult = eof,
@@ -2137,7 +2102,8 @@
%-----------------------------------------------------------------------------%
- % same as ANSI C's clearerr().
+ % Same as ANSI C's clearerr().
+ %
:- pred io__clear_err(stream::in, io::di, io::uo) is det.
:- pragma foreign_proc("C",
@@ -2178,7 +2144,8 @@
Res = error(io_error(Msg))
).
- % similar to ANSI C's ferror().
+ % Similar to ANSI C's ferror().
+ %
:- pred io__ferror(stream::in, int::out, string::out, io::di, io::uo) is det.
:- pragma foreign_proc("C",
@@ -2243,6 +2210,7 @@
}").
:- pragma export(make_err_msg(in, in, out, di, uo), "ML_make_err_msg").
+
:- pragma foreign_proc("C",
make_err_msg(Error::in, Msg0::in, Msg::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
@@ -2334,6 +2302,7 @@
% io__stream_file_size(Stream, Size):
% If Stream is a regular file, then Size is its size (in bytes),
% otherwise Size is -1.
+ %
:- pred io__stream_file_size(stream::in, int::out, io::di, io::uo) is det.
:- pragma foreign_decl("C", "
@@ -2352,13 +2321,10 @@
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
#if defined(MR_HAVE_FSTAT) && \
- (defined(MR_HAVE_FILENO) || defined(fileno)) && \
- defined(S_ISREG)
+ (defined(MR_HAVE_FILENO) || defined(fileno)) && defined(S_ISREG)
struct stat s;
if (MR_IS_FILE_STREAM(*Stream)) {
- if (fstat(fileno(MR_file(*Stream)), &s) == 0 &&
- S_ISREG(s.st_mode))
- {
+ if (fstat(fileno(MR_file(*Stream)), &s) == 0 && S_ISREG(s.st_mode)) {
Size = s.st_size;
} else {
Size = -1;
@@ -2473,8 +2439,7 @@
io__file_type_2(FollowSymLinksInt, FileName, MaybeType, !IO)
;
MaybeType = error(io__make_io_error(
- "Sorry, io.file_type not implemented " ++
- "on this platform"))
+ "Sorry, io.file_type not implemented on this platform"))
).
:- pred file_type_implemented is semidet.
@@ -2509,8 +2474,7 @@
:- pragma foreign_proc("C",
io__file_type_2(FollowSymLinks::in, FileName::in,
Result::out, IO0::di, IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"{
#ifdef MR_HAVE_STAT
struct stat s;
@@ -2628,8 +2592,7 @@
** it uses `hp' and this procedure can call Mercury.
*/
ML_make_io_res_1_error_file_type(errno,
- MR_make_string_const(""io.file_type failed: ""),
- &Result);
+ MR_make_string_const(""io.file_type failed: ""), &Result);
}
#else
MR_fatal_error(
@@ -2641,8 +2604,7 @@
:- pragma foreign_proc("C#",
io__file_type_2(_FollowSymLinks::in, FileName::in,
Result::out, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"
try {
System.IO.FileAttributes attrs =
@@ -2675,8 +2637,7 @@
:- pragma foreign_proc("Java",
io__file_type_2(_FollowSymLinks::in, FileName::in,
Result::out, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"
java.io.File file = new java.io.File(FileName);
@@ -2736,11 +2697,9 @@
io__check_file_accessibility(FileName, AccessTypes, Result, !IO) :-
( have_dotnet ->
- io__check_file_accessibility_dotnet(FileName, AccessTypes,
- Result, !IO)
+ io__check_file_accessibility_dotnet(FileName, AccessTypes, Result, !IO)
;
- io__check_file_accessibility_2(FileName, AccessTypes, Result,
- !IO)
+ io__check_file_accessibility_2(FileName, AccessTypes, Result, !IO)
).
:- pred io__check_file_accessibility_2(string::in, list(access_type)::in,
@@ -2749,8 +2708,7 @@
:- pragma foreign_proc("C",
io__check_file_accessibility_2(FileName::in, AccessTypes::in,
Result::out, IO0::di, IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"{
#if defined(MR_HAVE_ACCESS)
#ifdef F_OK
@@ -2787,8 +2745,7 @@
Result = ML_make_io_res_0_ok();
} else {
ML_make_io_res_0_error(errno,
- MR_make_string_const(""file not accessible: ""),
- &Result);
+ MR_make_string_const(""file not accessible: ""), &Result);
}
#else /* !MR_HAVE_ACCESS */
Result = ML_make_io_res_0_error_msg(
@@ -2800,20 +2757,15 @@
:- pragma foreign_proc("Java",
io__check_file_accessibility_2(FileName::in, AccessTypes::in,
Result::out, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"
java.lang.String permissions = null;
- if (access_types_includes_read_1_p_0(
- (mercury.list.List_1) AccessTypes))
- {
+ if (access_types_includes_read_1_p_0((mercury.list.List_1) AccessTypes)) {
permissions = ""read"";
}
- if (access_types_includes_write_1_p_0(
- (mercury.list.List_1) AccessTypes))
- {
+ if (access_types_includes_write_1_p_0((mercury.list.List_1) AccessTypes)) {
if (permissions == null) {
permissions = ""write"";
} else {
@@ -2821,8 +2773,7 @@
}
}
- if (access_types_includes_execute_1_p_0(
- (mercury.list.List_1) AccessTypes))
+ if (access_types_includes_execute_1_p_0((mercury.list.List_1) AccessTypes))
{
if (permissions == null) {
permissions = ""execute"";
@@ -2834,8 +2785,7 @@
try {
if (permissions != null) {
java.lang.System.getSecurityManager().checkPermission(
- new java.io.FilePermission(FileName,
- permissions));
+ new java.io.FilePermission(FileName, permissions));
}
Result = make_io_res_0_ok_0_f_0();
}
@@ -2844,12 +2794,13 @@
}
").
- % The .NET CLI doesn't provide an equivalent of access(), so
- % we have to try to open the file to see if it is accessible.
:- pred io__check_file_accessibility_dotnet(string::in, list(access_type)::in,
io__res::out, io__state::di, io__state::uo) is det.
io__check_file_accessibility_dotnet(FileName, AccessTypes, Result, !IO) :-
+ % The .NET CLI doesn't provide an equivalent of access(), so we have to
+ % try to open the file to see if it is accessible.
+
CheckRead0 = pred_to_bool(access_types_includes_read(AccessTypes)),
CheckWrite = pred_to_bool(access_types_includes_write(AccessTypes)),
@@ -2862,8 +2813,7 @@
FileTypeRes = ok(FileType),
( FileType = directory ->
check_directory_accessibility_dotnet(FileName,
- to_int(CheckRead), to_int(CheckWrite),
- Result, !IO)
+ to_int(CheckRead), to_int(CheckWrite), Result, !IO)
;
( CheckRead = yes ->
io__open_input(FileName, InputRes, !IO),
@@ -2896,10 +2846,9 @@
),
(
CheckWriteRes = ok,
-
- % Unix programs need to check whether the
- % execute bit is set for the directory, but
- % we can't actually execute the directory.
+ % Unix programs need to check whether the execute bit is set
+ % for the directory, but we can't actually execute the
+ % directory.
CheckExec = yes
->
have_dotnet_exec_permission(Result, !IO)
@@ -2916,12 +2865,12 @@
is det.
have_dotnet_exec_permission(Res, !IO) :-
- % avoid determinism warnings
+ % Avoid determinism warnings.
( semidet_succeed ->
error("io.have_dotnet_exec_permission invoked " ++
"for non-.NET CLI backend")
;
- % never reached
+ % Never reached.
Res = ok
).
@@ -2947,20 +2896,19 @@
io__res::out, io__state::di, io__state::uo) is det.
check_directory_accessibility_dotnet(_, _, _, Res, !IO) :-
- % avoid determinism warnings
+ % Avoid determinism warnings.
( semidet_succeed ->
error("io.check_directory_accessibility_dotnet called " ++
"for non-.NET CLI backend")
;
- % never reached
+ % Never reached.
Res = ok
).
:- pragma foreign_proc("C#",
check_directory_accessibility_dotnet(FileName::in, CheckRead::in,
CheckWrite::in, Result::out, _IO0::di, _IO::uo),
- [promise_pure, may_call_mercury, tabled_for_io, thread_safe,
- terminates],
+ [promise_pure, may_call_mercury, tabled_for_io, thread_safe, terminates],
"{
try {
if (CheckRead != 0) {
@@ -2977,21 +2925,18 @@
System.IO.Directory.SetLastAccessTime(FileName,
System.DateTime.Now);
- // XXX This isn't quite right.
- // Just because the directory isn't read-only
- // doesn't mean we have permission to write to it.
- // The only way to test whether a directory is
- // writable is to write a file to it.
- // The ideal way to do that would be io__make_temp,
- // but currently the .NET backend version of that
+ // XXX This isn't quite right. Just because the directory
+ // isn't read-only doesn't mean we have permission to write to it.
+ // The only way to test whether a directory is writable is to
+ // write a file to it. The ideal way to do that would be
+ // io__make_temp, but currently the .NET backend version of that
// ignores the directory passed to it.
System.IO.FileAttributes attrs =
System.IO.File.GetAttributes(FileName);
if ((attrs & System.IO.FileAttributes.ReadOnly) ==
System.IO.FileAttributes.ReadOnly)
{
- throw (new System.Exception(
- ""file is read-only""));
+ throw (new System.Exception(""file is read-only""));
}
}
Result = mercury.io.mercury_code.ML_make_io_res_0_ok();
@@ -3101,11 +3046,10 @@
int inode_cmp;
/*
- ** For compilers other than GCC, glibc defines dev_t as
- ** struct (dev_t is 64 bits, and other compilers may
- ** not have a 64 bit arithmetic type).
- ** XXX This code assumes that dev_t and ino_t do not include
- ** padding bits. In practice, that should be OK.
+ ** For compilers other than GCC, glibc defines dev_t as struct (dev_t
+ ** is 64 bits, and other compilers may not have a 64 bit arithmetic type).
+ ** XXX This code assumes that dev_t and ino_t do not include padding bits.
+ ** In practice, that should be OK.
*/
device_cmp = memcmp(&(FileId1.device), &(FileId2.device),
sizeof(ML_dev_t));
@@ -3228,15 +3172,13 @@
"{
MR_Word buf;
MR_offset_incr_hp_atomic_msg(buf, 0,
- (Size * sizeof(MR_Char) + sizeof(MR_Word) - 1)
- / sizeof(MR_Word),
+ (Size * sizeof(MR_Char) + sizeof(MR_Word) - 1) / sizeof(MR_Word),
MR_PROC_LABEL, ""io:buffer/0"");
Buffer = (MR_Char *) buf;
}").
io__alloc_buffer(Size, buffer(Array)) :-
- % XXX '0' is used as Mercury doesn't recognise '\0' as
- % a char constant.
+ % XXX '0' is used as Mercury doesn't recognise '\0' as a char constant.
array__init(Size, '0', Array).
:- pred io__resize_buffer(int::in, int::in,
@@ -3279,8 +3221,7 @@
}").
io__resize_buffer(_OldSize, NewSize, buffer(Array0), buffer(Array)) :-
- % XXX '0' is used as Mercury doesn't recognise '\0' as
- % a char constant.
+ % XXX '0' is used as Mercury doesn't recognise '\0' as a char constant.
array__resize(Array0, NewSize, '0', Array).
:- pred io__buffer_to_string(buffer::buffer_di, int::in, string::uo) is det.
@@ -3473,31 +3414,25 @@
should_reduce_stack_usage(ShouldReduce),
(
ShouldReduce = no,
- io__binary_input_stream_foldl2_io_plain(Stream, Pred, T0, Res,
- !IO)
+ io__binary_input_stream_foldl2_io_plain(Stream, Pred, T0, Res, !IO)
;
ShouldReduce = yes,
- io__binary_input_stream_foldl2_io_chunk(Stream, Pred, T0, Res,
- !IO)
+ io__binary_input_stream_foldl2_io_chunk(Stream, Pred, T0, Res, !IO)
).
:- pred io__binary_input_stream_foldl2_io_plain(io__binary_input_stream,
- pred(int, T, T, io, io),
- T, io__maybe_partial_res(T), io, io).
+ pred(int, T, T, io, io), T, io__maybe_partial_res(T), io, io).
:- mode io__binary_input_stream_foldl2_io_plain(in,
- (pred(in, in, out, di, uo) is det),
- in, out, di, uo) is det.
+ (pred(in, in, out, di, uo) is det), in, out, di, uo) is det.
:- mode io__binary_input_stream_foldl2_io_plain(in,
- (pred(in, in, out, di, uo) is cc_multi),
- in, out, di, uo) is cc_multi.
+ (pred(in, in, out, di, uo) is cc_multi), in, out, di, uo) is cc_multi.
io__binary_input_stream_foldl2_io_plain(Stream, Pred, T0, Res, !IO) :-
io__read_byte(Stream, ByteResult, !IO),
(
ByteResult = ok(Byte),
Pred(Byte, T0, T1, !IO),
- io__binary_input_stream_foldl2_io_plain(Stream, Pred, T1, Res,
- !IO)
+ io__binary_input_stream_foldl2_io_plain(Stream, Pred, T1, Res, !IO)
;
ByteResult = eof,
Res = ok(T0)
@@ -3507,14 +3442,11 @@
).
:- pred io__binary_input_stream_foldl2_io_chunk(io__binary_input_stream,
- pred(int, T, T, io, io),
- T, io__maybe_partial_res(T), io, io).
+ pred(int, T, T, io, io), T, io__maybe_partial_res(T), io, io).
:- mode io__binary_input_stream_foldl2_io_chunk(in,
- (pred(in, in, out, di, uo) is det),
- in, out, di, uo) is det.
+ (pred(in, in, out, di, uo) is det), in, out, di, uo) is det.
:- mode io__binary_input_stream_foldl2_io_chunk(in,
- (pred(in, in, out, di, uo) is cc_multi),
- in, out, di, uo) is cc_multi.
+ (pred(in, in, out, di, uo) is cc_multi), in, out, di, uo) is cc_multi.
io__binary_input_stream_foldl2_io_chunk(Stream, Pred, T0, Res, !IO) :-
io__binary_input_stream_foldl2_io_inner(chunk_size, Stream, Pred, T0,
@@ -3527,19 +3459,15 @@
Res = error(T, Error)
;
InnerRes = more(T1),
- io__binary_input_stream_foldl2_io_chunk(Stream, Pred, T1, Res,
- !IO)
+ io__binary_input_stream_foldl2_io_chunk(Stream, Pred, T1, Res, !IO)
).
:- pred io__binary_input_stream_foldl2_io_inner(int, io__binary_input_stream,
- pred(int, T, T, io, io),
- T, chunk_inner_res(T), io, io).
+ pred(int, T, T, io, io), T, chunk_inner_res(T), io, io).
:- mode io__binary_input_stream_foldl2_io_inner(in, in,
- (pred(in, in, out, di, uo) is det),
- in, out, di, uo) is det.
+ (pred(in, in, out, di, uo) is det), in, out, di, uo) is det.
:- mode io__binary_input_stream_foldl2_io_inner(in, in,
- (pred(in, in, out, di, uo) is cc_multi),
- in, out, di, uo) is cc_multi.
+ (pred(in, in, out, di, uo) is cc_multi), in, out, di, uo) is cc_multi.
io__binary_input_stream_foldl2_io_inner(Left, Stream, Pred, T0, Res, !IO) :-
( Left > 0 ->
@@ -3562,8 +3490,7 @@
io__binary_input_stream_foldl2_io_maybe_stop(Pred, T0, Res, !IO) :-
io__binary_input_stream(Stream, !IO),
- io__binary_input_stream_foldl2_io_maybe_stop(Stream, Pred, T0, Res,
- !IO).
+ io__binary_input_stream_foldl2_io_maybe_stop(Stream, Pred, T0, Res, !IO).
io__binary_input_stream_foldl2_io_maybe_stop(Stream, Pred, T0, Res, !IO) :-
should_reduce_stack_usage(ShouldReduce),
@@ -3732,13 +3659,11 @@
io__read_from_string_with_int_instead_of_char(FileName, String, Len, Result,
!Posn) :-
IsAditiTuple = yes,
- io__read_from_string(IsAditiTuple, FileName, String, Len, Result,
- !Posn).
+ io__read_from_string(IsAditiTuple, FileName, String, Len, Result, !Posn).
io__read_from_string(FileName, String, Len, Result, !Posn) :-
IsAditiTuple = no,
- io__read_from_string(IsAditiTuple, FileName, String, Len, Result,
- !Posn).
+ io__read_from_string(IsAditiTuple, FileName, String, Len, Result, !Posn).
:- pred io__read_from_string(bool::in, string::in, string::in, int::in,
io__read_result(T)::out, posn::in, posn::out) is det.
@@ -3758,8 +3683,7 @@
(
(
IsAditiTuple = yes,
- term_to_type_with_int_instead_of_char(Term,
- Type)
+ term_to_type_with_int_instead_of_char(Term, Type)
;
IsAditiTuple = no,
term_to_type(Term, Type)
@@ -3767,14 +3691,12 @@
->
Result = ok(Type)
;
- ( \+ term__is_ground(Term) ->
- Result = error("io__read: the term read " ++
- "was not a ground term",
+ ( term__is_ground(Term) ->
+ Result = error(
+ "io__read: the term read did not have the right type",
LineNumber)
;
- Result = error(
- "io__read: the term read " ++
- "did not have the right type",
+ Result = error("io__read: the term read was not a ground term",
LineNumber)
)
)
@@ -3815,7 +3737,7 @@
%-----------------------------------------------------------------------------%
-% output predicates
+% Output predicates.
io__nl(!IO) :-
io__write_char('\n', !IO).
@@ -3860,7 +3782,7 @@
%-----------------------------------------------------------------------------%
-% various different versions of io__print
+% Various different versions of io__print.
:- pragma export(io__print(in, in(do_not_allow), in, di, uo),
"ML_io_print_dna_to_stream").
@@ -3916,8 +3838,8 @@
io__print_quoted(NonCanon, Term, !IO) :-
io__do_write(NonCanon, Term, !IO).
-% When we have type classes, then instead of io__write(Term),
-% we will want to do something like
+% When we have runtime type classes membership tests, then instead
+% of io__write(Term), we will want to do something like
% ( univ_to_type_class(Univ, Portrayable) ->
% portray(Portrayable, !IO)
% ;
@@ -3927,7 +3849,7 @@
%-----------------------------------------------------------------------------%
-% various different versions of io__write
+% Various different versions of io__write.
io__write(Stream, NonCanon, X, !IO) :-
io__set_output_stream(Stream, OrigStream, !IO),
@@ -3957,7 +3879,7 @@
%-----------------------------------------------------------------------------%
-% various different versions of io__write_univ
+% Various different versions of io__write_univ.
io__write_univ(Univ, !IO) :-
io__do_write_univ(canonicalize, Univ, !IO).
@@ -3990,11 +3912,10 @@
:- mode io__do_write_univ(in, in, in, di, uo) is cc_multi.
io__do_write_univ(NonCanon, Univ, Priority, !IO) :-
- %
- % we need to special-case the builtin types:
+ % We need to special-case the builtin types:
% int, char, float, string
% type_info, univ, c_pointer, array
- % and private_builtin:type_info
+ % and private_builtin.type_info
%
( univ_to_type(Univ, String) ->
term_io__quote_string(String, !IO)
@@ -4016,42 +3937,35 @@
; univ_to_type(Univ, C_Pointer) ->
io__write_c_pointer(C_Pointer, !IO)
;
+ % Check if the type is array.array/1. We can't just use univ_to_type
+ % here since array.array/1 is a polymorphic type.
%
- % Check if the type is array:array/1.
- % We can't just use univ_to_type here since
- % array:array/1 is a polymorphic type.
- %
- % The calls to type_ctor_name and type_ctor_module_name
- % are not really necessary -- we could use univ_to_type
- % in the condition instead of det_univ_to_type in the body.
- % However, this way of doing things is probably more efficient
- % in the common case when the thing being printed is
- % *not* of type array:array/1.
- %
- % The ordering of the tests here (arity, then name, then
- % module name, rather than the reverse) is also chosen
- % for efficiency, to find failure cheaply in the common cases,
- % rather than for readability.
+ % The calls to type_ctor_name and type_ctor_module_name are not really
+ % necessary -- we could use univ_to_type in the condition instead
+ % of det_univ_to_type in the body. However, this way of doing things
+ % is probably more efficient in the common case when the thing being
+ % printed is *not* of type array.array/1.
+ %
+ % The ordering of the tests here (arity, then name, then module name,
+ % rather than the reverse) is also chosen for efficiency, to find
+ % failure cheaply in the common cases, rather than for readability.
%
type_ctor_and_args(univ_type(Univ), TypeCtor, ArgTypes),
ArgTypes = [ElemType],
type_ctor_name(TypeCtor) = "array",
type_ctor_module_name(TypeCtor) = "array"
->
- %
- % Now that we know the element type, we can
- % constrain the type of the variable `Array'
- % so that we can use det_univ_to_type.
- %
+ % Now that we know the element type, we can constrain the type
+ % of the variable `Array' so that we can use det_univ_to_type.
+
has_type(Elem, ElemType),
same_array_elem_type(Array, Elem),
det_univ_to_type(Univ, Array),
io__write_array(Array, !IO)
;
- %
- % Check if the type is private_builtin:type_info/1.
- % See the comments above for array:array/1.
- %
+ % Check if the type is private_builtin.type_info/1.
+ % See the comments above for array.array/1.
+
type_ctor_and_args(univ_type(Univ), TypeCtor, ArgTypes),
ArgTypes = [ElemType],
type_ctor_name(TypeCtor) = "type_info",
@@ -4116,8 +4030,7 @@
io__write_char('}', !IO)
;
Args = [PrefixArg],
- ops__lookup_prefix_op(OpTable, Functor,
- OpPriority, OpAssoc)
+ ops__lookup_prefix_op(OpTable, Functor, OpPriority, OpAssoc)
->
maybe_write_paren('(', Priority, OpPriority, !IO),
term_io__quote_atom(Functor, !IO),
@@ -4127,8 +4040,7 @@
maybe_write_paren(')', Priority, OpPriority, !IO)
;
Args = [PostfixArg],
- ops__lookup_postfix_op(OpTable, Functor,
- OpPriority, OpAssoc)
+ ops__lookup_postfix_op(OpTable, Functor, OpPriority, OpAssoc)
->
maybe_write_paren('(', Priority, OpPriority, !IO),
adjust_priority_for_assoc(OpPriority, OpAssoc, NewPriority),
@@ -4138,8 +4050,8 @@
maybe_write_paren(')', Priority, OpPriority, !IO)
;
Args = [Arg1, Arg2],
- ops__lookup_infix_op(OpTable, Functor,
- OpPriority, LeftAssoc, RightAssoc)
+ ops__lookup_infix_op(OpTable, Functor, OpPriority,
+ LeftAssoc, RightAssoc)
->
maybe_write_paren('(', Priority, OpPriority, !IO),
adjust_priority_for_assoc(OpPriority, LeftAssoc, LeftPriority),
@@ -4151,24 +4063,21 @@
term_io__quote_atom(Functor, !IO),
io__write_char(' ', !IO)
),
- adjust_priority_for_assoc(OpPriority, RightAssoc,
- RightPriority),
+ adjust_priority_for_assoc(OpPriority, RightAssoc, RightPriority),
io__do_write_univ(NonCanon, Arg2, RightPriority, !IO),
maybe_write_paren(')', Priority, OpPriority, !IO)
;
Args = [Arg1, Arg2],
- ops__lookup_binary_prefix_op(OpTable, Functor,
- OpPriority, FirstAssoc, SecondAssoc)
+ ops__lookup_binary_prefix_op(OpTable, Functor, OpPriority,
+ FirstAssoc, SecondAssoc)
->
maybe_write_paren('(', Priority, OpPriority, !IO),
term_io__quote_atom(Functor, !IO),
io__write_char(' ', !IO),
- adjust_priority_for_assoc(OpPriority, FirstAssoc,
- FirstPriority),
+ adjust_priority_for_assoc(OpPriority, FirstAssoc, FirstPriority),
io__do_write_univ(NonCanon, Arg1, FirstPriority, !IO),
io__write_char(' ', !IO),
- adjust_priority_for_assoc(OpPriority, SecondAssoc,
- SecondPriority),
+ adjust_priority_for_assoc(OpPriority, SecondAssoc, SecondPriority),
io__do_write_univ(NonCanon, Arg2, SecondPriority, !IO),
maybe_write_paren(')', Priority, OpPriority, !IO)
;
@@ -4181,8 +4090,7 @@
term_io__quote_atom(Functor, !IO),
io__write_char(')', !IO)
;
- term_io__quote_atom(Functor,
- maybe_adjacent_to_graphic_token, !IO)
+ term_io__quote_atom(Functor, maybe_adjacent_to_graphic_token, !IO)
),
(
Args = [X | Xs]
@@ -4232,6 +4140,8 @@
io__do_write_univ(NonCanon, Univ, !IO)
).
+ % Write the remaining arguments.
+ %
:- pred io__write_term_args(deconstruct__noncanon_handling, list(univ),
io, io).
:- mode io__write_term_args(in(do_not_allow), in, di, uo) is det.
@@ -4239,7 +4149,6 @@
:- mode io__write_term_args(in(include_details_cc), in, di, uo) is cc_multi.
:- mode io__write_term_args(in, in, di, uo) is cc_multi.
- % write the remaining arguments
io__write_term_args(_, [], !IO).
io__write_term_args(NonCanon, [X | Xs], !IO) :-
io__write_string(", ", !IO),
@@ -4301,7 +4210,7 @@
:- pred io__write_c_pointer(c_pointer::in, io::di, io::uo) is det.
io__write_c_pointer(_C_Pointer, !IO) :-
- % XXX what should we do here?
+ % XXX What should we do here?
io__write_string("'<<c_pointer>>'", !IO).
:- pred io__write_array(array(T)::in, io::di, io::uo) is det.
@@ -4350,7 +4259,7 @@
io__set_binary_input_stream(OrigStream, _Stream, !IO).
io__write_binary(Term, !IO) :-
- % a quick-and-dirty implementation... not very space-efficient
+ % A quick-and-dirty implementation... not very space-efficient
% (not really binary!)
% XXX This will not work for the Java back-end. See the comment at the
% top of the MR_MercuryFileStruct class definition.
@@ -4359,7 +4268,7 @@
io__write_string(Stream, ".\n", !IO).
io__read_binary(Result, !IO) :-
- % a quick-and-dirty implementation... not very space-efficient
+ % A quick-and-dirty implementation... not very space-efficient
% (not really binary!)
% XXX This will not work for the Java back-end. See the comment at the
% top of the MR_MercuryFileStruct class definition.
@@ -4375,8 +4284,7 @@
; NewLineRes = ok('\n') ->
Result = ok(T)
;
- Result = error(io_error(
- "io.read_binary: missing newline"))
+ Result = error(io_error("io.read_binary: missing newline"))
)
;
ReadResult = eof,
@@ -4458,7 +4366,7 @@
%-----------------------------------------------------------------------------%
- % Declarative versions of Prolog's see/1 and seen/0.
+% Declarative versions of Prolog's see/1 and seen/0.
io__see(File, Result, !IO) :-
io__open_input(File, Result0, !IO),
@@ -4476,7 +4384,7 @@
io__set_input_stream(Stdin, OldStream, !IO),
io__close_input(OldStream, !IO).
- % Plus binary IO versions.
+% Plus binary IO versions.
io__see_binary(File, Result, !IO) :-
io__open_binary_input(File, Result0, !IO),
@@ -4496,7 +4404,7 @@
%-----------------------------------------------------------------------------%
- % Declarative versions of Prolog's tell/1 and told/0.
+% Declarative versions of Prolog's tell/1 and told/0.
io__told(!IO) :-
io__stdout_stream(Stdout, !IO),
@@ -4533,7 +4441,7 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-% stream name predicates
+% Stream name predicates.
io__input_stream_name(Name, !IO) :-
io__input_stream(Stream, !IO),
@@ -4699,21 +4607,20 @@
true
).
-% Return an integer that is nonzero if and only if we should delete
-% the information we have about stream when that stream is closed.
-% The debugger may need this information in order to display the stream id
-% in a user-friendly manner even after the stream is closed (e.g. after
-% performing a retry after the close), so if debugging is enabled, we
-% hang on to the stream info until the end of the execution. This is a
-% space leak, but one that is acceptable in a program being debugged.
-
+ % Return an integer that is nonzero if and only if we should delete
+ % the information we have about stream when that stream is closed.
+ % The debugger may need this information in order to display the stream id
+ % in a user-friendly manner even after the stream is closed (e.g. after
+ % performing a retry after the close), so if debugging is enabled, we
+ % hang on to the stream info until the end of the execution. This is a
+ % space leak, but one that is acceptable in a program being debugged.
+ %
:- pred io__may_delete_stream_info(int::out,
io__state::di, io__state::uo) is det.
:- pragma foreign_proc("C",
io__may_delete_stream_info(MayDelete::out, IO0::di, IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"
MayDelete = !MR_debug_ever_enabled;
IO = IO0;
@@ -4724,7 +4631,7 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-% global state predicates
+% Global state predicates.
% XXX design flaw with regard to unique modes
% and io__get_globals/3: the `Globals::uo' mode here is a lie.
@@ -4782,7 +4689,6 @@
io__get_stream_id(Stream::in) = (Id::out),
[will_not_call_mercury, promise_pure],
"
-
#ifndef MR_NATIVE_GC
/*
** Most of the time, we can just use the pointer to the stream
@@ -4791,7 +4697,7 @@
Id = (MR_Word) Stream;
#else
/*
- ** for accurate GC we embed an ID in the MercuryFile
+ ** For accurate GC we embed an ID in the MercuryFile
** and retrieve it here.
*/
Id = (Stream)->id;
@@ -4841,7 +4747,7 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-% statistics reporting predicates
+% Statistics reporting predicates.
io__report_stats(!IO) :-
io__report_stats("standard", !IO).
@@ -4859,8 +4765,7 @@
; Selector = "tabling" ->
impure table_builtin__table_report_statistics
;
- string__format(
- "io__report_stats: selector `%s' not understood",
+ string__format("io__report_stats: selector `%s' not understood",
[s(Selector)], Message),
error(Message)
).
@@ -4874,11 +4779,12 @@
% XXX Since on the IL backend pragma export is NYI, this
% predicate must be placed in the interface.
+ %
:- pred io__init_state(io::di, io::uo) is det.
:- implementation.
- % for use by the Mercury runtime
+ % For use by the Mercury runtime.
:- pragma export(io__init_state(di, uo), "ML_io_init_state").
io__init_state(!IO) :-
@@ -4892,13 +4798,12 @@
:- pred io__finalize_state(io::di, io::uo) is det.
- % for use by the Mercury runtime
+ % For use by the Mercury runtime.
:- pragma export(io__finalize_state(di, uo), "ML_io_finalize_state").
- % currently no finalization needed...
+ % Currently no finalization needed...
% (Perhaps we should close all open Mercury files?
- % That will happen on process exit anyway, so currently
- % we don't bother.)
+ % That will happen on process exit anyway, so currently we don't bother.)
io__finalize_state(!IO).
:- pred io__gc_init(type_desc::in, type_desc::in, io::di, io::uo) is det.
@@ -4924,11 +4829,9 @@
io__stdin_stream(Stdin, !IO),
io__insert_stream_info(Stdin, stream(0, input, preopen, stdin), !IO),
io__stdout_stream(Stdout, !IO),
- io__insert_stream_info(Stdout, stream(1, output, preopen, stdout),
- !IO),
+ io__insert_stream_info(Stdout, stream(1, output, preopen, stdout), !IO),
io__stderr_stream(Stderr, !IO),
- io__insert_stream_info(Stderr, stream(1, output, preopen, stderr),
- !IO).
+ io__insert_stream_info(Stderr, stream(1, output, preopen, stderr), !IO).
io__call_system(Command, Result, !IO) :-
io__call_system_return_signal(Command, Result0, !IO),
@@ -4938,8 +4841,7 @@
;
Result0 = ok(signalled(Signal)),
string__int_to_string(Signal, SignalStr),
- string__append("system command killed by signal number ",
- SignalStr, ErrMsg),
+ ErrMsg = "system command killed by signal number " ++ SignalStr,
Result = error(io_error(ErrMsg))
;
Result0 = error(Error),
@@ -4956,10 +4858,9 @@
:- type io__error
---> io_error(string). % This is subject to change.
- % Note that we use `io_error' rather than `io__error'
- % because io__print, which may be called to print out the uncaught
- % exception if there is no exception hander, does not print out
- % the module name.
+ % Note that we use `io_error' rather than `io__error' because io__print,
+ % which may be called to print out the uncaught exception if there is no
+ % exception hander, does not print out the module name.
io__make_io_error(Error) = io_error(Error).
@@ -4999,10 +4900,7 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-/*
-** The remaining predicates are implemented using the C interface.
-** They are also implemented for NU-Prolog in `io.nu.nl'.
-*/
+% The remaining predicates are implemented using the C interface.
:- pragma foreign_decl("C", "
@@ -5089,7 +4987,6 @@
public int line_number;
public int id;
-
};
}
}
@@ -5182,6 +5079,7 @@
public MR_MercuryFileStruct(java.lang.String file, char mode) {
id = ML_next_stream_id++;
String openstring;
+
if (mode == 'r') {
openstring = ""r"";
this.mode = INPUT;
@@ -5189,15 +5087,13 @@
} else if (mode == 'w' || mode == 'a') {
openstring = ""rw"";
this.mode = OUTPUT;
- // There is no such mode as ""w"", which could
- // be a problem for write-only files.
+ // There is no such mode as ""w"", which could be a problem
+ // for write-only files.
} else {
- throw new RuntimeException(
- ""Invalid file opening mode"");
+ throw new RuntimeException(""Invalid file opening mode"");
}
try {
- randomaccess = new java.io.RandomAccessFile(
- file, openstring);
+ randomaccess = new java.io.RandomAccessFile(file, openstring);
if (mode == 'a') {
seek(SEEK_END, 0);
}
@@ -5232,8 +5128,7 @@
mode = OUTPUT;
if (!openAsBinary) {
- output = new java.io.OutputStreamWriter(
- stream);
+ output = new java.io.OutputStreamWriter(stream);
} else {
/* open stdout as binary */
binary_output = new java.io.FileOutputStream(
@@ -5244,10 +5139,10 @@
/*
** size():
- ** Returns the length of a binary file. XXX Note that this
- ** method will return -1 for mercury_stdin_binary and
- ** the current position for mercury_stdout_binary in Java
- ** versions < 1.4.
+ **
+ ** Returns the length of a binary file. XXX Note that this method
+ ** will return -1 for mercury_stdin_binary and the current position
+ ** for mercury_stdout_binary in Java versions < 1.4.
*/
public int size() {
if (randomaccess != null) {
@@ -5260,10 +5155,8 @@
try {
java.lang.reflect.Method size_mth =
- channel.getClass().
- getMethod(""size"", null);
- return ((Long) size_mth.invoke(channel, null)).
- intValue();
+ channel.getClass().getMethod(""size"", null);
+ return ((Long) size_mth.invoke(channel, null)).intValue();
} catch (java.lang.Exception e) {
if (binary_output != null) {
return position;
@@ -5275,20 +5168,19 @@
/*
** seek():
- ** seek relative to start, current position or end
- ** depending on the flag.
- ** This function only works for binary files.
**
- ** The binary versions of stdin and stdout are treated
- ** specially as follows.
+ ** Seek relative to start, current position or end depending on the
+ ** flag. This function only works for binary files.
+ **
+ ** The binary versions of stdin and stdout are treated specially
+ ** as follows.
+ **
** For Java versions >= 1.4:
- ** Reflection is used to obtain and use the
- ** neccessary FileChannel object needed to perform
- ** seeking on each.
+ ** Reflection is used to obtain and use the necessary FileChannel
+ ** object needed to perform seeking on each.
** For older versions:
- ** For mercury_stdin_binary, seek may be
- ** only be done forwards from the current position
- ** and for mercury_stdout_binary seek is not
+ ** For mercury_stdin_binary, seek may be only be done forwards
+ ** from the current position and for mercury_stdout_binary seek is not
** supported at all.
*/
public void seek(int flag, int offset) {
@@ -5299,23 +5191,20 @@
if (input != null || output != null) {
throw new java.lang.RuntimeException(
- ""Java text streams are "" +
- ""not seekable"");
+ ""Java text streams are not seekable"");
}
if (binary_output != null) {
throw new java.lang.RuntimeException(
""for Java versions < 1.4, "" +
- ""mercury_stdout_binary is "" +
- ""not seekable"");
+ ""mercury_stdout_binary is not seekable"");
}
if (binary_input != null &&
(flag != SEEK_CUR || offset < 0))
{
throw new java.lang.RuntimeException(
""for Java versions < 1.4, "" +
- ""mercury_stdin_binary may "" +
- ""only seek forwards from "" +
- ""the current position"");
+ ""mercury_stdin_binary may only seek forwards "" +
+ ""from the current position"");
}
pushback = new java.util.Stack();
@@ -5328,40 +5217,32 @@
case SEEK_CUR:
if (randomaccess != null) {
randomaccess.seek(
- randomaccess.
- getFilePointer() +
- offset);
+ randomaccess.getFilePointer() + offset);
} else {
binary_input.skip(offset);
}
break;
case SEEK_END:
- randomaccess.seek(
- randomaccess.length() +
- offset);
+ randomaccess.seek(randomaccess.length() + offset);
break;
default:
throw new java.lang.
- RuntimeException(
- ""Invalid seek flag"");
+ RuntimeException(""Invalid seek flag"");
}
} catch (java.lang.Exception e) {
- throw new java.lang.RuntimeException(
- e.getMessage());
+ throw new java.lang.RuntimeException(e.getMessage());
}
}
/*
** channelSeek():
- ** seek relative to start, current position or end
- ** depending on the flag.
- ** This function is a special case of seek() above, used
- ** when a FileChannel is present and usable. At present,
- ** this is only the case for binary stdin/out using Java
- ** versions >= 1.4.
- ** FileChannel's position() method must be called using
- ** Reflection so that this code will still compile for
- ** Java versions < 1.4.
+ **
+ ** Seek relative to start, current position or end depending on the
+ ** flag. This function is a special case of seek() above, used when
+ ** a FileChannel is present and usable. At present, this is only the
+ ** case for binary stdin/out using Java versions >= 1.4. FileChannel's
+ ** position() method must be called using Reflection so that this code
+ ** will still compile for Java versions < 1.4.
*/
private void channelSeek(int flag, int offset) {
pushback = new java.util.Stack();
@@ -5372,16 +5253,14 @@
position = offset;
break;
case SEEK_CUR:
- position = getOffset() +
- offset;
+ position = getOffset() + offset;
break;
case SEEK_END:
position = size() + offset;
break;
default:
throw new java.lang.
- RuntimeException(
- ""Invalid seek flag"");
+ RuntimeException(""Invalid seek flag"");
}
// Simulate
@@ -5389,15 +5268,13 @@
// using reflection.
Class[] argTypes = {Long.TYPE};
java.lang.reflect.Method seek_mth =
- channel.getClass().getMethod(
- ""position"", argTypes);
+ channel.getClass().getMethod(""position"", argTypes);
Object[] args = {new Long(position)};
seek_mth.invoke(channel, args);
}
catch (java.lang.Exception e) {
- throw new java.lang.RuntimeException(
- e.getMessage());
+ throw new java.lang.RuntimeException(e.getMessage());
}
}
@@ -5408,8 +5285,7 @@
public int getOffset() {
if (randomaccess != null) {
try {
- return (int) randomaccess.
- getFilePointer();
+ return (int) randomaccess.getFilePointer();
} catch (java.io.IOException e) {
return -1;
}
@@ -5417,14 +5293,10 @@
try {
java.lang.reflect.Method posn_mth =
- channel.getClass().
- getMethod(""position"", null);
- return ((Long) posn_mth.invoke(channel, null)).
- intValue();
+ channel.getClass().getMethod(""position"", null);
+ return ((Long) posn_mth.invoke(channel, null)).intValue();
} catch (java.lang.Exception e) {
- if (binary_input != null ||
- binary_output != null)
- {
+ if (binary_input != null || binary_output != null) {
return position;
} else {
return -1;
@@ -5434,8 +5306,9 @@
/*
** read_char():
- ** Reads one character in from a text input file using the
- ** default charset decoding. Returns -1 at end of file.
+ **
+ ** Reads one character in from a text input file using the default
+ ** charset decoding. Returns -1 at end of file.
*/
public int read_char() {
int c;
@@ -5448,13 +5321,12 @@
try {
c = input.read();
} catch (java.io.IOException e) {
- throw new java.lang.RuntimeException(
- e.getMessage());
+ throw new java.lang.RuntimeException(e.getMessage());
}
} else {
- c = ((java.lang.Integer)pushback.pop()).
- intValue();
+ c = ((java.lang.Integer)pushback.pop()).intValue();
}
+
if (c == '\\n') {
line_number++;
}
@@ -5464,8 +5336,8 @@
/*
** read_byte():
- ** Reads one byte in from a binary file.
- ** Returns -1 at end of file.
+ **
+ ** Reads one byte in from a binary file. Returns -1 at end of file.
*/
public int read_byte() {
int c;
@@ -5486,12 +5358,10 @@
c = randomaccess.read();
}
} catch (java.io.IOException e) {
- throw new java.lang.RuntimeException(
- e.getMessage());
+ throw new java.lang.RuntimeException(e.getMessage());
}
} else {
- c = ((java.lang.Integer)pushback.pop()).
- intValue();
+ c = ((java.lang.Integer)pushback.pop()).intValue();
}
position++;
@@ -5500,10 +5370,10 @@
/*
** ungetc():
- ** Pushes an integer, which may represent either a byte or
- ** a character, onto the pushback stack. This stack
- ** is the same, regardless of whether the file is text or
- ** binary.
+ **
+ ** Pushes an integer, which may represent either a byte or a character,
+ ** onto the pushback stack. This stack is the same, regardless of
+ ** whether the file is text or binary.
*/
public void ungetc(int c) {
if (mode == OUTPUT) {
@@ -5520,11 +5390,12 @@
/*
** put():
- ** Write one unit to an output stream. If the file is
- ** text, the int will hold a character. If the file is
- ** binary, this will be a single byte. In the former case
- ** we assume that the lower order 16 bits hold a char, in
- ** latter we take only the lowest 8 bits for a byte.
+ **
+ ** Write one unit to an output stream. If the file is text, the int
+ ** will hold a character. If the file is binary, this will be a
+ ** single byte. In the former case we assume that the lower order
+ ** 16 bits hold a char, in latter we take only the lowest 8 bits
+ ** for a byte.
*/
public void put(int c) {
if (mode == INPUT) {
@@ -5545,17 +5416,16 @@
position++;
}
} catch (java.io.IOException e) {
- throw new java.lang.RuntimeException(
- e.getMessage());
+ throw new java.lang.RuntimeException(e.getMessage());
}
}
/*
** write():
- ** Writes a string to a file stream. For text files, this
- ** string is encoded as a byte stream using default
- ** encoding. For binary files, the lower order 8 bits of
- ** each character are written.
+ **
+ ** Writes a string to a file stream. For text files, this string
+ ** is encoded as a byte stream using default encoding. For binary
+ ** files, the lower order 8 bits of each character are written.
*/
public void write(java.lang.String s) {
if (mode == INPUT) {
@@ -5578,8 +5448,7 @@
}
}
} catch (java.io.IOException e) {
- throw new java.lang.RuntimeException(
- e.getMessage());
+ throw new java.lang.RuntimeException(e.getMessage());
}
}
@@ -5598,8 +5467,7 @@
}
// else randomaccess is already unbuffered.
} catch (java.io.IOException e) {
- throw new java.lang.RuntimeException(
- e.getMessage());
+ throw new java.lang.RuntimeException(e.getMessage());
}
}
@@ -5621,8 +5489,7 @@
binary_output.close();
}
} catch (java.io.IOException e) {
- throw new java.lang.RuntimeException(
- ""Error closing stream"");
+ throw new java.lang.RuntimeException(""Error closing stream"");
}
}
} // class MR_MercuryFileStruct
@@ -5669,16 +5536,15 @@
/*
** get_channel():
- ** Given some object, attempts to call getChannel() using
- ** Reflection and returns the result, or null if getChannel() is
- ** not available.
- ** The reason we do this is that FileChannels were not supported
- ** until Java v1.4, so users with older versions of Java would
- ** not be able to compile this code if the call to getChannel were
- ** made directly.
+ **
+ ** Given some object, attempts to call getChannel() using Reflection
+ ** and returns the result, or null if getChannel() is not available.
+ ** The reason we do this is that FileChannels were not supported until
+ ** Java v1.4, so users with older versions of Java would not be able to
+ ** compile this code if the call to getChannel were made directly.
** This way, older versions of Java will still be able to compile,
- ** but will not support binary seeking on stdin/out properly,
- ** since this can't be done without FileChannel.
+ ** but will not support binary seeking on stdin/out properly, since
+ ** this can't be done without FileChannel.
*/
static java.lang.Object/*FileChannel*/ get_channel(java.lang.Object o)
{
@@ -5687,8 +5553,7 @@
// return o.getChannel();
// using reflection.
java.lang.reflect.Method getChannel_mth =
- o.getClass().getMethod(
- ""getChannel"", null);
+ o.getClass().getMethod(""getChannel"", null);
return getChannel_mth.invoke(o, null);
}
@@ -5765,11 +5630,10 @@
return mf;
}
- // Note: for Windows GUI programs, the Console is set to the
- // equivalent of /dev/null. This could perhaps be considered a
- // problem. But if so, it is a problem in Windows, not in Mercury --
- // I don't think it is one that the Mercury implementation should
- // try to solve.
+ // Note: for Windows GUI programs, the Console is set to the equivalent
+ // of /dev/null. This could perhaps be considered a problem. But if so,
+ // it is a problem in Windows, not in Mercury -- I don't think it is one
+ // that the Mercury implementation should try to solve.
static MR_MercuryFileStruct mercury_stdin =
mercury_file_init(System.Console.OpenStandardInput(),
@@ -5789,12 +5653,16 @@
mercury_file_init(System.Console.OpenStandardOutput(),
null, System.Console.Out, ML_file_encoding_kind.ML_raw_binary);
-static MR_MercuryFileStruct mercury_current_text_input = mercury_stdin;
-static MR_MercuryFileStruct mercury_current_text_output = mercury_stdout;
-static MR_MercuryFileStruct mercury_current_binary_input = mercury_stdin_binary;
-static MR_MercuryFileStruct mercury_current_binary_output = mercury_stdout_binary;
+static MR_MercuryFileStruct mercury_current_text_input =
+ mercury_stdin;
+static MR_MercuryFileStruct mercury_current_text_output =
+ mercury_stdout;
+static MR_MercuryFileStruct mercury_current_binary_input =
+ mercury_stdin_binary;
+static MR_MercuryFileStruct mercury_current_binary_output =
+ mercury_stdout_binary;
-// XXX not thread-safe! */
+// XXX not thread-safe!
static System.Exception MR_io_exception;
").
@@ -5812,8 +5680,10 @@
static MR_MercuryFileStruct mercury_stdout_binary =
new MR_MercuryFileStruct(java.lang.System.out, true);
-static MR_MercuryFileStruct mercury_current_text_input = mercury_stdin;
-static MR_MercuryFileStruct mercury_current_text_output = mercury_stdout;
+static MR_MercuryFileStruct mercury_current_text_input =
+ mercury_stdin;
+static MR_MercuryFileStruct mercury_current_text_output =
+ mercury_stdout;
static MR_MercuryFileStruct mercury_current_binary_input =
mercury_stdin_binary;
static MR_MercuryFileStruct mercury_current_binary_output =
@@ -5893,8 +5763,7 @@
} else {
// we initialize the `reader' and `writer' fields to null;
// they will be filled in later if they are needed.
- return mercury_file_init(
- new System.IO.BufferedStream(stream),
+ return mercury_file_init(new System.IO.BufferedStream(stream),
null, null, file_encoding);
}
}
@@ -5971,29 +5840,25 @@
mercury_print_string(MR_MercuryFileStruct mf, string s)
{
//
- // For the .NET back-end, strings are represented as Unicode.
- // Text output streams (which may be connected to text files,
- // or to the console) require a byte stream.
- // This raises the question: how should we
- // convert from Unicode to the byte sequence?
+ // For the .NET back-end, strings are represented as Unicode. Text output
+ // streams (which may be connected to text files, or to the console)
+ // require a byte stream. This raises the question: how should we convert
+ // from Unicode to the byte sequence?
//
- // We leave this up to the system, by just using the TextWriter
- // associated with the file. For the console, this will be
- // System.Console.Out, which will use whatever encoding
- // is appropriate for the console. For a file, the TextWriter
- // will use the System.Encoding.Default encoding, which
- // will normally be an 8-bit national character set.
- // If the Unicode string contains characters which can't be
- // represented in this set, then the encoder will throw an exception.
+ // We leave this up to the system, by just using the TextWriter associated
+ // with the file. For the console, this will be System.Console.Out, which
+ // will use whatever encoding is appropriate for the console. For a file,
+ // the TextWriter will use the System.Encoding.Default encoding, which
+ // will normally be an 8-bit national character set. If the Unicode string
+ // contains characters which can't be represented in this set, then the
+ // encoder will throw an exception.
//
- // For files, we construct the TextWriter here, rather than at file
- // open time, so that we don't try to construct TextWriters for
- // input streams.
+ // For files, we construct the TextWriter here, rather than at file open
+ // time, so that we don't try to construct TextWriters for input streams.
if (mf.writer == null) {
mf.writer = new System.IO.StreamWriter(mf.stream,
System.Text.Encoding.Default);
-
}
switch (mf.file_encoding) {
@@ -6007,14 +5872,12 @@
}
break;
case ML_file_encoding_kind.ML_OS_text_encoding:
- //
- // We can't just use the System.TextWriter.Write(String)
- // method, since that method doesn't convert newline
- // characters to the system's newline convention
- // (e.g. CR-LF on Windows).
+ // We can't just use the System.TextWriter.Write(String) method,
+ // since that method doesn't convert newline characters to the
+ // system's newline convention (e.g. CR-LF on Windows).
// Only the WriteLine(...) method handles those properly.
// So we have to output each character separately.
- //
+
for (int i = 0; i < s.Length; i++) {
if (s[i] == '\\n') {
mf.line_number++;
@@ -6095,9 +5958,9 @@
// just like io__write_byte takes the byte from the bottom 8 bits
// of the int value.
-/* XXX possible alternative implementation.
- byte[] byte_array = System.Text.Encoding.Default().GetBytes(s);
-*/
+// XXX possible alternative implementation.
+// byte[] byte_array = System.Text.Encoding.Default().GetBytes(s);
+
int len = s.Length;
byte[] byte_array = new byte[len];
for (int i = 0; i < len; i++) {
@@ -6114,11 +5977,10 @@
:- pragma foreign_code("C#", "
-// Read in a character.
-// This means reading in one or more bytes,
+// Read in a character. This means reading in one or more bytes,
// converting the bytes from the system's default encoding to Unicode,
-// and possibly converting CR-LF to newline.
-// Returns -1 on error or EOF.
+// and possibly converting CR-LF to newline. Returns -1 on error or EOF.
+
static int
mercury_getc(MR_MercuryFileStruct mf)
{
@@ -6153,12 +6015,9 @@
// and that System.Environment.NewLine.Length > 0.
if (c != System.Environment.NewLine[0]) {
if (c == '\\n') {
- // the input file was ill-formed,
- // e.g. it contained only raw
- // LFs rather than CR-LF.
- // Perhaps we should throw an exception?
- // If not, we still need to treat
- // this as a newline, and thus
+ // the input file was ill-formed, e.g. it contained only raw
+ // LFs rather than CR-LF. Perhaps we should throw an exception?
+ // If not, we still need to treat this as a newline, and thus
// increment the line counter.
mf.line_number++;
}
@@ -6169,26 +6028,22 @@
c = '\\n';
break;
case 2:
- if (mf.reader.Peek() ==
- System.Environment.NewLine[1])
- {
+ if (mf.reader.Peek() == System.Environment.NewLine[1]) {
mf.reader.Read();
mf.line_number++;
c = '\\n';
} else if (c == '\\n') {
- // the input file was ill-formed,
- // e.g. it contained only raw
- // CRs rather than CR-LF. Perhaps
- // we should throw an exception?
- // If not, we still need to treat
- // this as a newline, and thus
- // increment the line counter.
+ // the input file was ill-formed, e.g. it contained only
+ // raw CRs rather than CR-LF. Perhaps we should throw an
+ // exception? If not, we still need to treat this
+ // as a newline, and thus increment the line counter.
mf.line_number++;
}
break;
default:
mercury.runtime.Errors.SORRY(
- ""mercury_getc: Environment.NewLine.Length is neither 1 nor 2"");
+ ""mercury_getc: Environment.NewLine.Length"" +
+ ""is neither 1 nor 2"");
break;
}
}
@@ -6305,18 +6160,15 @@
mercury_close(MercuryFilePtr mf)
{
if (MR_CLOSE(*mf) < 0) {
- mercury_io_error(mf, ""error closing file: %s"",
- strerror(errno));
+ mercury_io_error(mf, ""error closing file: %s"", strerror(errno));
}
#ifdef MR_NEW_MERCURYFILE_STRUCT
/*
- ** MR_closed_stream is a dummy stream object containing
- ** pointers to functions that always return an error
- ** indication.
- ** Doing this ensures that future accesses to the file
- ** will fail nicely.
+ ** MR_closed_stream is a dummy stream object containing pointers to
+ ** functions that always return an error indication. Doing this ensures
+ ** that future accesses to the file will fail nicely.
*/
/*
** gcc 2.95.2 barfs on `*mf = MR_closed_stream;'
@@ -6324,12 +6176,11 @@
*/
MR_memcpy(mf, &MR_closed_stream, sizeof(*mf));
-/*
-** XXX it would be nice to have an autoconf check
-** for the GNU libc function fopencookie();
-** we could use that to do a similar thing to what
-** we do in the MR_NEW_MERCURYFILE_STRUCT case.
-*/
+ /*
+ ** XXX It would be nice to have an autoconf check for the GNU libc
+ ** function fopencookie(); we could use that to do a similar thing to what
+ ** we do in the MR_NEW_MERCURYFILE_STRUCT case.
+ */
/****
#elif defined(HAVE_FOPENCOOKIE)
@@ -6339,16 +6190,14 @@
#else
/*
- ** We want future accesses to the file to fail nicely.
- ** Ideally they would throw an exception, but that would
- ** require a check at every I/O operation, and for simple
- ** operations like putchar() or getchar(), that would be
- ** too expensive. Instead we just set the file pointer
- ** to NULL; on systems which trap null pointer dereferences,
- ** or if library/io.m is compiled with MR_assert assertions
- ** enabled (i.e. -DMR_LOWLEVEL_DEBUG), this will ensure that
- ** accessing closed files traps immediately rather than
- ** causing problems at some later point.
+ ** We want future accesses to the file to fail nicely. Ideally they would
+ ** throw an exception, but that would require a check at every I/O
+ ** operation, and for simple operations like putchar() or getchar(),
+ ** that would be too expensive. Instead we just set the file pointer
+ ** to NULL; on systems which trap null pointer dereferences, or if
+ ** library/io.m is compiled with MR_assert assertions enabled
+ ** (i.e. -DMR_LOWLEVEL_DEBUG), this will ensure that accessing closed files
+ ** traps immediately rather than causing problems at some later point.
*/
MR_mercuryfile_init(NULL, 0, mf);
@@ -6367,12 +6216,10 @@
*/
} else {
/*
- ** For the accurate GC or no GC cases,
- ** we need to explicitly deallocate the memory here,
- ** to avoid a memory leak.
- ** Note that the accurate collector won't reclaim
- ** io_streams, since the io__stream type is defined
- ** as a foreign_type.
+ ** For the accurate GC or no GC cases, we need to explicitly deallocate
+ ** the memory here, to avoid a memory leak. Note that the accurate
+ ** collector won't reclaim io_streams, since the io__stream type
+ ** is defined as a foreign_type.
*/
MR_GC_free(mf);
}
@@ -6535,8 +6382,7 @@
:- pragma foreign_proc("C",
io__write_string(Message::in, IO0::di, IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"
mercury_print_string(mercury_current_text_output, Message);
MR_update_io(IO0, IO);
@@ -6544,8 +6390,7 @@
:- pragma foreign_proc("C",
io__write_char(Character::in, IO0::di, IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"
if (MR_PUTCH(*mercury_current_text_output, Character) < 0) {
mercury_output_error(mercury_current_text_output);
@@ -6558,8 +6403,7 @@
:- pragma foreign_proc("C",
io__write_int(Val::in, IO0::di, IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"
if (ML_fprintf(mercury_current_text_output, ""%ld"", (long) Val) < 0) {
mercury_output_error(mercury_current_text_output);
@@ -6569,8 +6413,7 @@
:- pragma foreign_proc("C",
io__write_float(Val::in, IO0::di, IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"
char buf[MR_SPRINTF_FLOAT_BUF_SIZE];
MR_sprintf_float(buf, Val);
@@ -6582,8 +6425,7 @@
:- pragma foreign_proc("C",
io__write_byte(Byte::in, IO0::di, IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"
/* call putc with a strictly non-negative byte-sized integer */
if (MR_PUTCH(*mercury_current_binary_output,
@@ -6596,8 +6438,7 @@
:- pragma foreign_proc("C",
io__write_bytes(Message::in, IO0::di, IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"{
mercury_print_binary_string(mercury_current_binary_output, Message);
MR_update_io(IO0, IO);
@@ -6605,8 +6446,7 @@
:- pragma foreign_proc("C",
io__flush_output(IO0::di, IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"
if (MR_FLUSH(*mercury_current_text_output) < 0) {
mercury_output_error(mercury_current_text_output);
@@ -6627,22 +6467,19 @@
:- pragma foreign_proc("C#",
io__write_string(Message::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"
mercury_print_string(mercury_current_text_output, Message);
").
:- pragma foreign_proc("C#",
io__write_char(Character::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"
/* See mercury_output_string() for comments */
if (mercury_current_text_output.writer == null) {
mercury_current_text_output.writer =
- new System.IO.StreamWriter(
- mercury_current_text_output.stream,
+ new System.IO.StreamWriter(mercury_current_text_output.stream,
System.Text.Encoding.Default);
}
System.IO.TextWriter w = mercury_current_text_output.writer;
@@ -6664,16 +6501,14 @@
:- pragma foreign_proc("C#",
io__write_int(Val::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"
mercury_print_string(mercury_current_text_output, Val.ToString());
").
:- pragma foreign_proc("C#",
io__write_byte(Byte::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"
mercury_current_binary_output.stream.WriteByte(
System.Convert.ToByte(Byte));
@@ -6681,85 +6516,74 @@
:- pragma foreign_proc("C#",
io__write_bytes(Message::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"{
mercury_print_binary_string(mercury_current_binary_output, Message);
}").
:- pragma foreign_proc("C#",
io__flush_output(_IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"
mercury_current_text_output.stream.Flush();
").
:- pragma foreign_proc("C#",
io__flush_binary_output(_IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"
mercury_current_binary_output.stream.Flush();
").
:- pragma foreign_proc("Java",
io__write_string(Message::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"
System.out.print(Message);
").
:- pragma foreign_proc("Java",
io__write_char(Character::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"
System.out.print(Character);
").
:- pragma foreign_proc("Java",
io__write_int(Val::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"
System.out.print(Val);
").
:- pragma foreign_proc("Java",
io__write_float(Val::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"
System.out.print(Val);
").
:- pragma foreign_proc("Java",
io__write_byte(Byte::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"
mercury_current_binary_output.put((byte) Byte);
").
:- pragma foreign_proc("Java",
io__write_bytes(Message::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"{
mercury_current_binary_output.write(Message);
}").
:- pragma foreign_proc("Java",
io__flush_output(_IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"
mercury_current_text_output.flush();
").
:- pragma foreign_proc("Java",
io__flush_binary_output(_IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"
mercury_current_binary_output.flush();
").
@@ -6767,7 +6591,7 @@
io__write_float(Float, !IO) :-
io__write_string(string__float_to_string(Float), !IO).
-/* moving about binary streams */
+% Moving about binary streams.
:- pred whence_to_int(io__whence::in, int::out) is det.
@@ -6793,8 +6617,7 @@
if (MR_IS_FILE_STREAM(*Stream)) {
fseek(MR_file(*Stream), Off, seek_flags[Flag]);
} else {
- mercury_io_error(Stream,
- ""io__seek_binary_2: unseekable stream"");
+ mercury_io_error(Stream, ""io__seek_binary_2: unseekable stream"");
}
MR_update_io(IO0, IO);
}").
@@ -6818,8 +6641,7 @@
:- pragma foreign_proc("C",
io__write_string(Stream::in, Message::in, IO0::di, IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"{
mercury_print_string(Stream, Message);
MR_update_io(IO0, IO);
@@ -6827,8 +6649,7 @@
:- pragma foreign_proc("C",
io__write_char(Stream::in, Character::in, IO0::di, IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"{
if (MR_PUTCH(*Stream, Character) < 0) {
mercury_output_error(Stream);
@@ -6852,8 +6673,7 @@
:- pragma foreign_proc("C",
io__write_float(Stream::in, Val::in, IO0::di, IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"{
char buf[MR_SPRINTF_FLOAT_BUF_SIZE];
MR_sprintf_float(buf, Val);
@@ -6865,8 +6685,7 @@
:- pragma foreign_proc("C",
io__write_byte(Stream::in, Byte::in, IO0::di, IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"{
/* call putc with a strictly non-negative byte-sized integer */
if (MR_PUTCH(*Stream, (int) ((unsigned char) Byte)) < 0) {
@@ -6877,8 +6696,7 @@
:- pragma foreign_proc("C",
io__write_bytes(Stream::in, Message::in, IO0::di, IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"{
mercury_print_binary_string(Stream, Message);
MR_update_io(IO0, IO);
@@ -6886,8 +6704,7 @@
:- pragma foreign_proc("C",
io__flush_output(Stream::in, IO0::di, IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"{
if (MR_FLUSH(*Stream) < 0) {
mercury_output_error(Stream);
@@ -6897,8 +6714,7 @@
:- pragma foreign_proc("C",
io__flush_binary_output(Stream::in, IO0::di, IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"{
if (MR_FLUSH(*Stream) < 0) {
mercury_output_error(Stream);
@@ -6908,16 +6724,14 @@
:- pragma foreign_proc("C#",
io__write_string(Stream::in, Message::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"{
mercury_print_string(Stream, Message);
}").
:- pragma foreign_proc("C#",
io__write_char(Stream::in, Character::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"{
MR_MercuryFileStruct stream = Stream;
/* See mercury_output_string() for comments */
@@ -6944,40 +6758,35 @@
:- pragma foreign_proc("C#",
io__write_int(Stream::in, Val::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"{
mercury_print_string(Stream, Val.ToString());
}").
:- pragma foreign_proc("C#",
io__write_byte(Stream::in, Byte::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"{
Stream.stream.WriteByte(System.Convert.ToByte(Byte));
}").
:- pragma foreign_proc("C#",
io__write_bytes(Stream::in, Message::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"{
mercury_print_binary_string(Stream, Message);
}").
:- pragma foreign_proc("C#",
io__flush_output(Stream::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"{
Stream.stream.Flush();
}").
:- pragma foreign_proc("C#",
io__flush_binary_output(Stream::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"{
Stream.stream.Flush();
}").
@@ -7000,64 +6809,56 @@
:- pragma foreign_proc("Java",
io__write_string(Stream::in, Message::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"
Stream.write(Message);
").
:- pragma foreign_proc("Java",
io__write_char(Stream::in, Character::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"
Stream.put(Character);
").
:- pragma foreign_proc("Java",
io__write_int(Stream::in, Val::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"
Stream.write(java.lang.String.valueOf(Val));
").
:- pragma foreign_proc("Java",
io__write_float(Stream::in, Val::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"
Stream.write(java.lang.String.valueOf(Val));
").
:- pragma foreign_proc("Java",
io__write_byte(Stream::in, Byte::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"
Stream.put(Byte);
").
:- pragma foreign_proc("Java",
io__write_bytes(Stream::in, Message::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"
Stream.write(Message);
").
:- pragma foreign_proc("Java",
io__flush_output(Stream::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"
Stream.flush();
").
:- pragma foreign_proc("Java",
io__flush_binary_output(Stream::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io,
- terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"
Stream.flush();
").
@@ -7065,7 +6866,7 @@
io__write_float(Stream, Float, !IO) :-
io__write_string(Stream, string__float_to_string(Float), !IO).
-/* stream predicates */
+% Stream predicates.
:- pragma export(io__stdin_stream(out, di, uo), "ML_io_stdin_stream").
:- pragma export(io__stdout_stream(out, di, uo), "ML_io_stdout_stream").
@@ -7216,9 +7017,6 @@
current_binary_output_stream(S, !IO) :-
binary_output_stream(S, !IO).
-% io__set_input_stream(NewStream, OldStream, IO0, IO1)
-% Changes the current input stream to the stream specified.
-% Returns the previous stream.
:- pragma foreign_proc("C",
io__set_input_stream(NewStream::in, OutStream::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
@@ -7376,9 +7174,6 @@
Stream.line_number = LineNum;
}").
-% io__set_input_stream(NewStream, OldStream, IO0, IO1)
-% Changes the current input stream to the stream specified.
-% Returns the previous stream.
:- pragma foreign_proc("C#",
io__set_input_stream(NewStream::in, OutStream::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
@@ -7570,16 +7365,17 @@
mercury_current_binary_output = NewStream;
").
- /* stream open/close predicates */
+% Stream open/close predicates.
% io__do_open_binary(File, Mode, ResultCode, StreamId, Stream, !IO):
% io__do_open_text(File, Mode, ResultCode, StreamId, Stream, !IO):
+ %
% Attempts to open a file in the specified mode.
% The Mode is a string suitable for passing to fopen().
% Result is 0 for success, -1 for failure.
% StreamId is a unique integer identifying the open.
% Both StreamId and Stream are valid only if Result == 0.
-
+ %
:- pred io__do_open_binary(string::in, string::in, int::out, int::out,
io__input_stream::out, io__state::di, io__state::uo) is det.
@@ -7658,9 +7454,8 @@
Stream = new MR_MercuryFileStruct(
new java.io.FileOutputStream(FileName, true));
} else {
- throw new java.lang.RuntimeException(
- ""io__do_open_text: Invalid open mode""
- + "" \\"""" + Mode + ""\\"""");
+ throw new java.lang.RuntimeException(""io__do_open_text: "" +
+ ""Invalid open mode"" + "" \\"""" + Mode + ""\\"""");
}
StreamId = Stream.id;
ResultCode = 0;
@@ -7709,8 +7504,7 @@
:- pragma foreign_proc("C",
io__close_stream(Stream::in, IO0::di, IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"
mercury_close(Stream);
MR_update_io(IO0, IO);
@@ -7718,21 +7512,19 @@
:- pragma foreign_proc("C#",
io__close_stream(Stream::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"
mercury_close(Stream);
").
:- pragma foreign_proc("Java",
io__close_stream(Stream::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates],
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
"
Stream.close();
").
-/* miscellaneous predicates */
+% Miscellaneous predicates.
:- pragma foreign_proc("C",
io__progname(DefaultProgname::in, PrognameOut::out, IO0::di, IO::uo),
@@ -7784,7 +7576,7 @@
[will_not_call_mercury, promise_pure, tabled_for_io],
"
Status = system(Command);
- if ( Status == -1 ) {
+ if (Status == -1) {
/*
** Return values of 127 or -1 from system() indicate that
** the system call failed. Don't return -1, as -1 indicates
@@ -7792,8 +7584,7 @@
*/
Status = 127;
ML_maybe_make_err_msg(MR_TRUE, errno,
- ""error invoking system command: "",
- MR_PROC_LABEL, Msg);
+ ""error invoking system command: "", MR_PROC_LABEL, Msg);
} else {
Msg = MR_make_string_const("""");
}
@@ -7801,29 +7592,27 @@
").
io__progname(DefaultProgName::in, ProgName::out, IO::di, IO::uo) :-
- % This is a fall-back for back-ends which don't support the
- % C interface.
+ % This is a fall-back for back-ends which don't support the C interface.
ProgName = DefaultProgName.
io__handle_system_command_exit_status(Code0) = Status :-
Code = io__handle_system_command_exit_code(Code0),
( Code = 127 ->
- Status = error(
- io_error("unknown result code from system command"))
+ Status = error(io_error("unknown result code from system command"))
; Code < 0 ->
Status = ok(signalled(-Code))
;
Status = ok(exited(Code))
).
- % Interpret the child process exit status returned by
- % system() or wait(): return negative for `signalled',
- % non-negative for `exited', or 127 for anything else
- % (e.g. an error invoking the command).
+ % Interpret the child process exit status returned by system() or wait():
+ % return negative for `signalled', non-negative for `exited', or 127
+ % for anything else (e.g. an error invoking the command).
+ %
:- func io__handle_system_command_exit_code(int) = int.
-% This is a fall-back for back-ends that don't support the C interface.
io__handle_system_command_exit_code(Status0::in) = (Status::out) :-
+ % This is a fall-back for back-ends that don't support the C interface.
( (Status0 /\ 0xff) \= 0 ->
/* the process was killed by a signal */
Status = -(Status0 /\ 0xff)
@@ -7863,10 +7652,9 @@
string[] arg_vector = System.Environment.GetCommandLineArgs();
int i = arg_vector.Length;
Args = mercury.list.mercury_code.ML_empty_list(null);
- // We don't get the 0th argument: it is the executable name
+ // We don't get the 0th argument: it is the executable name.
while (--i > 0) {
- Args = mercury.list.mercury_code.ML_cons(null,
- arg_vector[i], Args);
+ Args = mercury.list.mercury_code.ML_cons(null, arg_vector[i], Args);
}
").
@@ -7909,8 +7697,7 @@
Msg = """";
// debugging...
- // System.Console.Out.WriteLine(
- // ""[exitcode = "" + Status + ""]"");
+ // System.Console.Out.WriteLine(""[exitcode = "" + Status + ""]"");
}
catch (System.Exception e) {
@@ -7918,8 +7705,7 @@
Msg = e.Message;
// debugging...
- // System.Console.Out.WriteLine(
- // ""[message = "" + Msg + ""]"");
+ // System.Console.Out.WriteLine(""[message = "" + Msg + ""]"");
}
").
@@ -7959,10 +7745,10 @@
:- pred command_line_argument(int::in, string::out) is semidet.
+command_line_argument(_, "") :-
% XXX This predicate is currently only used by the Java implementation,
% but to prevent compilation warnings for (eg) the C implementation,
% some definition needs to be present.
-command_line_argument(_, "") :-
( semidet_succeed ->
error("unexpected call to command_line_argument")
;
@@ -8006,9 +7792,8 @@
Status = process.waitFor();
Msg = null;
- // The StreamPipes are killed off after the Process is
- // finished, so as not to waste CPU cycles with pointless
- // threads.
+ // The StreamPipes are killed off after the Process is finished,
+ // so as not to waste CPU cycles with pointless threads.
stdin.interrupt();
stdout.interrupt();
stderr.interrupt();
@@ -8030,7 +7815,7 @@
/*---------------------------------------------------------------------------*/
-/* io__getenv and io__setenv */
+% io__getenv and io__setenv.
:- pragma foreign_decl("C", "
#include <stdlib.h> /* for getenv() and putenv() */
@@ -8079,11 +7864,11 @@
io__setenv(Var, Value) :-
impure io__putenv(Var ++ "=" ++ Value).
- % io__putenv(VarString): If VarString is a string of the form
- % "name=value", sets the environment variable name to the specified
- % value. Fails if the operation does not work.
- % Not supported for .NET.
- % This should only be called from io__setenv.
+ % io__putenv(VarString): If VarString is a string of the form "name=value",
+ % sets the environment variable name to the specified value. Fails if
+ % the operation does not work. Not supported for .NET. This should only be
+ % called from io__setenv.
+ %
:- impure pred io__putenv(string::in) is semidet.
:- pragma foreign_proc("C",
@@ -8098,10 +7883,10 @@
[will_not_call_mercury, tabled_for_io],
"
/*
- ** Unfortunately there is no API in the .NET standard library
- ** for setting environment variables. So we need to use
- ** platform-specific methods. Currently we use the Posix function
- ** putenv(), which is also supported on Windows.
+ ** Unfortunately there is no API in the .NET standard library for setting
+ ** environment variables. So we need to use platform-specific methods.
+ ** Currently we use the Posix function putenv(), which is also supported
+ ** on Windows.
*/
SUCCESS_INDICATOR = (mercury.runtime.PInvoke._putenv(VarAndValue) == 0);
").
@@ -8175,13 +7960,10 @@
:- pred io__do_make_temp(string::in, string::in, string::in,
string::out, int::out, string::out, io::di, io::uo) is det.
-/*
-** XXX The code for io__make_temp assumes POSIX.
-** It uses the functions open(), close(), and getpid()
-** and the macros EEXIST, O_WRONLY, O_CREAT, and O_EXCL.
-** We should be using conditional compilation here to
-** avoid these POSIX dependencies.
-*/
+% XXX The code for io__make_temp assumes POSIX. It uses the functions open(),
+% close(), and getpid() and the macros EEXIST, O_WRONLY, O_CREAT, and O_EXCL.
+% We should be using conditional compilation here to avoid these POSIX
+% dependencies.
%#include <stdio.h>
@@ -8208,12 +7990,11 @@
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
/*
- ** Constructs a temporary name by concatenating Dir, `/',
- ** the first 5 chars of Prefix, three hex digits, '.',
- ** and 3 more hex digits. The six digit hex number is generated
- ** by starting with the pid of this process.
- ** Uses `open(..., O_CREATE | O_EXCL, ...)' to create the file,
- ** checking that there was no existing file with that name.
+ ** Constructs a temporary name by concatenating Dir, `/', the first 5 chars
+ ** of Prefix, three hex digits, '.', and 3 more hex digits. The six digit
+ ** hex number is generated by starting with the pid of this process.
+ ** Uses `open(..., O_CREATE | O_EXCL, ...)' to create the file, checking
+ ** that there was no existing file with that name.
*/
int len, err, fd, num_tries;
char countstr[256];
@@ -8244,14 +8025,12 @@
num_tries < ML_MAX_TEMPNAME_TRIES);
if (fd == -1) {
ML_maybe_make_err_msg(MR_TRUE, errno,
- ""error opening temporary file: "",
- MR_PROC_LABEL, ErrorMessage);
+ ""error opening temporary file: "", MR_PROC_LABEL, ErrorMessage);
Error = -1;
} else {
err = close(fd);
ML_maybe_make_err_msg(err, errno,
- ""error closing temporary file: "",
- MR_PROC_LABEL, ErrorMessage);
+ ""error closing temporary file: "", MR_PROC_LABEL, ErrorMessage);
Error = err;
}
MR_update_io(IO0, IO);
@@ -8312,8 +8091,8 @@
}
}").
-% For the Java implementation, io__make_temp/3 is overwritten directly, since
-% Java is capable of locating the default temp directory itself.
+% For the Java implementation, io__make_temp/3 is overwritten directly,
+% since Java is capable of locating the default temp directory itself.
:- pragma foreign_proc("Java",
io__do_make_temp(_Dir::in, _Prefix::in, _Sep::in, _FileName::out,
@@ -8331,8 +8110,7 @@
"
try {
java.io.File tmpdir = new java.io.File(
- java.lang.System.getProperty(
- ""java.io.tmpdir""));
+ java.lang.System.getProperty(""java.io.tmpdir""));
FileName = java.io.File.createTempFile(""mtmp"", null, tmpdir).
getName();
} catch (java.lang.Exception e) {
@@ -8352,9 +8130,8 @@
// at least 3 characters long.
Prefix = Prefix + ""tmp"";
} else if (Prefix.length() > 5) {
- // The documentation for io__make_temp says that
- // we should only use the first five characters
- // of Prefix.
+ // The documentation for io__make_temp says that we should only use
+ // the first five characters of Prefix.
Prefix = Prefix.substring(0, 5);
}
FileName = java.io.File.createTempFile(Prefix, null,
@@ -8388,6 +8165,7 @@
** It also needs to be a macro because MR_offset_incr_hp_atomic_msg()
** stringizes the procname argument.
*/
+
#define ML_maybe_make_err_msg(was_error, error, msg, procname, error_msg) \\
do { \\
char *errno_msg; \\
@@ -8398,18 +8176,15 @@
errno_msg = strerror(error); \\
total_len = strlen(msg) + strlen(errno_msg); \\
MR_offset_incr_hp_atomic_msg(tmp, 0, \\
- (total_len + sizeof(MR_Word)) \\
- / sizeof(MR_Word), \\
- procname, \\
- ""string:string/0""); \\
- (error_msg) = (char *)tmp; \\
+ (total_len + sizeof(MR_Word)) / sizeof(MR_Word), \\
+ procname, ""string.string/0""); \\
+ (error_msg) = (char *) tmp; \\
strcpy((error_msg), msg); \\
strcat((error_msg), errno_msg); \\
} else { \\
/* \\
- ** We can't just return NULL here, because \\
- ** otherwise mdb will break when it tries to \\
- ** print the string. \\
+ ** We can't just return NULL here, because otherwise mdb \\
+ ** will break when it tries to print the string. \\
*/ \\
(error_msg) = MR_make_string_const(""""); \\
} \\
@@ -8460,11 +8235,9 @@
} \\
total_len = strlen(msg) + strlen((char *)err_buf); \\
MR_incr_hp_atomic_msg(tmp, \\
- (total_len + sizeof(MR_Word)) \\
- / sizeof(MR_Word), \\
- procname, \\
- ""string:string/0""); \\
- (error_msg) = (char *)tmp; \\
+ (total_len + sizeof(MR_Word)) / sizeof(MR_Word), \\
+ procname, ""string.string/0""); \\
+ (error_msg) = (char *) tmp; \\
strcpy((error_msg), msg); \\
strcat((error_msg), (char *)err_buf); \\
if (free_err_buf) { \\
@@ -8472,9 +8245,8 @@
} \\
} else { \\
/* \\
- ** We can't just return NULL here, because \\
- ** otherwise mdb will break when it tries to \\
- ** print the string. \\
+ ** We can't just return NULL here, because otherwise mdb \\
+ ** will break when it tries to print the string. \\
*/ \\
(error_msg) = MR_make_string_const(""""); \\
} \\
@@ -8667,11 +8439,9 @@
io__read_symlink(FileName, Result, !IO) :-
( io__have_symlinks ->
- io__read_symlink_2(FileName, TargetFileName, Status, Error,
- !IO),
+ io__read_symlink_2(FileName, TargetFileName, Status, Error, !IO),
( Status = 0 ->
- io__make_err_msg(Error, "io.read_symlink failed: ",
- Msg, !IO),
+ io__make_err_msg(Error, "io.read_symlink failed: ", Msg, !IO),
Result = error(make_io_error(Msg))
;
Result = ok(TargetFileName)
@@ -8707,6 +8477,7 @@
buffer2 = MR_RESIZE_ARRAY(buffer2, char, buffer_size2);
num_chars = readlink(FileName, buffer2, PATH_MAX);
} while (num_chars == buffer_size2);
+
if (num_chars == -1) {
Error = errno;
TargetFileName = MR_make_string_const("""");
@@ -8728,9 +8499,8 @@
}
#else /* !MR_HAVE_READLINK */
/*
- ** We can't just return NULL here, because
- ** otherwise mdb will break when it tries to
- ** print the string.
+ ** We can't just return NULL here, because otherwise mdb will break
+ ** when it tries to print the string.
*/
TargetFileName = MR_make_string_const("""");
Status = 0;
Index: library/string.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/string.m,v
retrieving revision 1.237
diff -u -b -r1.237 string.m
--- library/string.m 29 Aug 2005 06:18:45 -0000 1.237
+++ library/string.m 18 Sep 2005 09:00:35 -0000
@@ -1,4 +1,6 @@
%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%---------------------------------------------------------------------------%
% Copyright (C) 1993-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
@@ -62,22 +64,22 @@
%
:- pred string__remove_suffix(string::in, string::in, string::out) is semidet.
- % string__prefix(String, Prefix) is true iff Prefix is a
- % prefix of String. Same as string__append(Prefix, _, String).
+ % string__prefix(String, Prefix) is true iff Prefix is a prefix of String.
+ % Same as string__append(Prefix, _, String).
%
:- pred string__prefix(string, string).
:- mode string__prefix(in, in) is semidet.
:- mode string__prefix(in, out) is multi.
- % string__suffix(String, Suffix) is true iff Suffix is a
- % suffix of String. Same as string__append(_, Suffix, String).
+ % string__suffix(String, Suffix) is true iff Suffix is a suffix of String.
+ % Same as string__append(_, Suffix, String).
%
:- pred string__suffix(string, string).
:- mode string__suffix(in, in) is semidet.
:- mode string__suffix(in, out) is multi.
- % string__string(X): Returns a canonicalized string
- % representation of the value X using the standard Mercury operators.
+ % string__string(X): Returns a canonicalized string representation
+ % of the value X using the standard Mercury operators.
%
:- func string__string(T) = string.
@@ -87,16 +89,16 @@
% string__string(NonCanon, OpsTable, X, String)
%
- % As above, but the caller specifies what behaviour should
- % occur for non-canonical terms (i.e. terms where multiple
- % representations may compare as equal):
- % - `do_not_allow' will throw an exception if (any subterm of)
- % the argument is not canonical;
- % - `canonicalize' will substitute a string indicating the
- % presence of a non-canonical subterm;
- % - `include_details_cc' will show the structure of any
- % non-canonical subterms, but can only be called from a
- % committed choice context.
+ % As above, but the caller specifies what behaviour should occur for
+ % non-canonical terms (i.e. terms where multiple representations
+ % may compare as equal):
+ %
+ % - `do_not_allow' will throw an exception if (any subterm of) the argument
+ % is not canonical;
+ % - `canonicalize' will substitute a string indicating the presence
+ % of a non-canonical subterm;
+ % - `include_details_cc' will show the structure of any non-canonical
+ % subterms, but can only be called from a committed choice context.
%
:- pred string__string(deconstruct__noncanon_handling, ops__table, T, string).
:- mode string__string(in(do_not_allow), in, in, out) is det.
@@ -105,8 +107,7 @@
:- mode string__string(in, in, in, out) is cc_multi.
% string__char_to_string(Char, String).
- % Converts a character (single-character atom) to a string
- % or vice versa.
+ % Converts a character (single-character atom) to a string or vice versa.
%
:- func string__char_to_string(char) = string.
:- mode string__char_to_string(in) = uo is det.
@@ -155,12 +156,12 @@
:- mode string__int_to_base_string_group(in, in, in, in) = uo is det.
% Convert a float to a string.
- % In the current implementation the resulting float will be in the
- % form that it was printed using the format string "%#.<prec>g".
+ % In the current implementation the resulting float will be in the form
+ % that it was printed using the format string "%#.<prec>g".
% <prec> will be in the range p to (p+2)
% where p = floor(mantissa_digits * log2(base_radix) / log2(10)).
- % The precision chosen from this range will be such to allow a
- % successful decimal -> binary conversion of the float.
+ % The precision chosen from this range will be such to allow a successful
+ % decimal -> binary conversion of the float.
%
:- func string__float_to_string(float) = string.
:- mode string__float_to_string(in) = uo is det.
@@ -171,14 +172,13 @@
%
:- func string__from_float(float::in) = (string::uo) is det.
- % string__first_char(String, Char, Rest) is true iff Char is
- % the first character of String, and Rest is the remainder.
+ % string__first_char(String, Char, Rest) is true iff Char is the first
+ % character of String, and Rest is the remainder.
%
- % WARNING: string__first_char makes a copy of Rest because the
- % garbage collector doesn't handle references into the middle
- % of an object, at least not the way we use it.
- % Repeated use of string__first_char to iterate
- % over a string will result in very poor performance.
+ % WARNING: string__first_char makes a copy of Rest because the garbage
+ % collector doesn't handle references into the middle of an object,
+ % at least not the way we use it. Repeated use of string__first_char
+ % to iterate over a string will result in very poor performance.
% Use string__foldl or string__to_char_list instead.
%
:- pred string__first_char(string, char, string).
@@ -197,8 +197,8 @@
is semidet.
% string__replace_all(String0, Search, Replace, String):
- % string__replace_all replaces any occurrences of Search in
- % String0 with Replace to give String.
+ % string__replace_all replaces any occurrences of Search in String0
+ % with Replace to give String.
%
:- func string__replace_all(string, string, string) = string.
:- mode string__replace_all(in, in, in) = uo is det.
@@ -264,27 +264,27 @@
% not match this syntax, string__to_int fails.
:- pred string__to_int(string::in, int::out) is semidet.
- % Convert a string in the specified base (2-36) to an int. The
- % string must contain one or more digits in the specified base,
- % optionally preceded by a plus or minus sign. For bases > 10,
- % digits 10 to 35 are represented by the letters A-Z or a-z. If
- % the string does not match this syntax, the predicate fails.
+ % Convert a string in the specified base (2-36) to an int. The string
+ % must contain one or more digits in the specified base, optionally
+ % preceded by a plus or minus sign. For bases > 10, digits 10 to 35
+ % are represented by the letters A-Z or a-z. If the string does not match
+ % this syntax, the predicate fails.
%
:- pred string__base_string_to_int(int::in, string::in, int::out) is semidet.
% Converts a signed base N string to an int; throws an exception
- % if the string argument is not precisely an optional sign followed
- % by a non-empty string of base N digits.
+ % if the string argument is not precisely an optional sign followed by
+ % a non-empty string of base N digits.
%
:- func string__det_base_string_to_int(int, string) = int.
- % Convert a string to a float. Throws an exception if the string
- % is not a syntactically correct float literal.
+ % Convert a string to a float. Throws an exception if the string is not
+ % a syntactically correct float literal.
%
:- func string__det_to_float(string) = float.
- % Convert a string to a float. If the string is not a syntactically
- % correct float literal, string__to_float fails.
+ % Convert a string to a float. If the string is not a syntactically correct
+ % float literal, string__to_float fails.
%
:- pred string__to_float(string::in, float::out) is semidet.
@@ -301,15 +301,15 @@
:- pred string__is_alnum_or_underscore(string::in) is semidet.
% string__pad_left(String0, PadChar, Width, String):
- % Insert `PadChar's at the left of `String0' until it is at least
- % as long as `Width', giving `String'.
+ % Insert `PadChar's at the left of `String0' until it is at least as long
+ % as `Width', giving `String'.
%
:- func string__pad_left(string, char, int) = string.
:- pred string__pad_left(string::in, char::in, int::in, string::out) is det.
% string__pad_right(String0, PadChar, Width, String):
- % Insert `PadChar's at the right of `String0' until it is at least
- % as long as `Width', giving `String'.
+ % Insert `PadChar's at the right of `String0' until it is at least as long
+ % as `Width', giving `String'.
%
:- func string__pad_right(string, char, int) = string.
:- pred string__pad_right(string::in, char::in, int::in, string::out) is det.
@@ -328,8 +328,8 @@
% string__index(String, Index, Char):
% `Char' is the (`Index' + 1)-th character of `String'.
- % Fails if `Index' is out of range (negative, or greater than or
- % equal to the length of `String').
+ % Fails if `Index' is out of range (negative, or greater than or equal to
+ % the length of `String').
%
:- pred string__index(string::in, int::in, char::uo) is semidet.
@@ -351,8 +351,7 @@
% WARNING: behavior is UNDEFINED if `Index' is out of range
% (negative, or greater than or equal to the length of `String').
% This version is constant time, whereas string__index_det
- % may be linear in the length of the string.
- % Use with care!
+ % may be linear in the length of the string. Use with care!
%
:- func string__unsafe_index(string, int) = char.
:- pred string__unsafe_index(string::in, int::in, char::uo) is det.
@@ -383,15 +382,15 @@
:- func string__strip(string) = string.
% string__lstrip(Pred, String):
- % `String' minus the maximal prefix consisting entirely of
- % chars satisfying `Pred'.
+ % `String' minus the maximal prefix consisting entirely of chars
+ % satisfying `Pred'.
%
:- func string__lstrip(pred(char)::in(pred(in) is semidet), string::in)
= (string::out) is det.
% string__rstrip(Pred, String):
- % `String' minus the maximal suffix consisting entirely of
- % chars satisfying `Pred'.
+ % `String' minus the maximal suffix consisting entirely of chars
+ % satisfying `Pred'.
%
:- func string__rstrip(pred(char)::in(pred(in) is semidet), string::in)
= (string::out) is det.
@@ -404,17 +403,16 @@
= (int::out) is det.
% string__suffix_length(Pred, String):
- % The length of the maximal suffix of `String' consisting entirely of
- % chars satisfying Pred.
+ % The length of the maximal suffix of `String' consisting entirely of chars
+ % satisfying Pred.
%
:- func suffix_length(pred(char)::in(pred(in) is semidet), string::in)
= (int::out) is det.
% string__set_char(Char, Index, String0, String):
- % `String' is `String0' with the (`Index' + 1)-th character
- % set to `Char'.
- % Fails if `Index' is out of range (negative, or greater than or
- % equal to the length of `String0').
+ % `String' is `String0' with the (`Index' + 1)-th character set to `Char'.
+ % Fails if `Index' is out of range (negative, or greater than or equal to
+ % the length of `String0').
%
:- pred string__set_char(char, int, string, string).
:- mode string__set_char(in, in, in, out) is semidet.
@@ -423,8 +421,7 @@
%:- mode string__set_char(in, in, di, uo) is semidet.
% string__set_char_det(Char, Index, String0, String):
- % `String' is `String0' with the (`Index' + 1)-th character
- % set to `Char'.
+ % `String' is `String0' with the (`Index' + 1)-th character set to `Char'.
% Calls error/1 if `Index' is out of range (negative, or greater than
% or equal to the length of `String0').
%
@@ -436,13 +433,11 @@
%:- mode string__set_char_det(in, in, di, uo) is det.
% string__unsafe_set_char(Char, Index, String0, String):
- % `String' is `String0' with the (`Index' + 1)-th character
- % set to `Char'.
+ % `String' is `String0' with the (`Index' + 1)-th character set to `Char'.
% WARNING: behavior is UNDEFINED if `Index' is out of range
% (negative, or greater than or equal to the length of `String0').
% This version is constant time, whereas string__set_char_det
- % may be linear in the length of the string.
- % Use with care!
+ % may be linear in the length of the string. Use with care!
%
:- func string__unsafe_set_char(char, int, string) = string.
:- mode string__unsafe_set_char(in, in, in) = out is det.
@@ -563,38 +558,38 @@
:- mode string__words(pred(in) is semidet, in) = out is det.
% string__words(String) = string__words(char__is_whitespace, String).
+ %
:- func string__words(string) = list(string).
% string__split(String, Count, LeftSubstring, RightSubstring):
% `LeftSubstring' is the left-most `Count' characters of `String',
% and `RightSubstring' is the remainder of `String'.
- % (If `Count' is out of the range [0, length of `String'], it is
- % treated as if it were the nearest end-point of that range.)
+ % (If `Count' is out of the range [0, length of `String'], it is treated
+ % as if it were the nearest end-point of that range.)
%
:- pred string__split(string::in, int::in, string::uo, string::uo) is det.
% string__left(String, Count, LeftSubstring):
% `LeftSubstring' is the left-most `Count' characters of `String'.
- % (If `Count' is out of the range [0, length of `String'], it is
- % treated as if it were the nearest end-point of that range.)
+ % (If `Count' is out of the range [0, length of `String'], it is treated
+ % as if it were the nearest end-point of that range.)
%
:- func string__left(string::in, int::in) = (string::uo) is det.
:- pred string__left(string::in, int::in, string::uo) is det.
% string__right(String, Count, RightSubstring):
% `RightSubstring' is the right-most `Count' characters of `String'.
- % (If `Count' is out of the range [0, length of `String'], it is
- % treated as if it were the nearest end-point of that range.)
+ % (If `Count' is out of the range [0, length of `String'], it is treated
+ % as if it were the nearest end-point of that range.)
%
:- func string__right(string::in, int::in) = (string::uo) is det.
:- pred string__right(string::in, int::in, string::uo) is det.
% string__substring(String, Start, Count, Substring):
- % `Substring' is first the `Count' characters in what would
- % remain of `String' after the first `Start' characters were
- % removed.
- % (If `Start' is out of the range [0, length of `String'], it is
- % treated as if it were the nearest end-point of that range.
+ % `Substring' is first the `Count' characters in what would remain
+ % of `String' after the first `Start' characters were removed.
+ % (If `Start' is out of the range [0, length of `String'], it is treated
+ % as if it were the nearest end-point of that range.
% If `Count' is out of the range [0, length of `String' - `Start'],
% it is treated as if it were the nearest end-point of that range.)
%
@@ -604,16 +599,14 @@
:- mode string__substring(in, in, in, uo) is det.
% string__unsafe_substring(String, Start, Count, Substring):
- % `Substring' is first the `Count' characters in what would
- % remain of `String' after the first `Start' characters were
- % removed.
+ % `Substring' is first the `Count' characters in what would remain
+ % of `String' after the first `Start' characters were removed.
% WARNING: if `Start' is out of the range [0, length of `String'],
% or if `Count' is out of the range [0, length of `String' - `Start'],
- % then the behaviour is UNDEFINED.
- % Use with care!
- % This version takes time proportional to the length of the
- % substring, whereas string__substring may take time proportional
- % to the length of the whole string.
+ % then the behaviour is UNDEFINED. Use with care!
+ % This version takes time proportional to the length of the substring,
+ % whereas string__substring may take time proportional to the length
+ %% of the whole string.
%
:- func string__unsafe_substring(string, int, int) = string.
:- mode string__unsafe_substring(in, in, in) = uo is det.
@@ -627,8 +620,7 @@
% string__join_list(Separator, Strings) = JoinedString:
% Appends together the strings in Strings, putting Separator between
- % adjacent strings. If Strings is the empty list, returns the empty
- % string.
+ % adjacent strings. If Strings is the empty list, returns the empty string.
%
:- func string__join_list(string::in, list(string)::in) = (string::uo) is det.
@@ -639,8 +631,8 @@
% string__sub_string_search(String, SubString, Index).
% `Index' is the position in `String' where the first occurrence of
- % `SubString' begins. Indices start at zero, so if `SubString'
- % is a prefix of `String', this will return Index = 0.
+ % `SubString' begins. Indices start at zero, so if `SubString' is a prefix
+ % of `String', this will return Index = 0.
%
:- pred string__sub_string_search(string::in, string::in, int::out) is semidet.
@@ -681,27 +673,26 @@
% g,G float either e or f with trailing zeros.
% p int integer
%
- % An option of zero will cause any padding to be zeros rather than
- % spaces. A '-' will cause the output to be left-justified in its
- % 'space'. (With a `-', the default is for fields to be
- % right-justified.)
+ % An option of zero will cause any padding to be zeros rather than spaces.
+ % A '-' will cause the output to be left-justified in its % 'space'.
+ % (With a `-', the default is for fields to be right-justified.)
% A '+' forces a sign to be printed. This is not sensible for string
- % and character output. A ' ' causes a space to be printed before a
- % thing if there is no sign there. The other option is the '#', which
- % modifies the output string's format. These options are normally put
- % directly after the '%'.
+ % and character output. A ' ' causes a space to be printed before a thing
+ % if there is no sign there. The other option is the '#', which modifies
+ % the output string's format. These options are normally put directly
+ % after the '%'.
+ %
+ % Notes:
%
- % Note:
% %#.0e, %#.0E now prints a '.' before the 'e'.
%
- % Asking for more precision than a float actually has will
- % result in potentially misleading output.
+ % Asking for more precision than a float actually has will result in
+ % potentially misleading output.
%
- % Numbers are now rounded by precision value, not
- % truncated as previously.
+ % Numbers are now rounded by precision value, not truncated as previously.
%
- % The implementation uses the sprintf() function, so the
- % actual output will depend on the C standard library.
+ % The implementation uses the sprintf() function, so the actual output
+ % will depend on the C standard library.
%
:- func string__format(string, list(string__poly_type)) = string.
:- pred string__format(string::in, list(string__poly_type)::in, string::out)
@@ -714,12 +705,11 @@
; c(char).
% format_table(Columns, Separator) = Table
- % format_table/2 takes a list of columns and a column separator
- % and returns a formatted table, where each field in each column
- % has been aligned and fields are seperated with Separator.
- % A newline character is inserted between each row.
- % If the columns are not all the same length then an exception is
- % thrown.
+ % format_table/2 takes a list of columns and a column separator and returns
+ % a formatted table, where each field in each column has been aligned
+ % and fields are seperated with Separator. A newline character is inserted
+ % between each row. If the columns are not all the same length then
+ % an exception is thrown.
%
% For example:
%
@@ -738,18 +728,18 @@
% word_wrap(Str, N) = Wrapped.
% Wrapped is Str with newlines inserted between words so that at most
- % N characters appear on a line and each line contains as many
- % whole words as possible. If any one word exceeds N characters in
- % length then it will be broken over two (or more) lines.
- % Sequences of whitespace characters are replaced by a single space.
+ % N characters appear on a line and each line contains as many whole words
+ % as possible. If any one word exceeds N characters in length then it will
+ % be broken over two (or more) lines. Sequences of whitespace characters
+ % are replaced by a single space.
%
:- func string__word_wrap(string, int) = string.
% word_wrap(Str, N, WordSeperator) = Wrapped.
- % word_wrap/3 is like word_wrap/2, except that words that need to be
- % broken up over multiple lines have WordSeperator inserted between
- % each piece. If the length of WordSeperator is greater that or equal
- % to N, then no seperator is used.
+ % word_wrap/3 is like word_wrap/2, except that words that need to be broken
+ % up over multiple lines have WordSeperator inserted between each piece.
+ % If the length of WordSeperator is greater that or equal to N, then
+ % no seperator is used.
%
:- func string__word_wrap(string, int, string) = string.
@@ -792,16 +782,16 @@
Result = string__append_list(Chunks)
).
-:- func string__replace_all(string, string, string,
- int, int, list(string)) = list(string).
+:- func string__replace_all(string, string, string, int, int, list(string))
+ = list(string).
string__replace_all(Str, Pat, Subst, PatLength, BeginAt, Result0) = Result :-
( sub_string_search(Str, Pat, BeginAt, Index) ->
Length = Index - BeginAt,
Initial = string__unsafe_substring(Str, BeginAt, Length),
Start = Index + PatLength,
- Result = string__replace_all(Str, Pat, Subst,
- PatLength, Start, [Subst, Initial | Result0])
+ Result = string__replace_all(Str, Pat, Subst, PatLength, Start,
+ [Subst, Initial | Result0])
;
Length = string__length(Str) - BeginAt,
EndString = string__unsafe_substring(Str, BeginAt, Length),
@@ -833,7 +823,7 @@
char__digit_to_int(Char, M),
M < Base.
-% It's important to inline string__index and string__index_det.
+% It is important to inline string__index and string__index_det.
% so that the compiler can do loop invariant hoisting
% on calls to string__length that occur in loops.
:- pragma inline(string__index_det/3).
@@ -870,8 +860,7 @@
string__foldl2_substring(Closure, String, Start0, Count0, !Acc1, !Acc2) :-
Start = max(0, Start0),
Count = min(Count0, length(String) - Start),
- string__foldl2_substring_2(Closure, String, Start, Count,
- !Acc1, !Acc2).
+ string__foldl2_substring_2(Closure, String, Start, Count, !Acc1, !Acc2).
:- pred string__foldl_substring_2(pred(char, A, A), string, int, int, A, A).
:- mode string__foldl_substring_2(pred(in, di, uo) is det, in, in, in,
@@ -888,8 +877,7 @@
string__foldl_substring_2(Closure, String, I, Count, !Acc) :-
( 0 < Count ->
Closure(string__unsafe_index(String, I), !Acc),
- string__foldl_substring_2(Closure, String, I + 1, Count - 1,
- !Acc)
+ string__foldl_substring_2(Closure, String, I + 1, Count - 1, !Acc)
;
true
).
@@ -980,8 +968,7 @@
prefix_2_iii(String, Prefix, I) :-
( 0 =< I ->
- (String `unsafe_index` I) =
- (Prefix `unsafe_index` I) `with_type` char,
+ (String `unsafe_index` I) = (Prefix `unsafe_index` I) `with_type` char,
prefix_2_iii(String, Prefix, I - 1)
;
true
@@ -1045,7 +1032,8 @@
string__int_to_base_string(N, Base, Str) :-
(
- Base >= 2, Base =< 36
+ Base >= 2,
+ Base =< 36
->
true
;
@@ -1053,17 +1041,13 @@
),
string__int_to_base_string_1(N, Base, Str).
-:- pred string__int_to_base_string_1(int, int, string).
-:- mode string__int_to_base_string_1(in, in, uo) is det.
+:- pred string__int_to_base_string_1(int::in, int::in, string::uo) is det.
string__int_to_base_string_1(N, Base, Str) :-
- % Note that in order to handle MININT correctly,
- % we need to do the conversion of the absolute
- % number into digits using negative numbers
+ % Note that in order to handle MININT correctly, we need to do the
+ % conversion of the absolute number into digits using negative numbers
% (we can't use positive numbers, since -MININT overflows)
- (
- N < 0
- ->
+ ( N < 0 ->
string__int_to_base_string_2(N, Base, Str1),
string__append("-", Str1, Str)
;
@@ -1071,17 +1055,14 @@
string__int_to_base_string_2(N1, Base, Str)
).
-:- pred string__int_to_base_string_2(int, int, string).
-:- mode string__int_to_base_string_2(in, in, uo) is det.
+:- pred string__int_to_base_string_2(int::in, int::in, string::uo) is det.
% string__int_to_base_string_2/3 is almost identical to
% string__int_to_base_string_group_2/6 below so any changes here might
% also need to be applied to string__int_to_base_string_group_2/3.
%
string__int_to_base_string_2(NegN, Base, Str) :-
- (
- NegN > -Base
- ->
+ ( NegN > -Base ->
N = -NegN,
char__det_int_to_digit(N, DigitChar),
string__char_to_string(DigitChar, Str)
@@ -1104,7 +1085,8 @@
%
string__int_to_base_string_group(N, Base, Period, Sep) = Str :-
(
- Base >= 2, Base =< 36
+ Base >= 2,
+ Base =< 36
->
true
;
@@ -1118,20 +1100,15 @@
% Period is how many digits should be between each separator.
%
string__int_to_base_string_group_1(N, Base, Period, Sep, Str) :-
- % Note that in order to handle MININT correctly,
- % we need to do the conversion of the absolute
- % number into digits using negative numbers
+ % Note that in order to handle MININT correctly, we need to do
+ % the conversion of the absolute number into digits using negative numbers
% (we can't use positive numbers, since -MININT overflows)
- (
- N < 0
- ->
- string__int_to_base_string_group_2(N, Base, 0, Period, Sep,
- Str1),
+ ( N < 0 ->
+ string__int_to_base_string_group_2(N, Base, 0, Period, Sep, Str1),
string__append("-", Str1, Str)
;
N1 = 0 - N,
- string__int_to_base_string_group_2(N1, Base, 0, Period, Sep,
- Str)
+ string__int_to_base_string_group_2(N1, Base, 0, Period, Sep, Str)
).
:- pred string__int_to_base_string_group_2(int::in, int::in, int::in, int::in,
@@ -1146,15 +1123,13 @@
%
string__int_to_base_string_group_2(NegN, Base, Curr, Period, Sep, Str) :-
(
- Curr = Period, Period > 0
+ Curr = Period,
+ Period > 0
->
- string__int_to_base_string_group_2(NegN, Base, 0, Period, Sep,
- Str1),
+ string__int_to_base_string_group_2(NegN, Base, 0, Period, Sep, Str1),
string__append(Str1, Sep, Str)
;
- (
- NegN > -Base
- ->
+ ( NegN > -Base ->
N = -NegN,
char__det_int_to_digit(N, DigitChar),
string__char_to_string(DigitChar, Str)
@@ -1163,8 +1138,8 @@
N10 = (NegN1 * Base) - NegN,
char__det_int_to_digit(N10, DigitChar),
string__char_to_string(DigitChar, DigitString),
- string__int_to_base_string_group_2(NegN1, Base,
- Curr + 1, Period, Sep, Str1),
+ string__int_to_base_string_group_2(NegN1, Base, Curr + 1, Period,
+ Sep, Str1),
string__append(Str1, DigitString, Str)
)
).
@@ -1197,8 +1172,8 @@
size_t size;
/*
- ** loop to calculate list length + sizeof(MR_Word) in `size'
- ** using list in `char_list_ptr'
+ ** Loop to calculate list length + sizeof(MR_Word) in `size'
+ ** using list in `char_list_ptr'.
*/
size = sizeof(MR_Word);
char_list_ptr = CharList;
@@ -1208,13 +1183,13 @@
}
/*
- ** allocate (length + 1) bytes of heap space for string
- ** i.e. (length + 1 + sizeof(MR_Word) - 1) / sizeof(MR_Word) words
+ ** Allocate (length + 1) bytes of heap space for string
+ ** i.e. (length + 1 + sizeof(MR_Word) - 1) / sizeof(MR_Word) words.
*/
MR_allocate_aligned_string_msg(Str, size, MR_PROC_LABEL);
/*
- ** loop to copy the characters from the char_list to the string
+ ** Loop to copy the characters from the char_list to the string.
*/
size = 0;
char_list_ptr = CharList;
@@ -1222,24 +1197,26 @@
Str[size++] = MR_list_head(char_list_ptr);
char_list_ptr = MR_list_tail(char_list_ptr);
}
- /*
- ** null terminate the string
- */
+
Str[size] = '\\0';
}").
:- pragma promise_pure(string__to_char_list/2).
+
string__to_char_list(Str::in, CharList::out) :-
string__to_char_list_2(Str, 0, CharList).
string__to_char_list(Str::uo, CharList::in) :-
- ( CharList = [],
+ (
+ CharList = [],
Str = ""
- ; CharList = [C | Cs],
+ ;
+ CharList = [C | Cs],
string__to_char_list(Str0, Cs),
string__first_char(Str, C, Str0)
).
:- pred string__to_char_list_2(string::in, int::in, list(char)::uo) is det.
+
string__to_char_list_2(Str, Index, CharList) :-
( string__index(Str, Index, Char) ->
string__to_char_list_2(Str, Index + 1, CharList0),
@@ -1248,13 +1225,12 @@
CharList = []
).
-/*-----------------------------------------------------------------------*/
+%---------------------------------------------------------------------------%
-%
% We could implement from_rev_char_list using list__reverse and from_char_list,
% but the optimized implementation in C below is there for efficiency since
% it improves the overall speed of parsing by about 7%.
-%
+
:- pragma foreign_proc("C",
string__from_rev_char_list(Chars::in, Str::uo),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -1263,9 +1239,8 @@
MR_Word size, len;
/*
- ** loop to calculate list length + sizeof(MR_Word) in `size'
- ** using list in `list_ptr' and separately count the length of the
- ** string
+ ** Loop to calculate list length + sizeof(MR_Word) in `size'
+ ** using list in `list_ptr' and separately count the length of the string.
*/
size = sizeof(MR_Word);
len = 1;
@@ -1277,19 +1252,19 @@
}
/*
- ** allocate (length + 1) bytes of heap space for string
- ** i.e. (length + 1 + sizeof(MR_Word) - 1) / sizeof(MR_Word) words
+ ** Allocate (length + 1) bytes of heap space for string
+ ** i.e. (length + 1 + sizeof(MR_Word) - 1) / sizeof(MR_Word) words.
*/
MR_allocate_aligned_string_msg(Str, size, MR_PROC_LABEL);
/*
- ** set size to be the offset of the end of the string
+ ** Set size to be the offset of the end of the string
** (ie the \\0) and null terminate the string.
*/
Str[--len] = '\\0';
/*
- ** loop to copy the characters from the list_ptr to the string
+ ** Loop to copy the characters from the list_ptr to the string
** in reverse order.
*/
list_ptr = Chars;
@@ -1395,8 +1370,8 @@
string__append_list(Lists, string__append_list(Lists)).
- % Implementation of string__append_list that uses C as this
- % minimises the amount of garbage created.
+ % We implement string__append_list in C as this minimises
+ % the amount of garbage created.
:- pragma foreign_proc("C",
string__append_list(Strs::in) = (Str::uo),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -1424,22 +1399,23 @@
list = MR_list_tail(list);
}
- /* Set the last character to the null char */
Str[len] = '\\0';
}").
- % Implementation of string__join_list that uses C as this
- % minimises the amount of garbage created.
+ % We implement string__join_list in C as this minimises the amount of
+ % garbage created.
:- pragma foreign_proc("C",
string__join_list(Sep::in, Strs::in) = (Str::uo),
[will_not_call_mercury, promise_pure, thread_safe],
"{
- MR_Word list = Strs;
+ MR_Word list;
MR_Word tmp;
- size_t len = 0;
+ size_t len;
size_t sep_len;
MR_bool add_sep;
+ list = Strs;
+ len = 0;
sep_len = strlen(Sep);
/* Determine the total length of all strings */
@@ -1473,24 +1449,25 @@
add_sep = MR_TRUE;
}
- /* Set the last character to the null char */
Str[len] = '\\0';
}").
string__append_list(Strs::in) = (Str::uo) :-
- ( Strs = [X | Xs] ->
+ (
+ Strs = [X | Xs],
Str = X ++ append_list(Xs)
;
+ Strs = [],
Str = ""
).
string__join_list(_, []) = "".
string__join_list(Sep, [H | T]) = H ++ string__join_list_2(Sep, T).
-:- func string__join_list_2(string::in, list(string)::in) = (string::uo) is det.
+:- func join_list_2(string::in, list(string)::in) = (string::uo) is det.
-string__join_list_2(_, []) = "".
-string__join_list_2(Sep, [H | T]) = Sep ++ H ++ string__join_list_2(Sep, T).
+join_list_2(_, []) = "".
+join_list_2(Sep, [H | T]) = Sep ++ H ++ join_list_2(Sep, T).
%-----------------------------------------------------------------------------%
@@ -1504,19 +1481,18 @@
:- pred string__hash_2(string::in, int::in, int::in, int::in, int::out) is det.
-string__hash_2(String, Index, Length, HashVal0, HashVal) :-
+string__hash_2(String, Index, Length, !HashVal) :-
( Index < Length ->
- string__combine_hash(HashVal0,
- char__to_int(string__unsafe_index(String, Index)),
- HashVal1),
- string__hash_2(String, Index + 1, Length, HashVal1, HashVal)
+ string__combine_hash(char__to_int(string__unsafe_index(String, Index)),
+ !HashVal),
+ string__hash_2(String, Index + 1, Length, !HashVal)
;
- HashVal = HashVal0
+ true
).
:- pred string__combine_hash(int::in, int::in, int::out) is det.
-string__combine_hash(H0, X, H) :-
+string__combine_hash(X, H0, H) :-
H1 = H0 `xor` (H0 << 5),
H = H1 `xor` X.
@@ -1552,36 +1528,34 @@
sub_string_search_2(String, SubString, BeginAt, length(String),
length(SubString), Index).
- % Brute force string searching. For short Strings this is
- % good; for longer strings Boyer-Moore is much better.
+ % Brute force string searching. For short Strings this is good;
+ % for longer strings Boyer-Moore is much better.
+ %
:- pred sub_string_search_2(string::in, string::in, int::in, int::in, int::in,
int::out) is semidet.
sub_string_search_2(String, SubString, I, Length, SubLength, Index) :-
I < Length,
(
- % XXX This is inefficient --
- % there is no (in, in, in) = in is semidet mode of
- % substring, so this ends up calling the
- % (in, in, in) = out mode and then doing the unification.
- % This will create a lot of unnecessary garbage.
+ % XXX This is inefficient -- there is no (in, in, in) = in is semidet
+ % mode of substring, so this ends up calling the (in, in, in) = out
+ % mode and then doing the unification. This will create a lot of
+ % unnecessary garbage.
substring(String, I, SubLength) = SubString
->
Index = I
;
- sub_string_search_2(String, SubString, I + 1,
- Length, SubLength, Index)
+ sub_string_search_2(String, SubString, I + 1, Length, SubLength, Index)
).
%-----------------------------------------------------------------------------%
- % This predicate has been optimised to produce the least memory
- % possible -- memory usage is a significant problem for programs
- % which do a lot of formatted IO.
string__format(FormatString, PolyList, String) :-
+ % This predicate has been optimised to produce the least memory possible
+ % -- memory usage is a significant problem for programs which do a lot of
+ % formatted IO.
(
- format_string(Specifiers, PolyList, [],
- to_char_list(FormatString), [])
+ format_string(Specifiers, PolyList, [], to_char_list(FormatString), [])
->
String = string__append_list(
list__map(specifier_to_string, Specifiers))
@@ -1598,60 +1572,56 @@
)
; string(list(char)).
- %
- % A format string is parsed into alternate sections.
- % We alternate between the list of characters which don't
- % represent a conversion specifier and those that do.
+ % A format string is parsed into alternate sections. We alternate between
+ % the list of characters which don't represent a conversion specifier
+ % and those that do.
%
:- pred format_string(list(string__specifier)::out,
list(string__poly_type)::in, list(string__poly_type)::out,
list(char)::in, list(char)::out) is det.
-format_string(Results, PolyTypes0, PolyTypes) -->
- other(NonConversionSpecChars),
- ( conversion_specification(ConversionSpec, PolyTypes0, PolyTypes1) ->
- format_string(Results0, PolyTypes1, PolyTypes),
- { Results = [string(NonConversionSpecChars),
- ConversionSpec | Results0] }
+format_string(Results, !PolyTypes, !Chars) :-
+ other(NonConversionSpecChars, !Chars),
+ ( conversion_specification(ConversionSpec, !PolyTypes, !Chars) ->
+ format_string(Results0, !PolyTypes, !Chars),
+ Results = [string(NonConversionSpecChars), ConversionSpec | Results0]
;
- { Results = [string(NonConversionSpecChars)] },
- { PolyTypes = PolyTypes0 }
+ Results = [string(NonConversionSpecChars)]
).
- %
- % Parse a string which doesn't contain any conversion
- % specifications.
+ % Parse a string which doesn't contain any conversion specifications.
%
:- pred other(list(char)::out, list(char)::in, list(char)::out) is det.
-other(Result) -->
- ( [Char], { Char \= '%' } ->
- other(Result0),
- { Result = [Char | Result0] }
+other(Result, !Chars) :-
+ (
+ !.Chars = [Char | !:Chars],
+ Char \= '%'
+ ->
+ other(Result0, !Chars),
+ Result = [Char | Result0]
;
- { Result = [] }
+ Result = []
).
- %
- % Each conversion specification is introduced by the character
- % '%', and ends with a conversion specifier. In between there
- % may be (in this order) zero or more flags, an optional
- % minimum field width, and an optional precision.
+ % Each conversion specification is introduced by the character '%',
+ % and ends with a conversion specifier. In between there may be
+ % (in this order) zero or more flags, an optional minimum field width,
+ % and an optional precision.
%
:- pred conversion_specification(string__specifier::out,
list(string__poly_type)::in, list(string__poly_type)::out,
list(char)::in, list(char)::out) is semidet.
-conversion_specification(Specificier, PolyTypes0, PolyTypes) -->
- ['%'],
- flags(Flags),
- optional(width, MaybeWidth, PolyTypes0, PolyTypes1),
- optional(prec, MaybePrec, PolyTypes1, PolyTypes2),
- ( spec(Spec, PolyTypes2, PolyTypes3) ->
- { Specificier = conv(Flags, MaybeWidth, MaybePrec, Spec) },
- { PolyTypes = PolyTypes3 }
+conversion_specification(Specificier, !PolyTypes, !Chars) :-
+ !.Chars = ['%' | !:Chars],
+ flags(Flags, !Chars),
+ optional(width, MaybeWidth, !PolyTypes, !Chars),
+ optional(prec, MaybePrec, !PolyTypes, !Chars),
+ ( spec(Spec, !PolyTypes, !Chars) ->
+ Specificier = conv(Flags, MaybeWidth, MaybePrec, Spec)
;
- { error("string__format: invalid conversion specifier.") }
+ error("string__format: invalid conversion specifier.")
).
:- pred optional(
@@ -1669,15 +1639,17 @@
:- pred flags(list(char)::out, list(char)::in, list(char)::out) is semidet.
-flags(Result) -->
- ( [Char], { flag(Char) } ->
- flags(Result0),
- { Result = [Char | Result0] }
+flags(Result, !Chars) :-
+ (
+ !.Chars = [Char | !:Chars],
+ flag(Char)
+ ->
+ flags(Result0, !Chars),
+ Result = [Char | Result0]
;
- { Result = [] }
+ Result = []
).
- %
% Is it a valid flag character?
%
:- pred flag(char::in) is semidet.
@@ -1688,64 +1660,56 @@
flag(' ').
flag('+').
- %
% Do we have a minimum field width?
%
:- pred width(list(char)::out,
list(string__poly_type)::in, list(string__poly_type)::out,
list(char)::in, list(char)::out) is semidet.
-width(Width, PolyTypes0, PolyTypes) -->
- ( ['*'] ->
- { PolyTypes0 = [i(Width0) | PolyTypes1] ->
+width(Width, !PolyTypes, !Chars) :-
+ ( !.Chars = ['*' | !:Chars] ->
+ ( !.PolyTypes = [i(Width0) | !:PolyTypes] ->
% XXX may be better done in C.
- Width = to_char_list(int_to_string(Width0)),
- PolyTypes = PolyTypes1
+ Width = to_char_list(int_to_string(Width0))
;
- error("string__format: `*' width modifier " ++
- "not associated with an integer.")
- }
+ error("string__format: " ++
+ "`*' width modifier not associated with an integer.")
+ )
;
- =(Init),
- non_zero_digit,
- zero_or_more_occurences(digit),
- =(Final),
+ Init = !.Chars,
+ non_zero_digit(!Chars),
+ zero_or_more_occurences(digit, !Chars),
+ Final = !.Chars,
- { char_list_remove_suffix(Init, Final, Width) },
- { PolyTypes = PolyTypes0 }
+ char_list_remove_suffix(Init, Final, Width)
).
- %
% Do we have a precision?
%
:- pred prec(list(char)::out,
list(string__poly_type)::in, list(string__poly_type)::out,
list(char)::in, list(char)::out) is semidet.
-prec(Prec, PolyTypes0, PolyTypes) -->
- ['.'],
- ( ['*'] ->
- { PolyTypes0 = [i(Prec0) | PolyTypes1] ->
+prec(Prec, !PolyTypes, !Chars) :-
+ !.Chars = ['.' | !:Chars],
+ ( !.Chars = ['*' | !:Chars] ->
+ ( !.PolyTypes = [i(Prec0) | !:PolyTypes] ->
% XXX Best done in C
- Prec = to_char_list(int_to_string(Prec0)),
- PolyTypes = PolyTypes1
+ Prec = to_char_list(int_to_string(Prec0))
;
- error("string__format: `*' precision modifier " ++
- "not associated with an integer.")
- }
+ error("string__format: " ++
+ "`*' precision modifier not associated with an integer.")
+ )
+ ;
+ Init = !.Chars,
+ digit(!Chars),
+ zero_or_more_occurences(digit, !Chars),
+ Final = !.Chars
+ ->
+ char_list_remove_suffix(Init, Final, Prec)
;
- =(Init),
- digit,
- zero_or_more_occurences(digit),
- =(Final)
- ->
- { char_list_remove_suffix(Init, Final, Prec) },
- { PolyTypes = PolyTypes0 }
- ;
- % When no number follows the '.' the precision
- % defaults to 0.
- { Prec = ['0'] },
- { PolyTypes = PolyTypes0 }
+ % When no number follows the '.' the precision defaults to 0.
+ Prec = ['0']
).
% NB the capital letter specifiers are proceeded with a 'c'.
@@ -1774,10 +1738,8 @@
; s(string)
% specifier representing "%%"
- ; percent
- .
+ ; percent.
- %
% Do we have a valid conversion specifier?
% We check to ensure that the specifier also matches the type
% from the input list.
@@ -1786,48 +1748,51 @@
list(string__poly_type)::in, list(string__poly_type)::out,
list(char)::in, list(char)::out) is semidet.
- % valid integer conversion specifiers
-spec(d(Int), [i(Int) | Ps], Ps) --> ['d'].
-spec(i(Int), [i(Int) | Ps], Ps) --> ['i'].
-spec(o(Int), [i(Int) | Ps], Ps) --> ['o'].
-spec(u(Int), [i(Int) | Ps], Ps) --> ['u'].
-spec(x(Int), [i(Int) | Ps], Ps) --> ['x'].
-spec(cX(Int), [i(Int) | Ps], Ps) --> ['X'].
-spec(p(Int), [i(Int) | Ps], Ps) --> ['p'].
-
- % valid float conversion specifiers
-spec(e(Float), [f(Float) | Ps], Ps) --> ['e'].
-spec(cE(Float), [f(Float) | Ps], Ps) --> ['E'].
-spec(f(Float), [f(Float) | Ps], Ps) --> ['f'].
-spec(cF(Float), [f(Float) | Ps], Ps) --> ['F'].
-spec(g(Float), [f(Float) | Ps], Ps) --> ['g'].
-spec(cG(Float), [f(Float) | Ps], Ps) --> ['G'].
-
- % valid char conversion specifiers
-spec(c(Char), [c(Char) | Ps], Ps) --> ['c'].
+% Valid integer conversion specifiers.
+spec(d(Int), [i(Int) | Ps], Ps, !Chars) :- !.Chars = ['d' | !:Chars].
+spec(i(Int), [i(Int) | Ps], Ps, !Chars) :- !.Chars = ['i' | !:Chars].
+spec(o(Int), [i(Int) | Ps], Ps, !Chars) :- !.Chars = ['o' | !:Chars].
+spec(u(Int), [i(Int) | Ps], Ps, !Chars) :- !.Chars = ['u' | !:Chars].
+spec(x(Int), [i(Int) | Ps], Ps, !Chars) :- !.Chars = ['x' | !:Chars].
+spec(cX(Int), [i(Int) | Ps], Ps, !Chars) :- !.Chars = ['X' | !:Chars].
+spec(p(Int), [i(Int) | Ps], Ps, !Chars) :- !.Chars = ['p' | !:Chars].
+
+% Valid float conversion specifiers.
+spec(e(Float), [f(Float) | Ps], Ps, !Chars) :- !.Chars = ['e' | !:Chars].
+spec(cE(Float), [f(Float) | Ps], Ps, !Chars) :- !.Chars = ['E' | !:Chars].
+spec(f(Float), [f(Float) | Ps], Ps, !Chars) :- !.Chars = ['f' | !:Chars].
+spec(cF(Float), [f(Float) | Ps], Ps, !Chars) :- !.Chars = ['F' | !:Chars].
+spec(g(Float), [f(Float) | Ps], Ps, !Chars) :- !.Chars = ['g' | !:Chars].
+spec(cG(Float), [f(Float) | Ps], Ps, !Chars) :- !.Chars = ['G' | !:Chars].
+
+% Valid char conversion specifiers.
+spec(c(Char), [c(Char) | Ps], Ps, !Chars) :- !.Chars = ['c' | !:Chars].
- % valid string conversion specifiers
-spec(s(Str), [s(Str) | Ps], Ps) --> ['s'].
+% Valid string conversion specifiers.
+spec(s(Str), [s(Str) | Ps], Ps, !Chars) :- !.Chars = ['s' | !:Chars].
- % conversion specifier representing the "%" sign
-spec(percent, Ps, Ps) --> ['%'].
+% Conversion specifier representing the "%" sign.
+spec(percent, Ps, Ps, !Chars) :- !.Chars = ['%' | !:Chars].
- % A digit in the range [1-9]
+ % A digit in the range [1-9].
+ %
:- pred non_zero_digit(list(char)::in, list(char)::out) is semidet.
-non_zero_digit -->
- [ Char ],
- { char__is_digit(Char) },
- { Char \= '0' }.
+non_zero_digit(!Chars) :-
+ !.Chars = [Char | !:Chars],
+ char__is_digit(Char),
+ Char \= '0'.
- % A digit in the range [0-9]
+ % A digit in the range [0-9].
+ %
:- pred digit(list(char)::in, list(char)::out) is semidet.
-digit -->
- [ Char ],
- { char__is_digit(Char) }.
+digit(!Chars) :-
+ !.Chars = [Char | !:Chars],
+ char__is_digit(Char).
- % Zero or more occurences of the string parsed by the ho pred.
+ % Zero or more occurences of the string parsed by the given pred.
+ %
:- pred zero_or_more_occurences(
pred(list(T), list(T))::in(pred(in, out) is semidet),
list(T)::in, list(T)::out) is det.
@@ -1843,85 +1808,83 @@
specifier_to_string(conv(Flags, Width, Prec, Spec)) = String :-
(
- % valid int conversion specifiers
+ % Valid int conversion specifiers.
Spec = d(Int),
( using_sprintf ->
- FormatStr = make_format(Flags, Width,
- Prec, int_length_modifer, "d"),
+ FormatStr = make_format(Flags, Width, Prec, int_length_modifer,
+ "d"),
String = native_format_int(FormatStr, Int)
;
- String = format_int(Flags, conv(Width), conv(Prec),
- Int)
+ String = format_int(Flags, conv(Width), conv(Prec), Int)
)
;
Spec = i(Int),
( using_sprintf ->
- FormatStr = make_format(Flags, Width,
- Prec, int_length_modifer, "i"),
+ FormatStr = make_format(Flags, Width, Prec, int_length_modifer,
+ "i"),
String = native_format_int(FormatStr, Int)
;
- String = format_int(Flags, conv(Width), conv(Prec),
- Int)
+ String = format_int(Flags, conv(Width), conv(Prec), Int)
)
;
Spec = o(Int),
( using_sprintf ->
- FormatStr = make_format(Flags, Width,
- Prec, int_length_modifer, "o"),
+ FormatStr = make_format(Flags, Width, Prec, int_length_modifer,
+ "o"),
String = native_format_int(FormatStr, Int)
;
- String = format_unsigned_int(Flags, conv(Width),
- conv(Prec), 8, Int, no, "")
+ String = format_unsigned_int(Flags, conv(Width), conv(Prec),
+ 8, Int, no, "")
)
;
Spec = u(Int),
( using_sprintf ->
- FormatStr = make_format(Flags, Width,
- Prec, int_length_modifer, "u"),
+ FormatStr = make_format(Flags, Width, Prec, int_length_modifer,
+ "u"),
String = native_format_int(FormatStr, Int)
;
- String = format_unsigned_int(Flags, conv(Width),
- conv(Prec), 10, Int, no, "")
+ String = format_unsigned_int(Flags, conv(Width), conv(Prec),
+ 10, Int, no, "")
)
;
Spec = x(Int),
( using_sprintf ->
- FormatStr = make_format(Flags, Width,
- Prec, int_length_modifer, "x"),
+ FormatStr = make_format(Flags, Width, Prec, int_length_modifer,
+ "x"),
String = native_format_int(FormatStr, Int)
;
- String = format_unsigned_int(Flags, conv(Width),
- conv(Prec), 16, Int, no, "0x")
+ String = format_unsigned_int(Flags, conv(Width), conv(Prec),
+ 16, Int, no, "0x")
)
;
Spec = cX(Int),
( using_sprintf ->
- FormatStr = make_format(Flags, Width,
- Prec, int_length_modifer, "X"),
+ FormatStr = make_format(Flags, Width, Prec, int_length_modifer,
+ "X"),
String = native_format_int(FormatStr, Int)
;
- String = format_unsigned_int(Flags, conv(Width),
- conv(Prec), 16, Int, no, "0X")
+ String = format_unsigned_int(Flags, conv(Width), conv(Prec),
+ 16, Int, no, "0X")
)
;
Spec = p(Int),
( using_sprintf ->
- FormatStr = make_format(Flags, Width,
- Prec, int_length_modifer, "p"),
+ FormatStr = make_format(Flags, Width, Prec, int_length_modifer,
+ "p"),
String = native_format_int(FormatStr, Int)
;
- String = format_unsigned_int(['#' | Flags],
- conv(Width), conv(Prec), 16, Int, yes, "0x")
+ String = format_unsigned_int(['#' | Flags], conv(Width),
+ conv(Prec), 16, Int, yes, "0x")
)
;
- % valid float conversion specifiers
+ % Valid float conversion specifiers.
Spec = e(Float),
( using_sprintf ->
FormatStr = make_format(Flags, Width, Prec, "", "e"),
String = native_format_float(FormatStr, Float)
;
- String = format_scientific_number(Flags,
- conv(Width), conv(Prec), Float, "e")
+ String = format_scientific_number(Flags, conv(Width), conv(Prec),
+ Float, "e")
)
;
Spec = cE(Float),
@@ -1929,8 +1892,8 @@
FormatStr = make_format(Flags, Width, Prec, "", "E"),
String = native_format_float(FormatStr, Float)
;
- String = format_scientific_number(Flags,
- conv(Width), conv(Prec), Float, "E")
+ String = format_scientific_number(Flags, conv(Width), conv(Prec),
+ Float, "E")
)
;
Spec = f(Float),
@@ -1938,8 +1901,7 @@
FormatStr = make_format(Flags, Width, Prec, "", "f"),
String = native_format_float(FormatStr, Float)
;
- String = format_float(Flags, conv(Width), conv(Prec),
- Float)
+ String = format_float(Flags, conv(Width), conv(Prec), Float)
)
;
Spec = cF(Float),
@@ -1947,8 +1909,7 @@
FormatStr = make_format(Flags, Width, Prec, "", "F"),
String = native_format_float(FormatStr, Float)
;
- String = format_float(Flags, conv(Width), conv(Prec),
- Float)
+ String = format_float(Flags, conv(Width), conv(Prec), Float)
)
;
Spec = g(Float),
@@ -1956,8 +1917,8 @@
FormatStr = make_format(Flags, Width, Prec, "", "g"),
String = native_format_float(FormatStr, Float)
;
- String = format_scientific_number_g(Flags,
- conv(Width), conv(Prec), Float, "e")
+ String = format_scientific_number_g(Flags, conv(Width), conv(Prec),
+ Float, "e")
)
;
Spec = cG(Float),
@@ -1965,11 +1926,11 @@
FormatStr = make_format(Flags, Width, Prec, "", "G"),
String = native_format_float(FormatStr, Float)
;
- String = format_scientific_number_g(Flags,
- conv(Width), conv(Prec), Float, "E")
+ String = format_scientific_number_g(Flags, conv(Width), conv(Prec),
+ Float, "E")
)
;
- % valid char conversion Specifiers
+ % Valid char conversion Specifiers.
Spec = c(Char),
( using_sprintf ->
FormatStr = make_format(Flags, Width, Prec, "", "c"),
@@ -1978,17 +1939,16 @@
String = format_char(Flags, conv(Width), Char)
)
;
- % valid string conversion Specifiers
+ % Valid string conversion Specifiers.
Spec = s(Str),
( using_sprintf ->
FormatStr = make_format(Flags, Width, Prec, "", "s"),
String = native_format_string(FormatStr, Str)
;
- String = format_string(Flags,
- conv(Width), conv(Prec), Str)
+ String = format_string(Flags, conv(Width), conv(Prec), Str)
)
;
- % conversion specifier representing the "%" sign
+ % Conversion specifier representing the "%" sign.
Spec = percent,
String = "%"
).
@@ -2002,26 +1962,27 @@
%-----------------------------------------------------------------------------%
% Construct a format string.
+ %
:- func make_format(list(char), maybe(list(char)),
maybe(list(char)), string, string) = string.
make_format(Flags, MaybeWidth, MaybePrec, LengthMod, Spec) =
( using_sprintf ->
- make_format_sprintf(Flags, MaybeWidth, MaybePrec, LengthMod,
- Spec)
+ make_format_sprintf(Flags, MaybeWidth, MaybePrec, LengthMod, Spec)
;
- make_format_dotnet(Flags, MaybeWidth, MaybePrec, LengthMod,
- Spec)
+ make_format_dotnet(Flags, MaybeWidth, MaybePrec, LengthMod, Spec)
).
% Are we using C's sprintf? All backends other than C return false.
% Note that any backends which return true for using_sprintf/0 must
% also implement:
+ %
% int_length_modifer/0
% native_format_float/2
% native_format_int/2
% native_format_string/2
% native_format_char/2
+ %
:- pred using_sprintf is semidet.
:- pragma foreign_proc("C", using_sprintf,
@@ -2041,6 +2002,7 @@
").
% Construct a format string suitable to passing to sprintf.
+ %
:- func make_format_sprintf(list(char), maybe(list(char)),
maybe(list(char)), string, string) = string.
@@ -2065,6 +2027,7 @@
% functions.
% XXX this code is not yet complete. We need to do a lot more work
% to make this work perfectly.
+ %
:- func make_format_dotnet(list(char), maybe(list(char)),
maybe(list(char)), string, string) = string.
@@ -2097,6 +2060,7 @@
"}"]).
:- func int_length_modifer = string.
+
:- pragma foreign_proc("C",
int_length_modifer = (LengthModifier::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -2104,14 +2068,17 @@
MR_make_aligned_string(LengthModifier, MR_INTEGER_LENGTH_MODIFIER);
}").
-% This predicate is only called if using_sprintf/0, so we produce an error
-% by default.
-int_length_modifer = _ :- error("string.int_length_modifer/0 not defined").
+int_length_modifer = _ :-
+ % This predicate is only called if using_sprintf/0, so we produce an error
+ % by default.
+ error("string.int_length_modifer/0 not defined").
% Create a string from a float using the format string.
% Note it is the responsibility of the caller to ensure that the
% format string is valid.
+ %
:- func native_format_float(string, float) = string.
+
:- pragma foreign_proc("C",
native_format_float(FormatStr::in, Val::in) = (Str::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -2120,15 +2087,17 @@
Str = MR_make_string(MR_PROC_LABEL, FormatStr, (double) Val);
MR_restore_transient_hp();
}").
-% This predicate is only called if using_sprintf/0, so we produce an error
-% by default.
native_format_float(_, _) = _ :-
+ % This predicate is only called if using_sprintf/0, so we produce an error
+ % by default.
error("string.native_format_float/2 not defined").
% Create a string from a int using the format string.
% Note it is the responsibility of the caller to ensure that the
% format string is valid.
+ %
:- func native_format_int(string, int) = string.
+
:- pragma foreign_proc("C",
native_format_int(FormatStr::in, Val::in) = (Str::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -2137,15 +2106,17 @@
Str = MR_make_string(MR_PROC_LABEL, FormatStr, Val);
MR_restore_transient_hp();
}").
-% This predicate is only called if using_sprintf/0, so we produce an error
-% by default.
native_format_int(_, _) = _ :-
+ % This predicate is only called if using_sprintf/0, so we produce an error
+ % by default.
error("string.native_format_int/2 not defined").
% Create a string from a string using the format string.
% Note it is the responsibility of the caller to ensure that the
% format string is valid.
+ %
:- func native_format_string(string, string) = string.
+
:- pragma foreign_proc("C",
native_format_string(FormatStr::in, Val::in) = (Str::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -2154,15 +2125,17 @@
Str = MR_make_string(MR_PROC_LABEL, FormatStr, Val);
MR_restore_transient_hp();
}").
-% This predicate is only called if using_sprintf/0, so we produce an error
-% by default.
native_format_string(_, _) = _ :-
+ % This predicate is only called if using_sprintf/0, so we produce an error
+ % by default.
error("string.native_format_string/2 not defined").
% Create a string from a char using the format string.
% Note it is the responsibility of the caller to ensure that the
% format string is valid.
+ %
:- func native_format_char(string, char) = string.
+
:- pragma foreign_proc("C",
native_format_char(FormatStr::in, Val::in) = (Str::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -2171,9 +2144,9 @@
Str = MR_make_string(MR_PROC_LABEL, FormatStr, Val);
MR_restore_transient_hp();
}").
-% This predicate is only called if using_sprintf/0, so we produce an error
-% by default.
native_format_char(_, _) = _ :-
+ % This predicate is only called if using_sprintf/0, so we produce an error
+ % by default.
error("string.native_format_char/2 not defined").
%-----------------------------------------------------------------------------%
@@ -2182,22 +2155,24 @@
:- type maybe_width == maybe(int).
:- type maybe_precision == maybe(int).
- %
% Format a character (c).
%
:- func format_char(flags, maybe_width, char) = string.
+
format_char(Flags, Width, Char) = String :-
CharStr = string__char_to_string(Char),
String = justify_string(Flags, Width, CharStr).
- %
% Format a string (s).
%
:- func format_string(flags, maybe_width, maybe_precision, string) = string.
+
format_string(Flags, Width, Prec, OldStr) = NewStr :-
- ( Prec = yes(NumChars) ->
+ (
+ Prec = yes(NumChars),
PrecStr = string__substring(OldStr, 0, NumChars)
;
+ Prec = no,
PrecStr = OldStr
),
NewStr = justify_string(Flags, Width, PrecStr).
@@ -2205,11 +2180,12 @@
:- func format_int(flags, maybe_width, maybe_precision, int) = string.
format_int(Flags, Width, Prec, Int) = String :-
- %
- % Find the integer's absolute value, and take care of the special
- % case of precision zero with an integer of 0.
- %
- ( Int = 0, Prec = yes(0) ->
+ % Find the integer's absolute value, and take care of the special case
+ % of precision zero with an integer of 0.
+ (
+ Int = 0,
+ Prec = yes(0)
+ ->
AbsIntStr = ""
;
Integer = integer(Int),
@@ -2218,18 +2194,17 @@
),
AbsIntStrLength = string__length(AbsIntStr),
- %
% Do we need to increase precision?
- %
- ( Prec = yes(Precision), Precision > AbsIntStrLength ->
+ (
+ Prec = yes(Precision),
+ Precision > AbsIntStrLength
+ ->
PrecStr = string__pad_left(AbsIntStr, '0', Precision)
;
PrecStr = AbsIntStr
),
- %
- % Do we need to pad to the field width.
- %
+ % Do we need to pad to the field width?
(
Width = yes(FieldWidth),
FieldWidth > string__length(PrecStr),
@@ -2244,10 +2219,8 @@
ZeroPadded = no
),
- %
% Prefix with appropriate sign or zero padding.
% The previous step has deliberately left room for this.
- %
( Int < 0 ->
SignedStr = "-" ++ FieldStr
; member('+', Flags) ->
@@ -2262,7 +2235,6 @@
String = justify_string(Flags, Width, SignedStr).
- %
% Format an unsigned int, unsigned octal, or unsigned hexadecimal
% (u,o,x,X).
%
@@ -2270,10 +2242,8 @@
int, int, bool, string) = string.
format_unsigned_int(Flags, Width, Prec, Base, Int, IsTypeP, Prefix) = String :-
- %
- % Find the integer's absolute value, and take care of the
- % special case of precision zero with an integer of 0.
- %
+ % Find the integer's absolute value, and take care of the special case
+ % of precision zero with an integer of 0.
(
Int = 0,
Prec = yes(0)
@@ -2292,9 +2262,7 @@
AbsIntStr0 = to_capital_hex(UnsignedInteger)
),
- %
% Just in case Int = 0 (base converters return "").
- %
( AbsIntStr0 = "" ->
AbsIntStr = "0"
;
@@ -2303,18 +2271,17 @@
),
AbsIntStrLength = string__length(AbsIntStr),
- %
% Do we need to increase precision?
- %
- ( Prec = yes(Precision), Precision > AbsIntStrLength ->
+ (
+ Prec = yes(Precision),
+ Precision > AbsIntStrLength
+ ->
PrecStr = string__pad_left(AbsIntStr, '0', Precision)
;
PrecStr = AbsIntStr
),
- %
% Do we need to increase the precision of an octal?
- %
(
Base = 8,
member('#', Flags),
@@ -2325,9 +2292,7 @@
PrecModStr = PrecStr
),
- %
- % Do we need to pad to the field width.
- %
+ % Do we need to pad to the field width?
(
Width = yes(FieldWidth),
FieldWidth > string__length(PrecModStr),
@@ -2335,27 +2300,23 @@
\+ member('-', Flags),
Prec = no
->
- %
% Do we need to make room for "0x" or "0X" ?
- %
(
Base = 16,
member('#', Flags),
- ( Int \= 0 ; IsTypeP = yes )
+ ( Int \= 0
+ ; IsTypeP = yes
+ )
->
- FieldStr = string__pad_left(PrecModStr, '0',
- FieldWidth - 2)
+ FieldStr = string__pad_left(PrecModStr, '0', FieldWidth - 2)
;
- FieldStr = string__pad_left(PrecModStr, '0',
- FieldWidth)
+ FieldStr = string__pad_left(PrecModStr, '0', FieldWidth)
)
;
FieldStr = PrecModStr
),
- %
% Do we have to prefix "0x" or "0X"?
- %
(
Base = 16,
member('#', Flags),
@@ -2370,46 +2331,40 @@
String = justify_string(Flags, Width, FieldModStr).
- %
% Format a float (f)
%
:- func format_float(flags, maybe_width, maybe_precision, float) = string.
format_float(Flags, Width, Prec, Float) = NewFloat :-
-
- %
% Determine absolute value of string.
- %
Abs = abs(Float),
- %
- % Change precision (default is 6)
- %
+ % Change precision (default is 6).
AbsStr = convert_float_to_string(Abs),
( is_nan_or_inf(Abs) ->
PrecModStr = AbsStr
;
- ( Prec = yes(Precision) ->
+ (
+ Prec = yes(Precision),
PrecStr = change_precision(Precision, AbsStr)
;
+ Prec = no,
PrecStr = change_precision(6, AbsStr)
),
- %
% Do we need to remove the decimal point?
- %
- ( \+ member('#', Flags), Prec = yes(0) ->
+ (
+ \+ member('#', Flags),
+ Prec = yes(0)
+ ->
PrecStrLen = string__length(PrecStr),
- PrecModStr = string__substring(PrecStr, 0,
- PrecStrLen - 1)
+ PrecModStr = string__substring(PrecStr, 0, PrecStrLen - 1)
;
PrecModStr = PrecStr
)
),
- %
% Do we need to change field width?
- %
(
Width = yes(FieldWidth),
FieldWidth > string__length(PrecModStr),
@@ -2423,9 +2378,7 @@
ZeroPadded = no
),
- %
% Finishing up ..
- %
( Float < 0.0 ->
SignedStr = "-" ++ FieldStr
; member('+', Flags) ->
@@ -2440,7 +2393,6 @@
NewFloat = justify_string(Flags, Width, SignedStr).
- %
% Format a scientific number to a specified number of significant
% figures (g,G)
%
@@ -2448,27 +2400,23 @@
float, string) = string.
format_scientific_number_g(Flags, Width, Prec, Float, E) = NewFloat :-
- %
% Determine absolute value of string.
- %
Abs = abs(Float),
- %
- % Change precision (default is 6)
- %
+ % Change precision (default is 6).
AbsStr = convert_float_to_string(Abs),
( is_nan_or_inf(Abs) ->
PrecStr = AbsStr
;
- ( Prec = yes(Precision) ->
- (Precision = 0 ->
- PrecStr = change_to_g_notation(AbsStr,
- 1, E, Flags)
+ (
+ Prec = yes(Precision),
+ ( Precision = 0 ->
+ PrecStr = change_to_g_notation(AbsStr, 1, E, Flags)
;
- PrecStr = change_to_g_notation(AbsStr,
- Precision, E, Flags)
+ PrecStr = change_to_g_notation(AbsStr, Precision, E, Flags)
)
;
+ Prec = no,
PrecStr = change_to_g_notation(AbsStr, 6, E, Flags)
)
),
@@ -2489,9 +2437,7 @@
ZeroPadded = no
),
- %
% Finishing up ..
- %
( Float < 0.0 ->
SignedStr = "-" ++ FieldStr
; member('+', Flags) ->
@@ -2506,35 +2452,33 @@
NewFloat = justify_string(Flags, Width, SignedStr).
- %
% Format a scientific number (e,E)
%
:- func format_scientific_number(flags, maybe_width, maybe_precision,
float, string) = string.
format_scientific_number(Flags, Width, Prec, Float, E) = NewFloat :-
- %
% Determine absolute value of string.
- %
Abs = abs(Float),
- %
- % Change precision (default is 6)
- %
+ % Change precision (default is 6).
AbsStr = convert_float_to_string(Abs),
( is_nan_or_inf(Abs) ->
PrecModStr = AbsStr
;
- ( Prec = yes(Precision) ->
+ (
+ Prec = yes(Precision),
PrecStr = change_to_e_notation(AbsStr, Precision, E)
;
+ Prec = no,
PrecStr = change_to_e_notation(AbsStr, 6, E)
),
- %
% Do we need to remove the decimal point?
- %
- ( \+ member('#', Flags), Prec = yes(0) ->
+ (
+ \+ member('#', Flags),
+ Prec = yes(0)
+ ->
split_at_decimal_point(PrecStr, BaseStr, ExponentStr),
PrecModStr = BaseStr ++ ExponentStr
;
@@ -2542,9 +2486,7 @@
)
),
- %
% Do we need to change field width?
- %
(
Width = yes(FieldWidth),
FieldWidth > string__length(PrecModStr),
@@ -2558,9 +2500,7 @@
ZeroPadded = no
),
- %
% Finishing up ..
- %
( Float < 0.0 ->
SignedStr = "-" ++ FieldStr
; member('+', Flags) ->
@@ -2578,7 +2518,10 @@
:- func justify_string(flags, maybe_width, string) = string.
justify_string(Flags, Width, Str) =
- ( Width = yes(FWidth), FWidth > string__length(Str) ->
+ (
+ Width = yes(FWidth),
+ FWidth > string__length(Str)
+ ->
( member('-', Flags) ->
string__pad_right(Str, ' ', FWidth)
;
@@ -2588,7 +2531,6 @@
Str
).
- %
% Convert an integer to an octal string.
%
:- func to_octal(integer) = string.
@@ -2603,7 +2545,6 @@
NumStr = ""
).
- %
% Convert an integer to a hexadecimal string using a-f.
%
:- func to_hex(integer) = string.
@@ -2618,7 +2559,6 @@
NumStr = ""
).
- %
% Convert an integer to a hexadecimal string using A-F.
%
:- func to_capital_hex(integer) = string.
@@ -2633,9 +2573,7 @@
NumStr = ""
).
- %
- % Given a decimal integer, return the hexadecimal equivalent
- % (using % a-f).
+ % Given a decimal integer, return the hexadecimal equivalent (using % a-f).
%
:- func get_hex_int(integer) = string.
@@ -2656,7 +2594,6 @@
HexStr = "f"
).
- %
% Convert an integer to a hexadecimal string using A-F.
%
:- func get_capital_hex_int(integer) = string.
@@ -2678,22 +2615,18 @@
HexStr = "F"
).
- %
% Unlike the standard library function, this function converts a float
% to a string without resorting to scientific notation.
%
- % This predicate relies on the fact that string__float_to_string
- % returns a float which is round-trippable, ie to the full precision
- % needed.
+ % This predicate relies on the fact that string__float_to_string returns
+ % a float which is round-trippable, ie to the full precision needed.
%
:- func convert_float_to_string(float) = string.
convert_float_to_string(Float) = String :-
string__lowlevel_float_to_string(Float, FloatStr),
- %
- % check for scientific representation.
- %
+ % Check for scientific representation.
(
( string__contains_char(FloatStr, 'e')
; string__contains_char(FloatStr, 'E')
@@ -2702,20 +2635,14 @@
split_at_exponent(FloatStr, FloatPtStr, ExpStr),
split_at_decimal_point(FloatPtStr, MantissaStr, FractionStr),
- %
- % what is the exponent?
- %
+ % What is the exponent?
ExpInt = string__det_to_int(ExpStr),
( ExpInt >= 0 ->
-
- %
- % move decimal pt to the right.
- %
+ % Move decimal pt to the right.
ExtraDigits = ExpInt,
- PaddedFracStr = string__pad_right(FractionStr,
- '0', ExtraDigits),
- string__split(PaddedFracStr, ExtraDigits,
- MantissaRest, NewFraction),
+ PaddedFracStr = string__pad_right(FractionStr, '0', ExtraDigits),
+ string__split(PaddedFracStr, ExtraDigits, MantissaRest,
+ NewFraction),
NewMantissa = MantissaStr ++ MantissaRest,
MantAndPoint = NewMantissa ++ ".",
@@ -2725,12 +2652,10 @@
String = MantAndPoint ++ NewFraction
)
;
- %
- % move decimal pt to the left.
- %
+ % Move decimal pt to the left.
ExtraDigits = abs(ExpInt),
- PaddedMantissaStr = string__pad_left(MantissaStr,
- '0', ExtraDigits),
+ PaddedMantissaStr = string__pad_left(MantissaStr, '0',
+ ExtraDigits),
string__split(PaddedMantissaStr,
length(PaddedMantissaStr) - ExtraDigits,
NewMantissa, FractionRest),
@@ -2746,14 +2671,13 @@
String = FloatStr
).
- %
% Converts a floating point number to a specified number of standard
- % figures. The style used depends on the value converted; style e (or
- % E) is used only if the exponent resulting from such a conversion is
- % less than -4 or greater than or equal to the precision. Trailing
- % zeros are removed from the fractional portion of the result unless
- % the # flag is specified: a decimal-point character appears only if it
- % is followed by a digit.
+ % figures. The style used depends on the value converted; style e (or E)
+ % is used only if the exponent resulting from such a conversion is less
+ % than -4 or greater than or equal to the precision. Trailing zeros are
+ % removed from the fractional portion of the result unless the # flag
+ % is specified: a decimal-point character appears only if it is followed
+ % by a digit.
%
:- func change_to_g_notation(string, int, string, flags) = string.
@@ -2765,41 +2689,30 @@
->
% Float will be represented normally.
% -----------------------------------
- % Need to calculate precision to pass to the
- % change_precision function, because the current
- % precision represents significant figures, not decimal
- % places.
+ % Need to calculate precision to pass to the change_precision function,
+ % because the current precision represents significant figures,
+ % not decimal places.
%
- % now change float's precision.
+ % Now change float's precision.
%
( Exponent =< 0 ->
- %
- % deal with floats such as 0.00000000xyz
- %
+ % Deal with floats such as 0.00000000xyz.
DecimalPos = decimal_pos(Float),
- FormattedFloat0 = change_precision(
- abs(DecimalPos) - 1 + Prec, Float)
+ FormattedFloat0 = change_precision(abs(DecimalPos) - 1 + Prec,
+ Float)
;
- %
- % deal with floats such as ddddddd.mmmmmmmm
- %
- ScientificFloat = change_to_e_notation(Float,
- Prec - 1, "e"),
- split_at_exponent(ScientificFloat,
- BaseStr, ExponentStr),
+ % Deal with floats such as ddddddd.mmmmmmmm.
+ ScientificFloat = change_to_e_notation(Float, Prec - 1, "e"),
+ split_at_exponent(ScientificFloat, BaseStr, ExponentStr),
Exp = string__det_to_int(ExponentStr),
- split_at_decimal_point(BaseStr,
- MantissaStr, FractionStr),
+ split_at_decimal_point(BaseStr, MantissaStr, FractionStr),
RestMantissaStr = substring(FractionStr, 0, Exp),
- NewFraction = substring(FractionStr,
- Exp, Prec - Exp - 1),
- FormattedFloat0 = MantissaStr ++
- RestMantissaStr ++ "." ++ NewFraction
+ NewFraction = substring(FractionStr, Exp, Prec - Exp - 1),
+ FormattedFloat0 = MantissaStr ++ RestMantissaStr
+ ++ "." ++ NewFraction
),
- %
% Do we remove trailing zeros?
- %
( member('#', Flags) ->
FormattedFloat = FormattedFloat0
;
@@ -2808,24 +2721,19 @@
;
% Float will be represented in scientific notation.
% -------------------------------------------------
- %
UncheckedFloat = change_to_e_notation(Float, Prec - 1, E),
- %
% Do we need to remove trailing zeros?
- %
( member('#', Flags) ->
FormattedFloat = UncheckedFloat
;
- split_at_exponent(UncheckedFloat, BaseStr,
- ExponentStr),
+ split_at_exponent(UncheckedFloat, BaseStr, ExponentStr),
NewBaseStr = remove_trailing_zeros(BaseStr),
FormattedFloat = NewBaseStr ++ E ++ ExponentStr
)
).
- %
- % convert floating point notation to scientific notation.
+ % Convert floating point notation to scientific notation.
%
:- func change_to_e_notation(string, int, string) = string.
@@ -2833,23 +2741,19 @@
UnsafeExponent = decimal_pos(Float),
UnsafeBase = calculate_base_unsafe(Float, Prec),
- %
% Is mantissa greater than one digit long?
- %
split_at_decimal_point(UnsafeBase, MantissaStr, _FractionStr),
( string__length(MantissaStr) > 1 ->
- % need to append 0, to fix the problem of having no numbers
+ % Need to append 0, to fix the problem of having no numbers
% after the decimal point.
- SafeBase = calculate_base_unsafe(
- string__append(UnsafeBase, "0"), Prec),
+ SafeBase = calculate_base_unsafe(string__append(UnsafeBase, "0"),
+ Prec),
SafeExponent = UnsafeExponent + 1
;
SafeBase = UnsafeBase,
SafeExponent = UnsafeExponent
),
- %
% Creating exponent.
- %
( SafeExponent >= 0 ->
( SafeExponent < 10 ->
ExponentStr = string__append_list(
@@ -2861,15 +2765,13 @@
;
( SafeExponent > -10 ->
ExponentStr = string__append_list(
- [E, "-0", string__int_to_string(
- int__abs(SafeExponent))])
+ [E, "-0", string__int_to_string(int__abs(SafeExponent))])
;
ExponentStr = E ++ string__int_to_string(SafeExponent)
)
),
ScientificFloat = SafeBase ++ ExponentStr.
- %
% Given a floating point number, this function calculates the size of
% the exponent needed to represent the float in scientific notation.
%
@@ -2879,19 +2781,16 @@
UnsafeExponent = decimal_pos(Float),
UnsafeBase = calculate_base_unsafe(Float, Prec),
- %
% Is mantissa one digit long?
- %
split_at_decimal_point(UnsafeBase, MantissaStr, _FractionStr),
( string__length(MantissaStr) > 1 ->
- % we will need need to move decimal pt one place to the
- % left: therefore, increment exponent.
+ % We will need need to move decimal pt one place to the left:
+ % therefore, increment exponent.
Exponent = UnsafeExponent + 1
;
Exponent = UnsafeExponent
).
- %
% Given a string representing a floating point number, function returns
% a string with all trailing zeros removed.
%
@@ -2904,7 +2803,6 @@
TrimmedFloatCharList = list__reverse(TrimmedFloatRevCharList),
TrimmedFloat = string__from_char_list(TrimmedFloatCharList).
- %
% Given a char list, this function removes all leading zeros, including
% decimal point, if need be.
%
@@ -2919,7 +2817,6 @@
TrimmedNum = CharNum
).
- %
% Determine the location of the decimal point in the string that
% represents a floating point number.
%
@@ -2930,33 +2827,33 @@
NumZeros = string__length(MantissaStr) - 1,
Pos = find_non_zero_pos(string__to_char_list(Float), NumZeros).
- %
- % Given a list of chars representing a floating point number, function
- % determines the the first position containing a non-zero digit.
+ % Given a list of chars representing a floating point number, this
+ % function determines the the first position containing a non-zero digit.
% Positions after the decimal point are negative, and those before the
% decimal point are positive.
%
:- func find_non_zero_pos(list(char), int) = int.
-find_non_zero_pos(Xs, CurrentPos) = ActualPos :-
- ( Xs = [Y | Ys] ->
- ( is_decimal_point(Y) ->
- ActualPos = find_non_zero_pos(Ys, CurrentPos)
- ; Y = '0' ->
- ActualPos = find_non_zero_pos(Ys, CurrentPos - 1)
+find_non_zero_pos(L, CurrentPos) = ActualPos :-
+ (
+ L = [H | T],
+ ( is_decimal_point(H) ->
+ ActualPos = find_non_zero_pos(T, CurrentPos)
+ ; H = '0' ->
+ ActualPos = find_non_zero_pos(T, CurrentPos - 1)
;
ActualPos = CurrentPos
)
;
+ L = [],
ActualPos = 0
).
- %
% Representing a floating point number in scientific notation requires
- % a base and an exponent. This function returns the base. But it is
- % unsafe, since particular input result in the base having a mantissa
- % with more than one digit. Therefore, the calling function must check
- % for this problem.
+ % a base and an exponent. This function returns the base. But it is unsafe,
+ % since particular input result in the base having a mantissa with more
+ % than one digit. Therefore, the calling function must check for this
+ % problem.
%
:- func calculate_base_unsafe(string, int) = string.
@@ -2965,25 +2862,19 @@
split_at_decimal_point(Float, MantissaStr, FractionStr),
( Place < 0 ->
DecimalPos = abs(Place),
- PaddedMantissaStr = string__substring(FractionStr, 0,
- DecimalPos),
+ PaddedMantissaStr = string__substring(FractionStr, 0, DecimalPos),
- %
- % get rid of superfluous zeros.
- %
+ % Get rid of superfluous zeros.
MantissaInt = string__det_to_int(PaddedMantissaStr),
ExpMantissaStr = string__int_to_string(MantissaInt),
- %
- % create fractional part
- %
+ % Create fractional part.
PaddedFractionStr = pad_right(FractionStr, '0', Prec + 1),
- ExpFractionStr = string__substring(PaddedFractionStr,
- DecimalPos, Prec + 1)
+ ExpFractionStr = string__substring(PaddedFractionStr, DecimalPos,
+ Prec + 1)
; Place > 0 ->
ExpMantissaStr = string__substring(MantissaStr, 0, 1),
- FirstHalfOfFractionStr = string__substring(MantissaStr,
- 1, Place),
+ FirstHalfOfFractionStr = string__substring(MantissaStr, 1, Place),
ExpFractionStr = FirstHalfOfFractionStr ++ FractionStr
;
ExpMantissaStr = MantissaStr,
@@ -2993,9 +2884,7 @@
UnroundedExpStr = MantissaAndPoint ++ ExpFractionStr,
Exp = change_precision(Prec, UnroundedExpStr).
- %
- % Change the precision of a float to a specified number of decimal
- % places.
+ % Change the precision of a float to a specified number of decimal places.
%
% n.b. OldFloat must be positive for this function to work.
%
@@ -3015,23 +2904,16 @@
(char__to_int(NextDigit) - char__to_int('0')) >= 5
->
NewPrecFrac = string__det_to_int(UnroundedFrac) + 1,
- NewPrecFracStrNotOK = string__int_to_string(
- NewPrecFrac),
- NewPrecFracStr = string__pad_left(NewPrecFracStrNotOK,
- '0', Prec),
- (
- string__length(NewPrecFracStr) >
- string__length(UnroundedFrac)
- ->
- PrecFracStr = substring(NewPrecFracStr,
- 1, Prec),
+ NewPrecFracStrNotOK = string__int_to_string( NewPrecFrac),
+ NewPrecFracStr = string__pad_left(NewPrecFracStrNotOK, '0', Prec),
+ ( string__length(NewPrecFracStr) > string__length(UnroundedFrac) ->
+ PrecFracStr = substring(NewPrecFracStr, 1, Prec),
PrecMantissaInt = det_to_int(MantissaStr) + 1,
PrecMantissaStr = int_to_string(PrecMantissaInt)
;
PrecFracStr = NewPrecFracStr,
PrecMantissaStr = MantissaStr
)
-
;
UnroundedFrac = "",
(char__to_int(NextDigit) - char__to_int('0')) >= 5
@@ -3101,15 +2983,15 @@
"{
/*
** For efficiency reasons we duplicate the C implementation
- ** of string__lowlevel_float_to_string
+ ** of string__lowlevel_float_to_string.
*/
MR_float_to_string(Flt, Str);
}").
+string__float_to_string(Float, unsafe_promise_unique(String)) :-
% XXX The unsafe_promise_unique is needed because in
% string__float_to_string_2 the call to string__to_float doesn't
% have a (ui, out) mode hence the output string cannot be unique.
-string__float_to_string(Float, unsafe_promise_unique(String)) :-
String = string__float_to_string_2(min_precision, Float).
:- func string__float_to_string_2(int, float) = (string) is det.
@@ -3127,9 +3009,8 @@
).
% XXX For efficiency reasons we assume that on non-C backends that
- % we are using double precision floats, however the commented out
- % code provides a general mechanism for calculating the required
- % precision.
+ % we are using double precision floats, however the commented out code
+ % provides a general mechanism for calculating the required precision.
:- func min_precision = int.
min_precision = 15.
@@ -3140,12 +3021,10 @@
:- func max_precision = int.
max_precision = min_precision + 2.
-%
-% string__lowlevel_float_to_string differs from string__float_to_string in
-% that it must be implemented without calling string__format (e.g. by
-% invoking some foreign language routine to do the conversion) as this is
-% the predicate string__format uses to get the initial string
-% representation of a float.
+% string__lowlevel_float_to_string differs from string__float_to_string in that
+% it must be implemented without calling string__format (e.g. by invoking some
+% foreign language routine to do the conversion) as this is the predicate
+% string__format uses to get the initial string representation of a float.
%
% The string returned must match one of the following regular expression:
% ^[+-]?[0-9]*\.?[0-9]+((e|E)[0-9]+)?$
@@ -3172,11 +3051,11 @@
string__lowlevel_float_to_string(FloatVal::in, FloatString::uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
- // The R format string prints the double out such that it
- // can be round-tripped.
- // XXX According to the documentation it tries the 15 digits of
- // precision, then 17 digits skipping 16 digits of precision.
- // unlike what we do for the C backend.
+ // The R format string prints the double out such that it can be
+ // round-tripped.
+ // XXX According to the documentation it tries the 15 digits of precision,
+ // then 17 digits skipping 16 digits of precision, unlike what we do
+ // for the C backend.
FloatString = FloatVal.ToString(""R"");
").
@@ -3188,20 +3067,21 @@
").
string__det_to_float(FloatString) =
- ( if string__to_float(FloatString, FloatVal)
- then FloatVal
- else func_error("string.det_to_float/1 - conversion failed.")
+ ( string__to_float(FloatString, FloatVal) ->
+ FloatVal
+ ;
+ func_error("string.det_to_float/1 - conversion failed.")
).
:- pragma export(string__to_float(in, out), "ML_string_to_float").
+
:- pragma foreign_proc("C",
string__to_float(FloatString::in, FloatVal::out),
[will_not_call_mercury, promise_pure, thread_safe],
"{
/*
- ** The %c checks for any erroneous characters appearing after
- ** the float; if there are then sscanf() will return 2 rather
- ** than 1.
+ ** The %c checks for any erroneous characters appearing after the float;
+ ** if there are then sscanf() will return 2 rather than 1.
*/
char tmpc;
SUCCESS_INDICATOR =
@@ -3248,34 +3128,27 @@
FloatVal = java.lang.Double.parseDouble(FloatString);
succeeded = true;
} catch(java.lang.NumberFormatException e) {
-
- // At this point it *should* in theory be safe just to
- // set succeeded = false, since the Java API claims
- // that Double.parseDouble() will handle all the cases
- // we require. However, it turns out that in practice
- // (tested with Sun's Java 2 SDK, Standard Edition,
- // version 1.3.1_04)
- // Java actually throws a NumberFormatException when
- // you give it NaN or infinity, so we handle these
- // cases below.
+ // At this point it *should* in theory be safe just to set
+ // succeeded = false, since the Java API claims that
+ // Double.parseDouble() will handle all the cases we require.
+ // However, it turns out that in practice (tested with Sun's
+ // Java 2 SDK, Standard Edition, version 1.3.1_04) Java actually
+ // throws a NumberFormatException when you give it NaN or infinity,
+ // so we handle these cases below.
if (FloatString.equalsIgnoreCase(""nan"")) {
FloatVal = java.lang.Double.NaN;
succeeded = true;
- } else if (FloatString.equalsIgnoreCase(""infinity""))
- {
+ } else if (FloatString.equalsIgnoreCase(""infinity"")) {
FloatVal = java.lang.Double.POSITIVE_INFINITY;
succeeded = true;
- } else if (FloatString.substring(1).
- equalsIgnoreCase(""infinity""))
+ } else if (FloatString.substring(1).equalsIgnoreCase(""infinity""))
{
if (FloatString.charAt(0) == '+') {
- FloatVal = java.lang.Double.
- POSITIVE_INFINITY;
+ FloatVal = java.lang.Double.POSITIVE_INFINITY;
succeeded = true;
} else if (FloatString.charAt(0) == '-') {
- FloatVal = java.lang.Double.
- NEGATIVE_INFINITY;
+ FloatVal = java.lang.Double.NEGATIVE_INFINITY;
succeeded = true;
} else {
succeeded = false;
@@ -3307,8 +3180,8 @@
string__contains_char(String, Char) :-
string__contains_char(String, Char, 0, string__length(String)).
-:- pred string__contains_char(string::in, char::in,
- int::in, int::in) is semidet.
+:- pred string__contains_char(string::in, char::in, int::in, int::in)
+ is semidet.
string__contains_char(Str, Char, Index, Length) :-
( Index < Length ->
@@ -3339,19 +3212,17 @@
:- pred string__index_check(int::in, int::in) is semidet.
-/* We should consider making this routine a compiler built-in. */
+% We should consider making this routine a compiler built-in.
:- pragma foreign_proc("C",
string__index_check(Index::in, Length::in),
[will_not_call_mercury, promise_pure, thread_safe],
"
/*
- ** We do not test for negative values of Index
- ** because (a) MR_Unsigned is unsigned and hence a
- ** negative argument will appear as a very large
- ** positive one after the cast and (b) anybody
- ** dealing with the case where strlen(Str) > MAXINT
- ** is clearly barking mad (and one may well
- ** get an integer overflow error in this case).
+ ** We do not test for negative values of Index because (a) MR_Unsigned
+ ** is unsigned and hence a negative argument will appear as a very large
+ ** positive one after the cast and (b) anybody dealing with the case
+ ** where strlen(Str) > MAXINT is clearly barking mad (and one may well get
+ ** an integer overflow error in this case).
*/
SUCCESS_INDICATOR = ((MR_Unsigned) Index < (MR_Unsigned) Length);
").
@@ -3404,9 +3275,8 @@
"
#ifdef MR_USE_GCC_GLOBAL_REGISTERS
/*
- ** GNU C version egcs-1.1.2 crashes with `fixed or forbidden
- ** register spilled' in grade asm_fast.gc.tr.debug
- ** if we write this inline.
+ ** GNU C version egcs-1.1.2 crashes with `fixed or forbidden register
+ ** spilled' in grade asm_fast.gc.tr.debug if we write this inline.
*/
extern void MR_set_char(MR_String str, MR_Integer ind, MR_Char ch);
#else
@@ -3419,9 +3289,8 @@
"
#ifdef MR_USE_GCC_GLOBAL_REGISTERS
/*
- ** GNU C version egcs-1.1.2 crashes with `fixed or forbidden
- ** register spilled' in grade asm_fast.gc.tr.debug
- ** if we write this inline.
+ ** GNU C version egcs-1.1.2 crashes with `fixed or forbidden register
+ ** spilled' in grade asm_fast.gc.tr.debug if we write this inline.
*/
void MR_set_char(MR_String str, MR_Integer ind, MR_Char ch)
{
@@ -3553,7 +3422,8 @@
").
:- pragma foreign_proc("Java",
string__length(Str::in, Length::uo),
- [will_not_call_mercury, promise_pure, thread_safe], "
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
Length = Str.length();
").
@@ -3642,8 +3512,7 @@
len_3 = strlen(S3);
len_2 = len_3 - len_1;
/*
- ** We need to make a copy to ensure that the pointer is
- ** word-aligned.
+ ** We need to make a copy to ensure that the pointer is word-aligned.
*/
MR_allocate_aligned_string_msg(S2, len_2, MR_PROC_LABEL);
strcpy(S2, S3 + len_1);
@@ -3704,11 +3573,9 @@
string__append_ooi_3(NextS1Len, S3Len, S1, S2, S3)
;
(
- string__append_ooi_3(NextS1Len, S3Len,
- S1, S2, S3)
+ string__append_ooi_3(NextS1Len, S3Len, S1, S2, S3)
;
- string__append_ooi_2(NextS1Len + 1, S3Len,
- S1, S2, S3)
+ string__append_ooi_2(NextS1Len + 1, S3Len, S1, S2, S3)
)
).
@@ -3823,16 +3690,18 @@
Right = Str;
} else {
len = strlen(Str);
- if (Count > len) Count = len;
+
+ if (Count > len) {
+ Count = len;
+ }
+
MR_allocate_aligned_string_msg(Left, Count, MR_PROC_LABEL);
MR_memcpy(Left, Str, Count);
Left[Count] = '\\0';
/*
- ** We need to make a copy to ensure that the pointer is
- ** word-aligned.
+ ** We need to make a copy to ensure that the pointer is word-aligned.
*/
- MR_allocate_aligned_string_msg(Right, len - Count,
- MR_PROC_LABEL);
+ MR_allocate_aligned_string_msg(Right, len - Count, MR_PROC_LABEL);
strcpy(Right, Str + Count);
}
}").
@@ -3842,6 +3711,7 @@
[will_not_call_mercury, promise_pure, thread_safe],
"{
int len;
+
if (Count <= 0) {
Left = """";
Right = Str;
@@ -3920,8 +3790,7 @@
"
int len = Str.Length;
if (len > 0) {
- SUCCESS_INDICATOR =
- (System.String.Compare(Str, 1, Rest, 0, len) == 0);
+ SUCCESS_INDICATOR = (System.String.Compare(Str, 1, Rest, 0, len) == 0);
First = Str[0];
} else {
SUCCESS_INDICATOR = false;
@@ -3931,10 +3800,7 @@
string__first_char(Str::in, First::uo, Rest::in),
[will_not_call_mercury, promise_pure, thread_safe],
"
-
- if (Str.length() == Rest.length() + 1
- && Str.endsWith(Rest))
- {
+ if (Str.length() == Rest.length() + 1 && Str.endsWith(Rest)) {
succeeded = true;
First = Str.charAt(0);
} else {
@@ -3953,11 +3819,9 @@
} else {
Str++;
/*
- ** We need to make a copy to ensure that the pointer is
- ** word-aligned.
+ ** We need to make a copy to ensure that the pointer is word-aligned.
*/
- MR_allocate_aligned_string_msg(Rest, strlen(Str),
- MR_PROC_LABEL);
+ MR_allocate_aligned_string_msg(Rest, strlen(Str), MR_PROC_LABEL);
strcpy(Rest, Str);
SUCCESS_INDICATOR = MR_TRUE;
}
@@ -3967,6 +3831,7 @@
[will_not_call_mercury, promise_pure, thread_safe],
"{
int len = Str.Length;
+
if (len > 0) {
SUCCESS_INDICATOR = (First == Str[0]);
Rest = Str.Substring(1);
@@ -3979,6 +3844,7 @@
[will_not_call_mercury, promise_pure, thread_safe],
"{
int len = Str.length();
+
if (len > 0) {
succeeded = (First == Str.charAt(0));
Rest = Str.substring(1);
@@ -3999,11 +3865,9 @@
} else {
Str++;
/*
- ** We need to make a copy to ensure that the pointer is
- ** word-aligned.
+ ** We need to make a copy to ensure that the pointer is word-aligned.
*/
- MR_allocate_aligned_string_msg(Rest, strlen(Str),
- MR_PROC_LABEL);
+ MR_allocate_aligned_string_msg(Rest, strlen(Str), MR_PROC_LABEL);
strcpy(Rest, Str);
SUCCESS_INDICATOR = MR_TRUE;
}
@@ -4184,11 +4048,11 @@
%------------------------------------------------------------------------------%
% preceding_boundary(SepP, String, I) returns the largest index J =< I
- % in String of the char that is SepP and min(-1, I) if there is no
- % such J. preceding_boundary/3 is intended for finding (in reverse)
- % consecutive maximal sequences of chars satisfying some property.
- % Note that I *must not* exceed the largest valid index for String.
-
+ % in String of the char that is SepP and min(-1, I) if there is no such J.
+ % preceding_boundary/3 is intended for finding (in reverse) consecutive
+ % maximal sequences of chars satisfying some property. Note that I
+ % *must not* exceed the largest valid index for String.
+ %
:- func preceding_boundary(pred(char)::in(pred(in) is semidet), string::in,
int::in) = (int::out) is det.
@@ -4290,20 +4154,18 @@
%------------------------------------------------------------------------------%
- % For efficiency, these predicates collect a list of strings
- % which, when concatenated in reverse order, produce the final
- % output.
+ % For efficiency, these predicates collect a list of strings which,
+ % when concatenated in reverse order, produce the final output.
%
:- type revstrings == list(string).
% Utility predicate.
%
-:- pred add_revstring(string, revstrings, revstrings).
-:- mode add_revstring(in, in, out ) is det.
+:- pred add_revstring(string::in, revstrings::in, revstrings::out) is det.
add_revstring(String, RevStrings, [String | RevStrings]).
-% various different versions of univ_to_string.
+% Various different versions of univ_to_string.
string__string(Univ) = String :-
string__string(canonicalize, ops__init_mercury_op_table, Univ, String).
@@ -4321,8 +4183,7 @@
:- mode value_to_revstrings(in(canonicalize), in, in, in, out) is det.
:- mode value_to_revstrings(in(include_details_cc), in, in, in, out)
is cc_multi.
-:- mode value_to_revstrings(in, in, in, in, out)
- is cc_multi.
+:- mode value_to_revstrings(in, in, in, in, out) is cc_multi.
value_to_revstrings(NonCanon, OpsTable, X, !Rs) :-
Priority = ops__max_priority(OpsTable) + 1,
@@ -4334,8 +4195,7 @@
:- mode value_to_revstrings(in(canonicalize), in, in, in, in, out) is det.
:- mode value_to_revstrings(in(include_details_cc), in, in, in, in, out)
is cc_multi.
-:- mode value_to_revstrings(in, in, in, in, in, out)
- is cc_multi.
+:- mode value_to_revstrings(in, in, in, in, in, out) is cc_multi.
value_to_revstrings(NonCanon, OpsTable, Priority, X, !Rs) :-
%
@@ -4359,41 +4219,34 @@
; dynamic_cast(X, C_Pointer) ->
add_revstring(c_pointer_to_string(C_Pointer), !Rs)
;
+ % Check if the type is array:array/1. We can't just use dynamic_cast
+ % here since array.array/1 is a polymorphic type.
%
- % Check if the type is array:array/1.
- % We can't just use dynamic_cast here since
- % array:array/1 is a polymorphic type.
- %
- % The calls to type_ctor_name and type_ctor_module_name
- % are not really necessary -- we could use dynamic_cast
- % in the condition instead of det_dynamic_cast in the body.
- % However, this way of doing things is probably more efficient
- % in the common case when the thing being printed is
- % *not* of type array:array/1.
- %
- % The ordering of the tests here (arity, then name, then
- % module name, rather than the reverse) is also chosen
- % for efficiency, to find failure cheaply in the common cases,
- % rather than for readability.
+ % The calls to type_ctor_name and type_ctor_module_name are not really
+ % necessary -- we could use dynamic_cast in the condition instead of
+ % det_dynamic_cast in the body. However, this way of doing things
+ % is probably more efficient in the common case when the thing
+ % being printed is *not* of type array.array/1.
+ %
+ % The ordering of the tests here (arity, then name, then module name,
+ % rather than the reverse) is also chosen for efficiency, to find
+ % failure cheaply in the common cases, rather than for readability.
%
type_desc__type_ctor_and_args(type_of(X), TypeCtor, ArgTypes),
ArgTypes = [ElemType],
type_desc__type_ctor_name(TypeCtor) = "array",
type_desc__type_ctor_module_name(TypeCtor) = "array"
->
- %
- % Now that we know the element type, we can
- % constrain the type of the variable `Array'
- % so that we can use det_dynamic_cast.
+ % Now that we know the element type, we can constrain the type of
+ % the variable `Array' so that we can use det_dynamic_cast.
%
type_desc__has_type(Elem, ElemType),
same_array_elem_type(Array, Elem),
det_dynamic_cast(X, Array),
array_to_revstrings(NonCanon, OpsTable, Array, !Rs)
;
- %
- % Check if the type is private_builtin:type_info/1.
- % See the comments above for array:array/1.
+ % Check if the type is private_builtin.type_info/1.
+ % See the comments above for array.array/1.
%
type_desc__type_ctor_and_args(type_of(X), TypeCtor, ArgTypes),
ArgTypes = [ElemType],
@@ -4403,19 +4256,18 @@
type_desc__has_type(Elem, ElemType),
same_private_builtin_type(PrivateBuiltinTypeInfo, Elem),
det_dynamic_cast(X, PrivateBuiltinTypeInfo),
- private_builtin_type_info_to_revstrings(
- PrivateBuiltinTypeInfo, !Rs)
+ private_builtin_type_info_to_revstrings(PrivateBuiltinTypeInfo, !Rs)
;
- ordinary_term_to_revstrings(NonCanon, OpsTable, Priority,
- X, !Rs)
+ ordinary_term_to_revstrings(NonCanon, OpsTable, Priority, X, !Rs)
).
-:- pred same_array_elem_type(array(T), T).
-:- mode same_array_elem_type(unused, unused) is det.
+:- pred same_array_elem_type(array(T)::unused, T::unused) is det.
+
same_array_elem_type(_, _).
-:- pred same_private_builtin_type(private_builtin__type_info(T), T).
-:- mode same_private_builtin_type(unused, unused) is det.
+:- pred same_private_builtin_type(private_builtin__type_info(T)::unused,
+ T::unused) is det.
+
same_private_builtin_type(_, _).
:- pred ordinary_term_to_revstrings(deconstruct__noncanon_handling,
@@ -4437,8 +4289,7 @@
->
add_revstring("[", !Rs),
arg_to_revstrings(NonCanon, OpsTable, ListHead, !Rs),
- univ_list_tail_to_revstrings(NonCanon, OpsTable, ListTail,
- !Rs),
+ univ_list_tail_to_revstrings(NonCanon, OpsTable, ListTail, !Rs),
add_revstring("]", !Rs)
;
Functor = "[]",
@@ -4450,8 +4301,7 @@
Args = [BracedTerm]
->
add_revstring("{ ", !Rs),
- value_to_revstrings(NonCanon, OpsTable,
- univ_value(BracedTerm), !Rs),
+ value_to_revstrings(NonCanon, OpsTable, univ_value(BracedTerm), !Rs),
add_revstring(" }", !Rs)
;
Functor = "{}",
@@ -4463,8 +4313,7 @@
add_revstring("}", !Rs)
;
Args = [PrefixArg],
- ops__lookup_prefix_op(OpsTable, Functor,
- OpPriority, OpAssoc)
+ ops__lookup_prefix_op(OpsTable, Functor, OpPriority, OpAssoc)
->
maybe_add_revstring("(", Priority, OpPriority, !Rs),
add_revstring(term_io__quoted_atom(Functor), !Rs),
@@ -4475,8 +4324,7 @@
maybe_add_revstring(")", Priority, OpPriority, !Rs)
;
Args = [PostfixArg],
- ops__lookup_postfix_op(OpsTable, Functor,
- OpPriority, OpAssoc)
+ ops__lookup_postfix_op(OpsTable, Functor, OpPriority, OpAssoc)
->
maybe_add_revstring("(", Priority, OpPriority, !Rs),
adjust_priority(OpPriority, OpAssoc, NewPriority),
@@ -4487,8 +4335,8 @@
maybe_add_revstring(")", Priority, OpPriority, !Rs)
;
Args = [Arg1, Arg2],
- ops__lookup_infix_op(OpsTable, Functor,
- OpPriority, LeftAssoc, RightAssoc)
+ ops__lookup_infix_op(OpsTable, Functor, OpPriority,
+ LeftAssoc, RightAssoc)
->
maybe_add_revstring("(", Priority, OpPriority, !Rs),
adjust_priority(OpPriority, LeftAssoc, LeftPriority),
@@ -4538,20 +4386,18 @@
)
),
(
- Args = [Y | Ys]
- ->
+ Args = [Y | Ys],
add_revstring("(", !Rs),
arg_to_revstrings(NonCanon, OpsTable, Y, !Rs),
term_args_to_revstrings(NonCanon, OpsTable, Ys, !Rs),
add_revstring(")", !Rs)
;
- true
+ Args = []
)
).
-:- pred maybe_add_revstring(string, ops__priority, ops__priority,
- revstrings, revstrings).
-:- mode maybe_add_revstring(in, in, in, in, out) is det.
+:- pred maybe_add_revstring(string::in, ops__priority::in, ops__priority::in,
+ revstrings::in, revstrings::out) is det.
maybe_add_revstring(String, Priority, OpPriority, !Rs) :-
( OpPriority > Priority ->
@@ -4560,8 +4406,8 @@
true
).
-:- pred adjust_priority(ops__priority, ops__assoc, ops__priority).
-:- mode adjust_priority(in, in, out) is det.
+:- pred adjust_priority(ops__priority::in, ops__assoc::in, ops__priority::out)
+ is det.
adjust_priority(Priority, ops__y, Priority).
adjust_priority(Priority, ops__x, Priority - 1).
@@ -4577,17 +4423,25 @@
univ_list_tail_to_revstrings(NonCanon, OpsTable, Univ, !Rs) :-
deconstruct__deconstruct(univ_value(Univ), NonCanon, Functor, _Arity,
Args),
- ( Functor = "[|]", Args = [ListHead, ListTail] ->
+ (
+ Functor = "[|]",
+ Args = [ListHead, ListTail]
+ ->
add_revstring(", ", !Rs),
arg_to_revstrings(NonCanon, OpsTable, ListHead, !Rs),
univ_list_tail_to_revstrings(NonCanon, OpsTable, ListTail, !Rs)
- ; Functor = "[]", Args = [] ->
+ ;
+ Functor = "[]",
+ Args = []
+ ->
true
;
add_revstring(" | ", !Rs),
value_to_revstrings(NonCanon, OpsTable, univ_value(Univ), !Rs)
).
+ % Write the remaining arguments.
+ %
:- pred term_args_to_revstrings(deconstruct__noncanon_handling,
ops__table, list(univ), revstrings, revstrings).
:- mode term_args_to_revstrings(in(do_not_allow), in, in, in, out) is det.
@@ -4596,9 +4450,8 @@
is cc_multi.
:- mode term_args_to_revstrings(in, in, in, in, out) is cc_multi.
- % write the remaining arguments
term_args_to_revstrings(_, _, [], !Rs).
-term_args_to_revstrings(NonCanon, OpsTable, [X|Xs], !Rs) :-
+term_args_to_revstrings(NonCanon, OpsTable, [X | Xs], !Rs) :-
add_revstring(", ", !Rs),
arg_to_revstrings(NonCanon, OpsTable, X, !Rs),
term_args_to_revstrings(NonCanon, OpsTable, Xs, !Rs).
@@ -4615,16 +4468,16 @@
value_to_revstrings(NonCanon, OpsTable, Priority, univ_value(X), !Rs).
:- func comma_priority(ops__table) = ops__priority.
-/*
-comma_priority(OpsTable) =
- ( if ops__lookup_infix_op(OpTable, ",", Priority, _, _) then
- Priority
- else
- func_error("arg_priority: can't find the priority of `,'")
- ).
-*/
+
+% comma_priority(OpsTable) =
+% ( ops__lookup_infix_op(OpTable, ",", Priority, _, _) ->
+% Priority
+% ;
+% func_error("arg_priority: can't find the priority of `,'")
+% ).
% We could implement this as above, but it's more efficient to just
% hard-code it.
+
comma_priority(_OpTable) = 1000.
:- func c_pointer_to_string(c_pointer) = string.
@@ -4637,8 +4490,7 @@
:- mode array_to_revstrings(in(canonicalize), in, in, in, out) is det.
:- mode array_to_revstrings(in(include_details_cc), in, in, in, out)
is cc_multi.
-:- mode array_to_revstrings(in, in, in, in, out)
- is cc_multi.
+:- mode array_to_revstrings(in, in, in, in, out) is cc_multi.
array_to_revstrings(NonCanon, OpsTable, Array, !Rs) :-
add_revstring("array(", !Rs),
@@ -4646,27 +4498,26 @@
array__to_list(Array) `with_type` list(T), !Rs),
add_revstring(")", !Rs).
-:- pred type_desc_to_revstrings(type_desc__type_desc, revstrings, revstrings).
-:- mode type_desc_to_revstrings(in, in, out) is det.
+:- pred type_desc_to_revstrings(type_desc__type_desc::in,
+ revstrings::in, revstrings::out) is det.
type_desc_to_revstrings(TypeDesc, !Rs) :-
- add_revstring(
- term_io__quoted_atom(type_desc__type_name(TypeDesc)),
- !Rs
- ).
+ add_revstring(term_io__quoted_atom(type_desc__type_name(TypeDesc)), !Rs).
-:- pred type_ctor_desc_to_revstrings(type_desc__type_ctor_desc,
- revstrings, revstrings).
-:- mode type_ctor_desc_to_revstrings(in, in, out) is det.
+:- pred type_ctor_desc_to_revstrings(type_desc__type_ctor_desc::in,
+ revstrings::in, revstrings::out) is det.
type_ctor_desc_to_revstrings(TypeCtorDesc, !Rs) :-
- type_desc__type_ctor_name_and_arity(TypeCtorDesc,
- ModuleName, Name0, Arity0),
+ type_desc__type_ctor_name_and_arity(TypeCtorDesc, ModuleName,
+ Name0, Arity0),
Name = term_io__quoted_atom(Name0),
- ( ModuleName = "builtin", Name = "func" ->
- % The type ctor that we call `builtin:func/N' takes N + 1
- % type parameters: N arguments plus one return value.
- % So we need to subtract one from the arity here.
+ (
+ ModuleName = "builtin",
+ Name = "func"
+ ->
+ % The type ctor that we call `builtin:func/N' takes N + 1 type
+ % parameters: N arguments plus one return value. So we need to subtract
+ % one from the arity here.
Arity = Arity0 - 1
;
Arity = Arity0
@@ -4674,31 +4525,29 @@
( ModuleName = "builtin" ->
String = string__format("%s/%d", [s(Name), i(Arity)])
;
- String = string__format("%s.%s/%d",
- [s(ModuleName), s(Name), i(Arity)])
+ String = string__format("%s.%s/%d", [s(ModuleName), s(Name), i(Arity)])
),
add_revstring(String, !Rs).
:- pred private_builtin_type_info_to_revstrings(
- private_builtin__type_info(T), revstrings, revstrings).
-:- mode private_builtin_type_info_to_revstrings(in, in, out) is det.
+ private_builtin__type_info(T)::in, revstrings::in, revstrings::out)
+ is det.
private_builtin_type_info_to_revstrings(PrivateBuiltinTypeInfo, !Rs) :-
TypeDesc = rtti_implementation__unsafe_cast(PrivateBuiltinTypeInfo),
type_desc_to_revstrings(TypeDesc, !Rs).
-:- pred det_dynamic_cast(T1, T2).
-:- mode det_dynamic_cast(in, out) is det.
+:- pred det_dynamic_cast(T1::in, T2::out) is det.
det_dynamic_cast(X, Y) :-
det_univ_to_type(univ(X), Y).
%-----------------------------------------------------------------------------%
-% char_list_remove_suffix/3: We use this instead of the more general
-% list__remove_suffix so that (for example) string__format will succeed in
-% grade Java, even though unification has not yet been implemented.
-
+ % char_list_remove_suffix/3: We use this instead of the more general
+ % list__remove_suffix so that (for example) string__format will succeed in
+ % grade Java, even though unification has not yet been implemented.
+ %
:- pred char_list_remove_suffix(list(char)::in, list(char)::in,
list(char)::out) is semidet.
@@ -4723,8 +4572,7 @@
(
PaddedColumns = [PaddedHead | PaddedTail],
Rows = list.foldl(list.map_corresponding(
- string.join_rev_columns(
- Seperator)), PaddedTail, PaddedHead)
+ string.join_rev_columns(Seperator)), PaddedTail, PaddedHead)
;
PaddedColumns = [],
Rows = []
@@ -4760,9 +4608,7 @@
max_str_length(Str, PrevMaxLen, MaxLen, PrevMaxStr, MaxStr) :-
Length = string.length(Str),
- (
- Length > PrevMaxLen
- ->
+ ( Length > PrevMaxLen ->
MaxLen = Length,
MaxStr = Str
;
@@ -4789,25 +4635,25 @@
word_wrap_2([], _, _, _, _, RevStrs,
string.join_list("", list.reverse(RevStrs))).
+word_wrap_2([Word | Words], WordSep, SepLen, Col, N, Prev, Wrapped) :-
% Col is the column where the next character should be written if there
% is space for a whole word.
-word_wrap_2([Word | Words], WordSep, SepLen, Col, N, Prev, Wrapped) :-
WordLen = string.length(Word),
(
% We are on the first column and the length of the word
% is less than the line length.
- Col = 1, WordLen < N
+ Col = 1,
+ WordLen < N
->
NewCol = Col + WordLen,
WrappedRev = [Word | Prev],
NewWords = Words
;
% The word takes up the whole line.
- Col = 1, WordLen = N
+ Col = 1,
+ WordLen = N
->
- %
% We only put a newline if there are more words to follow.
- %
NewCol = 1,
(
Words = [],
@@ -4818,21 +4664,18 @@
),
NewWords = Words
;
- % If we add a space and the current word to the line we'll
- % still be within the line length limit.
+ % If we add a space and the current word to the line we'll still be
+ % within the line length limit.
Col + WordLen < N
->
NewCol = Col + WordLen + 1,
WrappedRev = [Word, " " | Prev],
NewWords = Words
;
- % Adding the word and a space takes us to the end of the
- % line exactly.
+ % Adding the word and a space takes us to the end of the line exactly.
Col + WordLen = N
->
- %
% We only put a newline if there are more words to follow.
- %
NewCol = 1,
(
Words = [],
@@ -4843,25 +4686,17 @@
),
NewWords = Words
;
- %
% Adding the word would take us over the line limit.
- %
- (
- Col = 1
- ->
- %
+ ( Col = 1 ->
% Break up words that are too big to fit on a line.
- %
- RevPieces = break_up_string_reverse(Word, N - SepLen,
- []),
+ RevPieces = break_up_string_reverse(Word, N - SepLen, []),
(
RevPieces = [LastPiece | Rest]
;
RevPieces = [],
error("string__word_wrap_2: no pieces")
),
- RestWithSep = list.map(func(S) = S ++ WordSep ++ "\n",
- Rest),
+ RestWithSep = list.map(func(S) = S ++ WordSep ++ "\n", Rest),
NewCol = 1,
WrappedRev = list.append(RestWithSep, Prev),
NewWords = [LastPiece | Words]
@@ -4876,9 +4711,7 @@
:- func break_up_string_reverse(string, int, list(string)) = list(string).
break_up_string_reverse(Str, N, Prev) = Strs :-
- (
- string.length(Str) =< N
- ->
+ ( string.length(Str) =< N ->
Strs = [Str | Prev]
;
string.split(Str, N, Left, Right),
@@ -4886,7 +4719,3 @@
).
%-----------------------------------------------------------------------------%
-:- end_module string.
-
-%------------------------------------------------------------------------------%
-%------------------------------------------------------------------------------%
Index: library/term.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/term.m,v
retrieving revision 1.113
diff -u -b -r1.113 term.m
--- library/term.m 12 Sep 2005 05:24:52 -0000 1.113
+++ library/term.m 18 Sep 2005 09:17:34 -0000
@@ -1,4 +1,6 @@
%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%---------------------------------------------------------------------------%
% Copyright (C) 1993-2000, 2003-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
@@ -57,8 +59,8 @@
%-----------------------------------------------------------------------------%
- % The following predicates can convert values of (almost)
- % any type to the type `term' and back again.
+ % The following predicates can convert values of (almost) any type
+ % to the type `term' and back again.
:- type term_to_type_result(T, U)
---> ok(T)
@@ -73,8 +75,8 @@
% where Var is a variable occurring in Term.
% If Term is not a valid term of the specified type, return
% `type_error(SubTerm, ExpectedType, Context, ArgContexts)',
- % where SubTerm is a sub-term of Term and ExpectedType is
- % the type expected for that part of Term.
+ % where SubTerm is a sub-term of Term and ExpectedType is the type
+ % expected for that part of Term.
% Context specifies the file and line number where the
% offending part of the term was read in from, if available.
% ArgContexts specifies the path from the root of the term
@@ -119,15 +121,16 @@
:- func term__type_to_term(T) = term(_).
:- pred term__type_to_term(T::in, term(_)::out) is det.
- % calls term__type_to_term on the value stored in the univ
- % (as distinct from the univ itself).
+ % Convert the value stored in the univ (as distinct from the univ itself)
+ % to a term.
%
:- func term__univ_to_term(univ) = term(_).
:- pred term__univ_to_term(univ::in, term(_)::out) is det.
%-----------------------------------------------------------------------------%
- % term__vars(Term, Vars)
+ % term__vars(Term, Vars):
+ %
% Vars is the list of variables contained in Term, in the order
% obtained by traversing the term depth first, left-to-right.
%
@@ -139,24 +142,27 @@
:- func term__vars_2(term(T), list(var(T))) = list(var(T)).
:- pred term__vars_2(term(T)::in, list(var(T))::in, list(var(T))::out) is det.
- % term__vars_list(TermList, Vars)
+ % term__vars_list(TermList, Vars):
+ %
% Vars is the list of variables contained in TermList, in the order
% obtained by traversing the list of terms depth-first, left-to-right.
%
:- func term__vars_list(list(term(T))) = list(var(T)).
:- pred term__vars_list(list(term(T))::in, list(var(T))::out) is det.
- % term__contains_var(Term, Var)
- % True if Term contains Var. On backtracking returns all the
- % variables contained in Term.
+ % term__contains_var(Term, Var):
+ %
+ % True if Term contains Var. On backtracking returns all the variables
+ % contained in Term.
%
:- pred term__contains_var(term(T), var(T)).
:- mode term__contains_var(in, in) is semidet.
:- mode term__contains_var(in, out) is nondet.
- % term__contains_var_list(TermList, Var)
- % True if TermList contains Var. On backtracking returns all the
- % variables contained in Term.
+ % term__contains_var_list(TermList, Var):
+ %
+ % True if TermList contains Var. On backtracking returns all the variables
+ % contained in Term.
%
:- pred term__contains_var_list(list(term(T)), var(T)).
:- mode term__contains_var_list(in, in) is semidet.
@@ -166,41 +172,43 @@
:- type substitution == substitution(generic).
% term__unify(Term1, Term2, Bindings0, Bindings):
+ %
% Unify (with occur check) two terms with respect to a set of bindings
% and possibly update the set of bindings.
%
:- pred term__unify(term(T)::in, term(T)::in, substitution(T)::in,
substitution(T)::out) is semidet.
- % As above, but unify the corresponding elements of two lists of
- % terms. Fails if the lists are not of equal length.
+ % As above, but unify the corresponding elements of two lists of terms.
+ % Fails if the lists are not of equal length.
%
:- pred term__unify_list(list(term(T))::in, list(term(T))::in,
substitution(T)::in, substitution(T)::out) is semidet.
- % term__unify(Term1, Term2, BoundVars, Bindings0, Bindings):
+ % term__unify(Term1, Term2, BoundVars, !Bindings):
+ %
% Unify (with occur check) two terms with respect to a set of bindings
- % and possibly update the set of bindings. Fails if any of the
- % variables in BoundVars would become bound by the unification.
+ % and possibly update the set of bindings. Fails if any of the variables
+ % in BoundVars would become bound by the unification.
%
:- pred term__unify(term(T)::in, term(T)::in, list(var(T))::in,
substitution(T)::in, substitution(T)::out) is semidet.
- % As above, but unify the corresponding elements of two lists of
- % terms. Fails if the lists are not of equal length.
+ % As above, but unify the corresponding elements of two lists of terms.
+ % Fails if the lists are not of equal length.
%
:- pred term__unify_list(list(term(T))::in, list(term(T))::in,
- list(var(T))::in, substitution(T)::in, substitution(T)::out)
- is semidet.
+ list(var(T))::in, substitution(T)::in, substitution(T)::out) is semidet.
% term__list_subsumes(Terms1, Terms2, Subst) succeeds iff the list
- % Terms1 subsumes (is more general than) Terms2, producing a
- % substitution which when applied to Terms1 will give Terms2.
+ % Terms1 subsumes (is more general than) Terms2, producing a substitution
+ % which when applied to Terms1 will give Terms2.
%
:- pred term__list_subsumes(list(term(T))::in, list(term(T))::in,
substitution(T)::out) is semidet.
% term__substitute(Term0, Var, Replacement, Term):
+ %
% Replace all occurrences of Var in Term0 with Replacement,
% and return the result in Term.
%
@@ -214,19 +222,19 @@
:- pred term__substitute_list(list(term(T))::in, var(T)::in, term(T)::in,
list(term(T))::out) is det.
- % term__substitute_corresponding(Vars, Repls, Term0, Term).
+ % term__substitute_corresponding(Vars, Repls, Term0, Term):
+ %
% Replace all occurrences of variables in Vars with the corresponding
% term in Repls, and return the result in Term. If Vars contains
- % duplicates, or if Vars is not the same length as Repls, the
- % behaviour is undefined and probably harmful.
+ % duplicates, or if Vars is not the same length as Repls, the behaviour
+ % is undefined and probably harmful.
%
:- func term__substitute_corresponding(list(var(T)), list(term(T)),
term(T)) = term(T).
:- pred term__substitute_corresponding(list(var(T))::in, list(term(T))::in,
term(T)::in, term(T)::out) is det.
- % As above, except applies to a list of terms rather than a
- % single term.
+ % As above, except applies to a list of terms rather than a single term.
%
:- func term__substitute_corresponding_list(list(var(T)),
list(term(T)), list(term(T))) = list(term(T)).
@@ -234,6 +242,7 @@
list(term(T))::in, list(term(T))::in, list(term(T))::out) is det.
% term__apply_rec_substitution(Term0, Substitution, Term):
+ %
% Recursively apply substitution to Term0 until no more substitutions
% can be applied, and then return the result in Term.
%
@@ -241,8 +250,7 @@
:- pred term__apply_rec_substitution(term(T)::in, substitution(T)::in,
term(T)::out) is det.
- % As above, except applies to a list of terms rather than a
- % single term.
+ % As above, except applies to a list of terms rather than a single term.
%
:- func term__apply_rec_substitution_to_list(list(term(T)),
substitution(T)) = list(term(T)).
@@ -250,14 +258,14 @@
substitution(T)::in, list(term(T))::out) is det.
% term__apply_substitution(Term0, Substitution, Term):
+ %
% Apply substitution to Term0 and return the result in Term.
%
:- func term__apply_substitution(term(T), substitution(T)) = term(T).
:- pred term__apply_substitution(term(T)::in, substitution(T)::in,
term(T)::out) is det.
- % As above, except applies to a list of terms rather than a
- % single term.
+ % As above, except applies to a list of terms rather than a single term.
%
:- func term__apply_substitution_to_list(list(term(T)),
substitution(T)) = list(term(T)).
@@ -265,8 +273,8 @@
substitution(T)::in, list(term(T))::out) is det.
% term__occurs(Term0, Var, Substitution):
- % True iff Var occurs in the term resulting after applying
- % Substitution to Term0.
+ % True iff Var occurs in the term resulting after applying Substitution
+ % to Term0. Var variable must not be mapped by Substitution.
%
:- pred term__occurs(term(T)::in, var(T)::in, substitution(T)::in) is semidet.
@@ -276,15 +284,15 @@
is semidet.
% term__relabel_variable(Term0, OldVar, NewVar, Term):
- % Replace all occurrences of OldVar in Term0 with NewVar and
- % put the result in Term.
+ %
+ % Replace all occurrences of OldVar in Term0 with NewVar and put the result
+ % in Term.
%
:- func term__relabel_variable(term(T), var(T), var(T)) = term(T).
:- pred term__relabel_variable(term(T)::in, var(T)::in, var(T)::in,
term(T)::out) is det.
- % As above, except applies to a list of terms rather than a
- % single term.
+ % As above, except applies to a list of terms rather than a single term.
% XXX the name of the predicate is misleading.
%
:- func term__relabel_variables(list(term(T)), var(T), var(T)) = list(term(T)).
@@ -334,6 +342,7 @@
% (We might want to give these a unique mode later.)
% term__init_var_supply(VarSupply):
+ %
% Returns a fresh var_supply for producing fresh variables.
%
:- func term__init_var_supply = var_supply(T).
@@ -355,14 +364,12 @@
%-----------------------------------------------------------------------------%
- % from_int/1 should only be applied to integers returned
- % by to_int/1. This instance declaration is needed to
- % allow sets of variables to be represented using
- % sparse_bitset.m.
+ % from_int/1 should only be applied to integers returned by to_int/1.
+ % This instance declaration is needed to allow sets of variables to be
+ % represented using sparse_bitset.m.
:- instance enum(var(_)).
- % Convert a variable to an int.
- % Different variables map to different ints.
+ % Convert a variable to an int. Different variables map to different ints.
% Other than that, the mapping is unspecified.
%
:- func term__var_to_int(var(T)) = int.
@@ -388,16 +395,15 @@
:- func term__context_init(string, int) = term__context.
:- pred term__context_init(string::in, int::in, term__context::out) is det.
- % Convert a list of terms which are all vars into a list
- % of vars. Abort (call error/1) if the list contains
- % any non-variables.
+ % Convert a list of terms which are all vars into a list of vars.
+ % Abort (call error/1) if the list contains any non-variables.
%
:- func term__term_list_to_var_list(list(term(T))) = list(var(T)).
:- pred term__term_list_to_var_list(list(term(T))::in, list(var(T))::out)
is det.
- % Convert a list of terms which are all vars into a list
- % of vars (or vice versa).
+ % Convert a list of terms which are all vars into a list of vars
+ % (or vice versa).
%
:- func term__var_list_to_term_list(list(var(T))) = list(term(T)).
:- pred term__var_list_to_term_list(list(var(T)), list(term(T))).
@@ -407,10 +413,9 @@
%-----------------------------------------------------------------------------%
% term__generic_term(Term) is true iff `Term' is a term of type
- % `term' ie `term(generic)'.
- % It is useful because in some instances it doesn't matter what
- % the type of a term is, and passing it to this predicate will
- % ground the type avoiding unbound type variable warnings.
+ % `term' ie `term(generic)'. It is useful because in some instances
+ % it doesn't matter what the type of a term is, and passing it to this
+ % predicate will ground the type avoiding unbound type variable warnings.
%
:- pred term__generic_term(term::in) is det.
@@ -441,16 +446,16 @@
:- interface.
-% This is the same as term_to_type, except that an integer
-% is allowed where a character is expected. This is needed by
-% extras/aditi/aditi.m because Aditi does not have a builtin
-% character type. This also allows an integer where a float
-% is expected.
+% This is the same as term_to_type, except that an integer is allowed
+% where a character is expected. This is needed by extras/aditi/aditi.m
+% because Aditi does not have a builtin character type. This also allows
+% an integer where a float is expected.
:- pred term__term_to_type_with_int_instead_of_char(term(U)::in, T::out)
is semidet.
% Returns the highest numbered variable returned from this var_supply.
+ %
:- func term__var_supply_max_var(var_supply(T)) = var(T).
%-----------------------------------------------------------------------------%
@@ -494,8 +499,8 @@
term_to_type_result(T, U)::out) is det.
term__try_term_to_type(IsAditiTuple, Term, Result) :-
- term__try_term_to_univ(IsAditiTuple, Term,
- type_desc__type_of(ValTypedVar), UnivResult),
+ term__try_term_to_univ(IsAditiTuple, Term, type_desc__type_of(ValTypedVar),
+ UnivResult),
(
UnivResult = ok(Univ),
det_univ_to_type(Univ, Val),
@@ -537,10 +542,7 @@
->
(
ArgsResult = ok(ArgValues),
- (
- Value = construct__construct(Type,
- FunctorNumber, ArgValues)
- ->
+ ( Value = construct__construct(Type, FunctorNumber, ArgValues) ->
Result = ok(Value)
;
error("term_to_type: construct/3 failed")
@@ -550,8 +552,8 @@
Result = error(Error)
)
;
- % the arg contexts are built up in reverse order,
- % so we need to reverse them here
+ % The arg contexts are built up in reverse order,
+ % so we need to reverse them here.
list__reverse(Context, RevContext),
Result = error(type_error(Term, Type, TermContext, RevContext))
).
@@ -625,9 +627,8 @@
fail.
term__term_to_univ_special_case(_, "std_util", "univ", [],
Term, _, _, Result) :-
- % Implementing this properly would require keeping a
- % global table mapping from type names to type_infos
- % for all of the types in the program...
+ % Implementing this properly would require keeping a global table mapping
+ % from type names to type_infos for all of the types in the program...
% so for the moment, we only allow it for basic types.
Term = term__functor(term__atom("univ"), [Arg], _),
Arg = term__functor(term__atom(":"), [Value, Type], _),
@@ -649,7 +650,7 @@
Result = ok(univ(Univ)).
term__term_to_univ_special_case(_, "std_util", "type_info", _, _, _, _, _) :-
- % ditto
+ % Ditto.
fail.
:- pred term__term_list_to_univ_list(bool::in, list(term(T))::in,
@@ -659,17 +660,15 @@
term__term_list_to_univ_list(_, [], [], _, _, _, _, ok([])).
term__term_list_to_univ_list(IsAditiTuple, [ArgTerm | ArgTerms],
- [Type | Types], Functor, ArgNum, PrevContext, TermContext,
- Result) :-
+ [Type | Types], Functor, ArgNum, PrevContext, TermContext, Result) :-
ArgContext = arg_context(Functor, ArgNum, TermContext),
NewContext = [ArgContext | PrevContext],
term__try_term_to_univ_2(IsAditiTuple, ArgTerm, Type, NewContext,
ArgResult),
(
ArgResult = ok(Arg),
- term__term_list_to_univ_list(IsAditiTuple, ArgTerms, Types,
- Functor, ArgNum + 1, PrevContext, TermContext,
- RestResult),
+ term__term_list_to_univ_list(IsAditiTuple, ArgTerms, Types, Functor,
+ ArgNum + 1, PrevContext, TermContext, RestResult),
(
RestResult = ok(Rest),
Result = ok([Arg | Rest])
@@ -707,14 +706,11 @@
( term__term_to_type(Term, X1) ->
X = X1
; \+ term__is_ground(Term) ->
- error("term__det_term_to_type failed, " ++
- "because the term wasn't ground")
+ error("term__det_term_to_type failed, because the term wasn't ground")
;
- string__append_list([
- "term__det_term_to_type failed, due to a type error:\n",
- "the term wasn't a valid term for type `",
- type_desc__type_name(type_desc__type_of(X)),
- "'"], Message),
+ Message = "term__det_term_to_type failed, due to a type error:\n"
+ ++ "the term wasn't a valid term for type `"
+ ++ type_desc__type_name(type_desc__type_of(X)) ++ "'",
error(Message)
).
@@ -723,42 +719,34 @@
term__type_to_term(Val, Term) :- type_to_univ(Val, Univ),
term__univ_to_term(Univ, Term).
- % convert the value stored in the univ (as distinct from
- % the univ itself) to a term.
term__univ_to_term(Univ, Term) :-
term__context_init(Context),
Type = univ_type(Univ),
% NU-Prolog barfs on `num_functors(Type) < 0'
( construct__num_functors(Type) = N, N < 0 ->
(
- type_desc__type_ctor_and_args(Type, TypeCtor,
- TypeArgs),
+ type_desc__type_ctor_and_args(Type, TypeCtor, TypeArgs),
TypeName = type_desc__type_ctor_name(TypeCtor),
- ModuleName =
- type_desc__type_ctor_module_name(TypeCtor),
- term__univ_to_term_special_case(ModuleName, TypeName,
- TypeArgs, Univ, Context, SpecialCaseTerm)
+ ModuleName = type_desc__type_ctor_module_name(TypeCtor),
+ term__univ_to_term_special_case(ModuleName, TypeName, TypeArgs,
+ Univ, Context, SpecialCaseTerm)
->
Term = SpecialCaseTerm
;
- string__append_list(
- ["term__type_to_term: unknown type `",
- type_desc__type_name(univ_type(Univ)),
- "'"],
- Message),
+ Message = "term__type_to_term: unknown type `"
+ ++ type_desc__type_name(univ_type(Univ)) ++ "'",
error(Message)
)
;
deconstruct(univ_value(Univ), FunctorString, _FunctorArity,
FunctorArgs),
term__univ_list_to_term_list(FunctorArgs, TermArgs),
- Term = term__functor(term__atom(FunctorString), TermArgs,
- Context)
+ Term = term__functor(term__atom(FunctorString), TermArgs, Context)
).
:- pred term__univ_to_term_special_case(string::in, string::in,
- list(type_desc__type_desc)::in, univ::in, term__context::in,
- term(T)::out) is semidet.
+ list(type_desc__type_desc)::in, univ::in, term__context::in, term(T)::out)
+ is semidet.
term__univ_to_term_special_case("builtin", "int", [], Univ, Context,
term__functor(term__integer(Int), [], Context)) :-
@@ -780,8 +768,7 @@
term__univ_to_term_special_case("std_util", "univ", [], Univ, Context, Term) :-
det_univ_to_type(Univ, NestedUniv),
Term = term__functor(term__atom("univ"),
- % XXX what operator should we use for type
- % qualification?
+ % XXX what operator should we use for type qualification?
[term__functor(term__atom(":"), % TYPE_QUAL_OP
[ValueTerm, TypeTerm], Context)], Context),
type_info_to_term(Context, univ_type(NestedUniv), TypeTerm),
@@ -801,15 +788,16 @@
same_type(_, _).
-:- pred term__univ_list_to_term_list(list(univ)::in,
- list(term(T))::out) is det.
+:- pred term__univ_list_to_term_list(list(univ)::in, list(term(T))::out)
+ is det.
term__univ_list_to_term_list([], []).
term__univ_list_to_term_list([Value|Values], [Term|Terms]) :-
term__univ_to_term(Value, Term),
term__univ_list_to_term_list(Values, Terms).
-% given a type_info, return a term that represents the name of that type.
+ % Given a type_info, return a term that represents the name of that type.
+ %
:- pred type_info_to_term(term__context::in, type_desc__type_desc::in,
term(T)::out) is det.
@@ -854,8 +842,6 @@
%-----------------------------------------------------------------------------%
- % term__contains_var(Term, Var) is true if Var occurs in Term.
-
term__contains_var(term__variable(Var), Var).
term__contains_var(term__functor(_, Args, _), Var) :-
term__contains_var_list(Args, Var).
@@ -874,26 +860,21 @@
%-----------------------------------------------------------------------------%
- % Unify two terms (with occurs check), updating the bindings of
- % the variables in the terms.
-
term__unify(term__variable(X), term__variable(Y), !Bindings) :-
( map__search(!.Bindings, X, BindingOfX) ->
( map__search(!.Bindings, Y, BindingOfY) ->
- % both X and Y already have bindings - just
- % unify the terms they are bound to
+ % Both X and Y already have bindings - just unify the terms
+ % they are bound to.
term__unify(BindingOfX, BindingOfY, !Bindings)
;
- % Y is a variable which hasn't been bound yet
+ % Y is a variable which hasn't been bound yet.
term__apply_rec_substitution(BindingOfX, !.Bindings,
SubstBindingOfX),
( SubstBindingOfX = term__variable(Y) ->
true
;
- \+ term__occurs(SubstBindingOfX, Y,
- !.Bindings),
- map__set(!.Bindings, Y, SubstBindingOfX,
- !:Bindings)
+ \+ term__occurs(SubstBindingOfX, Y, !.Bindings),
+ map__set(!.Bindings, Y, SubstBindingOfX, !:Bindings)
)
)
;
@@ -904,10 +885,8 @@
( SubstBindingOfY = term__variable(X) ->
true
;
- \+ term__occurs(SubstBindingOfY, X,
- !.Bindings),
- map__set(!.Bindings, X, SubstBindingOfY,
- !:Bindings)
+ \+ term__occurs(SubstBindingOfY, X, !.Bindings),
+ map__set(!.Bindings, X, SubstBindingOfY, !:Bindings)
)
;
% both X and Y are unbound variables -
@@ -915,8 +894,7 @@
( X = Y ->
true
;
- map__set(!.Bindings, X, term__variable(Y),
- !:Bindings)
+ map__set(!.Bindings, X, term__variable(Y), !:Bindings)
)
)
).
@@ -954,8 +932,7 @@
( map__search(!.Bindings, Y, BindingOfY) ->
% Both X and Y already have bindings - just unify the
% terms they are bound to.
- term__unify(BindingOfX, BindingOfY, BoundVars,
- !Bindings)
+ term__unify(BindingOfX, BindingOfY, BoundVars, !Bindings)
;
term__apply_rec_substitution(BindingOfX, !.Bindings,
SubstBindingOfX),
@@ -963,10 +940,8 @@
( SubstBindingOfX = term__variable(Y) ->
true
;
- \+ term__occurs(SubstBindingOfX, Y,
- !.Bindings),
- svmap__det_insert(Y, SubstBindingOfX,
- !Bindings)
+ \+ term__occurs(SubstBindingOfX, Y, !.Bindings),
+ svmap__det_insert(Y, SubstBindingOfX, !Bindings)
)
)
;
@@ -977,30 +952,23 @@
( SubstBindingOfY = term__variable(X) ->
true
;
- \+ term__occurs(SubstBindingOfY, X,
- !.Bindings),
- svmap__det_insert(X, SubstBindingOfY,
- !Bindings)
+ \+ term__occurs(SubstBindingOfY, X, !.Bindings),
+ svmap__det_insert(X, SubstBindingOfY, !Bindings)
)
;
- % Both X and Y are unbound variables - bind one to the
- % other.
+ % Both X and Y are unbound variables - bind one to the other.
( X = Y ->
true
;
- svmap__det_insert(X, term__variable(Y),
- !Bindings)
+ svmap__det_insert(X, term__variable(Y), !Bindings)
)
)
).
term__unify(term__variable(X), term__functor(F, As, C), BoundVars,
!Bindings) :-
- (
- map__search(!.Bindings, X, BindingOfX)
- ->
- term__unify(BindingOfX, term__functor(F, As, C), BoundVars,
- !Bindings)
+ ( map__search(!.Bindings, X, BindingOfX) ->
+ term__unify(BindingOfX, term__functor(F, As, C), BoundVars, !Bindings)
;
\+ term__occurs_list(As, X, !.Bindings),
\+ list__member(X, BoundVars),
@@ -1012,8 +980,7 @@
(
map__search(!.Bindings, X, BindingOfX)
->
- term__unify(term__functor(F, As, C), BindingOfX, BoundVars,
- !Bindings)
+ term__unify(term__functor(F, As, C), BindingOfX, BoundVars, !Bindings)
;
\+ term__occurs_list(As, X, !.Bindings),
\+ list__member(X, BoundVars),
@@ -1050,26 +1017,19 @@
true
;
\+ list__member(Var, BoundVars),
- svmap__det_insert(Var, term__variable(BoundVar),
- !Bindings)
+ svmap__det_insert(Var, term__variable(BoundVar), !Bindings)
)
).
term__list_subsumes(Terms1, Terms2, Subst) :-
- %
% Terms1 subsumes Terms2 iff Terms1 can be unified with Terms2
% without binding any of the variables in Terms2.
- %
term__vars_list(Terms2, Terms2Vars),
map__init(Subst0),
term__unify_list(Terms1, Terms2, Terms2Vars, Subst0, Subst).
%-----------------------------------------------------------------------------%
- % term__occurs(Term, Var, Subst) succeeds if Term contains Var,
- % perhaps indirectly via the substitution. (The variable must
- % not be mapped by the substitution.)
-
term__occurs(term__variable(X), Y, Bindings) :-
( X = Y ->
true
@@ -1089,10 +1049,6 @@
%-----------------------------------------------------------------------------%
- % term__substitute(Term0, Var, Replacement, Term) :
- % replace all occurrences of Var in Term0 with Replacement,
- % and return the result in Term.
-
term__substitute(term__variable(Var), SearchVar, Replacement, Term) :-
( Var = SearchVar ->
Term = Replacement
@@ -1121,8 +1077,7 @@
( term__substitute_corresponding_2(Ss, Rs, Subst0, Subst) ->
term__apply_substitution_to_list(TermList0, Subst, TermList)
;
- error("term__substitute_corresponding_list: " ++
- "different length lists")
+ error("term__substitute_corresponding_list: different length lists")
).
:- pred term__substitute_corresponding_2(list(var(T))::in, list(term(T))::in,
@@ -1137,7 +1092,7 @@
term__apply_rec_substitution(term__variable(Var), Substitution, Term) :-
( map__search(Substitution, Var, Replacement) ->
- % recursively apply the substition to the replacement
+ % Recursively apply the substition to the replacement.
term__apply_rec_substitution(Replacement, Substitution, Term)
;
Term = term__variable(Var)
@@ -1172,12 +1127,10 @@
%-----------------------------------------------------------------------------%
- % create a new supply of variables
term__init_var_supply(var_supply(0)).
- % We number variables using sequential numbers,
-
term__create_var(var_supply(V0), var(V), var_supply(V)) :-
+ % We number variables using sequential numbers,
V = V0 + 1.
%------------------------------------------------------------------------------%
@@ -1194,6 +1147,7 @@
term__var_to_int(var(Var), Var).
% Cast an integer to a var(T), subverting the type-checking.
+ %
:- func unsafe_int_to_var(int) = var(T).
term__unsafe_int_to_var(Var) = var(Var).
@@ -1202,7 +1156,6 @@
%-----------------------------------------------------------------------------%
- % substitute a variable name in a term.
term__relabel_variable(term__functor(Const, Terms0, Cont), OldVar, NewVar,
term__functor(Const, Terms, Cont)) :-
term__relabel_variables(Terms0, OldVar, NewVar, Terms).
@@ -1291,9 +1244,9 @@
%-----------------------------------------------------------------------------%
term__coerce(A, B) :-
- % Normally calls to this predicate should only be
- % generated by the compiler, but type coercion by
- % copying was taking about 3% of the compiler's runtime.
+ % Normally calls to this predicate should only be generated by the
+ % compiler, but type coercion by copying was taking about 3% of the
+ % compiler's runtime.
private_builtin__unsafe_type_cast(A, B).
term__coerce_var(var(V), var(V)).
Index: library/term_io.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/term_io.m,v
retrieving revision 1.75
diff -u -b -r1.75 term_io.m
--- library/term_io.m 22 Aug 2005 03:55:14 -0000 1.75
+++ library/term_io.m 18 Sep 2005 10:33:02 -0000
@@ -1,4 +1,6 @@
%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%---------------------------------------------------------------------------%
% Copyright (C) 1994-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
@@ -44,7 +46,8 @@
:- type read_term == read_term(generic).
- % term_io__read_term(Result, IO0, IO1).
+ % term_io__read_term(Result, !IO):
+ %
% Read a term from standard input. Similar to NU-Prolog read_term/2,
% except that resulting term is in the ground representation.
% Binds Result to either `eof', `term(VarSet, Term)', or
@@ -58,7 +61,8 @@
:- pred term_io__read_term_with_op_table(Ops::in, read_term(T)::out,
io::di, io::uo) is det <= op_table(Ops).
- % Writes a term to standard output.
+ % Writes a term to standard output. Uses the variable names specified
+ % by the varset. Writes _N for all unnamed variables, with N starting at 0.
%
:- pred term_io__write_term(varset(T)::in, term(T)::in, io::di, io::uo) is det.
@@ -226,7 +230,7 @@
; varset__search_name(!.VarSet, Id, Name) ->
io__write_string(Name, !IO)
;
- % XXX problems with name clashes
+ % XXX Problems with name clashes.
term__var_to_int(Id, VarNum),
string__int_to_string(VarNum, Num),
@@ -238,10 +242,6 @@
%-----------------------------------------------------------------------------%
- % write a term to standard output.
- % use the variable names specified by varset and write _N
- % for all unnamed variables with N starting at 0.
-
term_io__write_term(VarSet, Term, !IO) :-
io__get_op_table(Ops, !IO),
term_io__write_term_with_op_table(Ops, VarSet, Term, !IO).
@@ -250,16 +250,16 @@
term_io__write_term_2(Ops, Term, VarSet, _, 0, _, !IO).
:- pred term_io__write_term_2(Ops::in, term(T)::in,
- varset(T)::in, varset(T)::out, int::in, int::out,
- io::di, io::uo) is det <= op_table(Ops).
+ varset(T)::in, varset(T)::out, int::in, int::out, io::di, io::uo) is det
+ <= op_table(Ops).
term_io__write_term_2(Ops, Term, !VarSet, !N, !IO) :-
term_io__write_term_3(Ops, Term, ops__max_priority(Ops) + 1,
!VarSet, !N, !IO).
:- pred term_io__write_arg_term(Ops::in, term(T)::in,
- varset(T)::in, varset(T)::out, int::in, int::out,
- io::di, io::uo) is det <= op_table(Ops).
+ varset(T)::in, varset(T)::out, int::in, int::out, io::di, io::uo) is det
+ <= op_table(Ops).
term_io__write_arg_term(Ops, Term, !VarSet, !N, !IO) :-
term_io__write_term_3(Ops, Term, ops__arg_priority(Ops),
@@ -302,9 +302,9 @@
term_io__write_term_args(Ops, BracedTail, !VarSet, !N, !IO),
io__write_char('}', !IO)
;
- % the empty functor '' is used for higher-order syntax:
- % Var(Arg, ...) gets parsed as ''(Var, Arg). When writing
- % it out, we want to use the nice syntax.
+ % The empty functor '' is used for higher-order syntax: Var(Arg, ...)
+ % gets parsed as ''(Var, Arg). When writing it out, we want to use
+ % the nice syntax.
Functor = term__atom(""),
Args = [term__variable(Var), FirstArg | OtherArgs]
->
@@ -322,8 +322,7 @@
term_io__write_constant(Functor, !IO),
io__write_char(' ', !IO),
adjust_priority_for_assoc(OpPriority, OpAssoc, NewPriority),
- term_io__write_term_3(Ops, PrefixArg, NewPriority,
- !VarSet, !N, !IO),
+ term_io__write_term_3(Ops, PrefixArg, NewPriority, !VarSet, !N, !IO),
maybe_write_paren(')', Priority, OpPriority, !IO)
;
Args = [PostfixArg],
@@ -332,31 +331,25 @@
->
maybe_write_paren('(', Priority, OpPriority, !IO),
adjust_priority_for_assoc(OpPriority, OpAssoc, NewPriority),
- term_io__write_term_3(Ops, PostfixArg, NewPriority,
- !VarSet, !N, !IO),
+ term_io__write_term_3(Ops, PostfixArg, NewPriority, !VarSet, !N, !IO),
io__write_char(' ', !IO),
term_io__write_constant(Functor, !IO),
maybe_write_paren(')', Priority, OpPriority, !IO)
;
Args = [Arg1, Arg2],
Functor = term__atom(OpName),
- ops__lookup_infix_op(Ops, OpName, OpPriority,
- LeftAssoc, RightAssoc)
+ ops__lookup_infix_op(Ops, OpName, OpPriority, LeftAssoc, RightAssoc)
->
maybe_write_paren('(', Priority, OpPriority, !IO),
adjust_priority_for_assoc(OpPriority, LeftAssoc, LeftPriority),
- term_io__write_term_3(Ops, Arg1, LeftPriority,
- !VarSet, !N, !IO),
+ term_io__write_term_3(Ops, Arg1, LeftPriority, !VarSet, !N, !IO),
( OpName = "," ->
io__write_string(", ", !IO)
; OpName = "." ->
- % If the operator is '.'/2 then we must not
- % put spaces around it (or at the very least,
- % we should not put spaces afterwards, which
- % would make it appear as the end-of-term
- % token). However, we do have to quote it
- % if the right hand side can begin with
- % a digit.
+ % If the operator is '.'/2 then we must not put spaces around it
+ % (or at the very least, we should not put spaces afterwards, which
+ % would make it appear as the end-of-term token). However, we do
+ % have to quote it if the right hand side can begin with a digit.
( starts_with_digit(Arg2) ->
Dot = "'.'"
;
@@ -368,10 +361,8 @@
term_io__write_constant(Functor, !IO),
io__write_char(' ', !IO)
),
- adjust_priority_for_assoc(OpPriority, RightAssoc,
- RightPriority),
- term_io__write_term_3(Ops, Arg2, RightPriority,
- !VarSet, !N, !IO),
+ adjust_priority_for_assoc(OpPriority, RightAssoc, RightPriority),
+ term_io__write_term_3(Ops, Arg2, RightPriority, !VarSet, !N, !IO),
maybe_write_paren(')', Priority, OpPriority, !IO)
;
Args = [Arg1, Arg2],
@@ -382,15 +373,11 @@
maybe_write_paren('(', Priority, OpPriority, !IO),
term_io__write_constant(Functor, !IO),
io__write_char(' ', !IO),
- adjust_priority_for_assoc(OpPriority, FirstAssoc,
- FirstPriority),
- term_io__write_term_3(Ops, Arg1, FirstPriority,
- !VarSet, !N, !IO),
+ adjust_priority_for_assoc(OpPriority, FirstAssoc, FirstPriority),
+ term_io__write_term_3(Ops, Arg1, FirstPriority, !VarSet, !N, !IO),
io__write_char(' ', !IO),
- adjust_priority_for_assoc(OpPriority, SecondAssoc,
- SecondPriority),
- term_io__write_term_3(Ops, Arg2, SecondPriority,
- !VarSet, !N, !IO),
+ adjust_priority_for_assoc(OpPriority, SecondAssoc, SecondPriority),
+ term_io__write_term_3(Ops, Arg2, SecondPriority, !VarSet, !N, !IO),
maybe_write_paren(')', Priority, OpPriority, !IO)
;
(
@@ -406,19 +393,20 @@
term_io__write_constant(Functor,
maybe_adjacent_to_graphic_token, !IO)
),
- ( Args = [X | Xs] ->
+ (
+ Args = [X | Xs],
io__write_char('(', !IO),
term_io__write_arg_term(Ops, X, !VarSet, !N, !IO),
term_io__write_term_args(Ops, Xs, !VarSet, !N, !IO),
io__write_char(')', !IO)
;
- true
+ Args = []
)
).
:- pred term_io__write_list_tail(Ops::in, term(T)::in,
- varset(T)::in, varset(T)::out, int::in, int::out,
- io::di, io::uo) is det <= op_table(Ops).
+ varset(T)::in, varset(T)::out, int::in, int::out, io::di, io::uo) is det
+ <= op_table(Ops).
term_io__write_list_tail(Ops, Term, !VarSet, !N, !IO) :-
(
@@ -427,8 +415,7 @@
->
term_io__write_list_tail(Ops, Val, !VarSet, !N, !IO)
;
- Term = term__functor(term__atom("[|]"),
- [ListHead, ListTail], _)
+ Term = term__functor(term__atom("[|]"), [ListHead, ListTail], _)
->
io__write_string(", ", !IO),
term_io__write_arg_term(Ops, ListHead, !VarSet, !N, !IO),
@@ -463,8 +450,8 @@
%-----------------------------------------------------------------------------%
:- pred term_io__write_term_args(Ops::in, list(term(T))::in,
- varset(T)::in, varset(T)::out, int::in, int::out,
- io::di, io::uo) is det <= op_table(Ops).
+ varset(T)::in, varset(T)::out, int::in, int::out, io::di, io::uo) is det
+ <= op_table(Ops).
% write the remaining arguments
term_io__write_term_args(_, [], !VarSet, !N, !IO).
@@ -506,8 +493,8 @@
%-----------------------------------------------------------------------------%
-term_io__quote_char(C) -->
- io__write_string(term_io__quoted_char(C)).
+term_io__quote_char(C, !IO) :-
+ io__write_string(term_io__quoted_char(C), !IO).
term_io__quoted_char(C) =
string__format("'%s'", [s(term_io__escaped_char(C))]).
@@ -520,9 +507,11 @@
term_io__quote_atom(S, NextToGraphicToken, !IO) :-
ShouldQuote = should_atom_be_quoted(S, NextToGraphicToken),
- ( ShouldQuote = no ->
+ (
+ ShouldQuote = no,
io__write_string(S, !IO)
;
+ ShouldQuote = yes,
io__write_char('''', !IO),
term_io__write_escaped_string(S, !IO),
io__write_char('''', !IO)
@@ -530,9 +519,11 @@
term_io__quoted_atom(S, NextToGraphicToken) = String :-
ShouldQuote = should_atom_be_quoted(S, NextToGraphicToken),
- ( ShouldQuote = no ->
+ (
+ ShouldQuote = no,
String = S
;
+ ShouldQuote = yes,
ES = term_io__escaped_string(S),
String = string__append_list(["'", ES, "'"])
).
@@ -541,42 +532,37 @@
should_atom_be_quoted(S, NextToGraphicToken) = ShouldQuote :-
(
- % I didn't make these rules up: see ISO Prolog 6.3.1.3
- % and 6.4.2.
+ % I didn't make these rules up: see ISO Prolog 6.3.1.3 and 6.4.2. -fjh
(
- % letter digit token (6.4.2)
+ % Letter digit token (6.4.2)
string__first_char(S, FirstChar, Rest),
char__is_lower(FirstChar),
string__is_alnum_or_underscore(Rest)
;
- % semicolon token (6.4.2)
+ % Semicolon token (6.4.2)
S = ";"
;
- % cut token (6.4.2)
+ % Cut token (6.4.2)
S = "!"
;
- % graphic token (6.4.2)
+ % Graphic token (6.4.2)
string__to_char_list(S, Chars),
- \+ (
- list__member(Char, Chars),
- \+ lexer__graphic_token_char(Char)
+ (
+ list__member(Char, Chars)
+ =>
+ lexer__graphic_token_char(Char)
),
- Chars \= [],
- %
- % We need to quote tokens starting with '#',
- % because Mercury uses '#' to start source line
- % number indicators.
- %
+ Chars = [_ | _],
+
+ % We need to quote tokens starting with '#', because Mercury uses
+ % '#' to start source line number indicators.
Chars \= ['#' | _],
- %
- % If the token could be the last token in a term,
- % and the term could be followed with ".\n",
- % then we need to quote the token, otherwise
- % the "." would be considered part of the
- % same graphic token. We can only leave it
- % unquoted if we're sure it won't be adjacent
- % to any graphic token.
- %
+
+ % If the token could be the last token in a term, and the term
+ % could be followed with ".\n", then we need to quote the token,
+ % otherwise the "." would be considered part of the same graphic
+ % token. We can only leave it unquoted if we're sure it won't be
+ % adjacent to any graphic token.
NextToGraphicToken = not_adjacent_to_graphic_token
;
% 6.3.1.3: atom = open list, close list ;
@@ -588,13 +574,12 @@
->
ShouldQuote = no
;
- % anything else must be output as a quoted token (6.4.2)
+ % Anything else must be output as a quoted token (6.4.2).
ShouldQuote = yes
).
- % Note: the code here is similar to code in
- % compiler/mercury_to_mercury.m; any changes here
- % may require similar changes there.
+% Note: the code here is similar to code in compiler/mercury_to_mercury.m;
+% any changes here may require similar changes there.
term_io__quote_string(S, !IO) :-
io__write_char('"', !IO),
@@ -621,10 +606,10 @@
String = String0 ++ mercury_escape_char(Char)
).
- % Note: the code of add_escaped_char and write_escaped_char should be
- % kept in sync. The code of both is similar to code in
- % compiler/mercury_to_mercury.m; any changes here may require
- % similar changes there.
+% Note: the code of add_escaped_char and write_escaped_char should be
+% kept in sync. The code of both is similar to code in
+% compiler/mercury_to_mercury.m; any changes here may require
+% similar changes there.
term_io__write_escaped_char(Char, !IO) :-
( mercury_escape_special_char(Char, QuoteChar) ->
@@ -648,14 +633,12 @@
% Convert a character to the corresponding octal escape code.
%
- % We use ISO-Prolog style octal escapes, which are of the form
- % '\nnn\'; note that unlike C octal escapes, they are terminated
- % with a backslash.
- %
- % Note: the code here is similar to code in
- % compiler/mercury_to_mercury.m; any changes here
- % may require similar changes there.
-
+ % We use ISO-Prolog style octal escapes, which are of the form '\nnn\';
+ % note that unlike C octal escapes, they are terminated with a backslash.
+ %
+ % Note: the code here is similar to code in compiler/mercury_to_mercury.m;
+ % any changes here may require similar changes there.
+ %
:- func mercury_escape_char(char) = string.
mercury_escape_char(Char) = EscapeCode :-
@@ -664,15 +647,14 @@
string__pad_left(OctalString0, '0', 3, OctalString),
EscapeCode = "\\" ++ OctalString ++ "\\".
+ % Succeed if Char is a character which is allowed in Mercury string
+ % and character literals.
+ %
+ % Note: the code here is similar to code in compiler/mercury_to_mercury.m;
+ % any changes here may require similar changes there.
+ %
:- pred is_mercury_source_char(char::in) is semidet.
- % Succeed if Char is a character which is allowed in
- % Mercury string and character literals.
-
- % Note: the code here is similar to code in
- % compiler/mercury_to_mercury.m; any changes here
- % may require similar changes there.
-
is_mercury_source_char(Char) :-
( char__is_alnum(Char) ->
true
@@ -684,12 +666,11 @@
% Currently we only allow the following characters.
% XXX should we just use is_printable(Char) instead?
-
- % Note: the code here is similar to code in
- % compiler/mercury_to_mercury.m and also
- % runtime/mercury_trace_base.c; any changes here
- % may require similar changes there.
-
+ %
+ % Note: the code here is similar to code in compiler/mercury_to_mercury.m
+ % and also runtime/mercury_trace_base.c; any changes here may require
+ % similar changes there.
+ %
:- pred is_mercury_punctuation_char(char::in) is semidet.
is_mercury_punctuation_char(' ').
@@ -728,15 +709,14 @@
%-----------------------------------------------------------------------------%
- % mercury_escape_special_char(Char, EscapeChar)
- % is true iff Char is character for which there is a special
- % backslash-escape character EscapeChar that can be used
- % after a backslash in string literals or atoms to represent Char.
-
- % Note: the code here is similar to code in
- % compiler/mercury_to_mercury.m; any changes here
- % may require similar changes there.
-
+ % mercury_escape_special_char(Char, EscapeChar) is true iff Char
+ % is character for which there is a special backslash-escape character
+ % EscapeChar that can be used after a backslash in string literals or
+ % atoms to represent Char.
+ %
+ % Note: the code here is similar to code in compiler/mercury_to_mercury.m;
+ % any changes here may require similar changes there.
+ %
:- pred mercury_escape_special_char(char::in, char::out) is semidet.
mercury_escape_special_char('''', '''').
Index: library/type_desc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/type_desc.m,v
retrieving revision 1.32
diff -u -b -r1.32 type_desc.m
--- library/type_desc.m 16 Jun 2005 04:08:06 -0000 1.32
+++ library/type_desc.m 18 Sep 2005 10:41:27 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%-----------------------------------------------------------------------------%
% Copyright (C) 2002-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
@@ -50,8 +52,8 @@
%
:- func pseudo_type_desc_to_rep(pseudo_type_desc) = pseudo_type_rep.
- % Convert a type_desc, which by definition describes a ground
- % type, to a pseudo_type_desc.
+ % Convert a type_desc, which by definition describes a ground type,
+ % to a pseudo_type_desc.
%
:- func type_desc_to_pseudo_type_desc(type_desc) = pseudo_type_desc.
@@ -67,63 +69,59 @@
:- func ground_pseudo_type_desc_to_type_desc_det(pseudo_type_desc) = type_desc
is det.
- % (Note: it is not possible for the type of a variable to be an
- % unbound type variable; if there are no constraints on a type
- % variable, then the typechecker will use the type `void'.
- % `void' is a special (builtin) type that has no constructors.
- % There is no way of creating an object of type `void'.
- % `void' is not considered to be a discriminated union, so
- % get_functor/5 and construct/3 will fail if used upon a value
- % of this type.)
-
% The function type_of/1 returns a representation of the type
% of its argument.
%
+ % (Note: it is not possible for the type of a variable to be an unbound
+ % type variable; if there are no constraints on a type variable, then the
+ % typechecker will use the type `void'. `void' is a special (builtin) type
+ % that has no constructors. There is no way of creating an object of
+ % type `void'. `void' is not considered to be a discriminated union, so
+ % get_functor/5 and construct/3 will fail if used upon a value of
+ % this type.)
+ %
:- func type_of(T::unused) = (type_desc__type_desc::out) is det.
- % The predicate has_type/2 is basically an existentially typed
- % inverse to the function type_of/1. It constrains the type
- % of the first argument to be the type represented by the
- % second argument.
+ % The predicate has_type/2 is basically an existentially typed inverse
+ % to the function type_of/1. It constrains the type of the first argument
+ % to be the type represented by the second argument.
%
:- some [T] pred has_type(T::unused, type_desc__type_desc::in) is det.
% type_name(Type) returns the name of the specified type
% (e.g. type_name(type_of([2,3])) = "list:list(int)").
% Any equivalence types will be fully expanded.
- % Builtin types (those defined in builtin.m) will
- % not have a module qualifier.
+ % Builtin types (those defined in builtin.m) will not have
+ % a module qualifier.
%
:- func type_name(type_desc__type_desc) = string.
% type_ctor_and_args(Type, TypeCtor, TypeArgs):
- % True iff `TypeCtor' is a representation of the top-level
- % type constructor for `Type', and `TypeArgs' is a list
- % of the corresponding type arguments to `TypeCtor',
- % and `TypeCtor' is not an equivalence type.
- %
- % For example, type_ctor_and_args(type_of([2,3]), TypeCtor,
- % TypeArgs) will bind `TypeCtor' to a representation of the
- % type constructor list/1, and will bind `TypeArgs' to the list
- % `[Int]', where `Int' is a representation of the type `int'.
- %
- % Note that the requirement that `TypeCtor' not be an
- % equivalence type is fulfilled by fully expanding any
- % equivalence types. For example, if you have a declaration
- % `:- type foo == bar.', then type_ctor_and_args/3 will always
- % return a representation of type constructor `bar/0', not `foo/0'.
- % (If you don't want them expanded, you can use the reverse mode
- % of make_type/2 instead.)
+ %
+ % True iff `TypeCtor' is a representation of the top-level type constructor
+ % for `Type', and `TypeArgs' is a list of the corresponding type arguments
+ % to `TypeCtor', and `TypeCtor' is not an equivalence type.
+ %
+ % For example, type_ctor_and_args(type_of([2,3]), TypeCtor, TypeArgs)
+ % will bind `TypeCtor' to a representation of the type constructor list/1,
+ % and will bind `TypeArgs' to the list `[Int]', where `Int' is a
+ % representation of the type `int'.
+ %
+ % Note that the requirement that `TypeCtor' not be an equivalence type
+ % is fulfilled by fully expanding any equivalence types. For example,
+ % if you have a declaration `:- type foo == bar.', then
+ % type_ctor_and_args/3 will always return a representation of type
+ % constructor `bar/0', not `foo/0'. (If you don't want them expanded,
+ %% you can use the reverse mode of make_type/2 instead.)
%
:- pred type_ctor_and_args(type_desc__type_desc::in,
- type_desc__type_ctor_desc::out, list(type_desc__type_desc)::out)
- is det.
+ type_desc__type_ctor_desc::out, list(type_desc__type_desc)::out) is det.
% pseudo_type_ctor_and_args(Type, TypeCtor, TypeArgs):
- % True iff `TypeCtor' is a representation of the top-level
- % type constructor for `Type', and `TypeArgs' is a list
- % of the corresponding type arguments to `TypeCtor',
- % and `TypeCtor' is not an equivalence type.
+ %
+ % True iff `TypeCtor' is a representation of the top-level type constructor
+ % for `Type', and `TypeArgs' is a list of the corresponding type arguments
+ % to `TypeCtor', and `TypeCtor' is not an equivalence type.
%
% Similar to type_ctor_and_args, but works on pseudo_type_infos.
% Fails if the input pseudo_type_info is a variable.
@@ -154,8 +152,7 @@
:- func pseudo_type_args(type_desc__pseudo_type_desc) =
list(type_desc__pseudo_type_desc) is semidet.
- % type_ctor_name(TypeCtor) returns the name of specified
- % type constructor.
+ % type_ctor_name(TypeCtor) returns the name of specified type constructor.
% (e.g. type_ctor_name(type_ctor(type_of([2,3]))) = "list").
%
:- func type_ctor_name(type_desc__type_ctor_desc) = string.
@@ -181,17 +178,16 @@
string::out, string::out, int::out) is det.
% make_type(TypeCtor, TypeArgs) = Type:
- % True iff `Type' is a type constructed by applying
- % the type constructor `TypeCtor' to the type arguments
- % `TypeArgs'.
- %
- % Operationally, the forwards mode returns the type formed by
- % applying the specified type constructor to the specified
- % argument types, or fails if the length of TypeArgs is not the
- % same as the arity of TypeCtor. The reverse mode returns a
- % type constructor and its argument types, given a type_desc;
- % the type constructor returned may be an equivalence type
- % (and hence this reverse mode of make_type/2 may be more useful
+ %
+ % True iff `Type' is a type constructed by applying the type constructor
+ % `TypeCtor' to the type arguments `TypeArgs'.
+ %
+ % Operationally, the forwards mode returns the type formed by applying
+ % the specified type constructor to the specified argument types, or fails
+ % if the length of TypeArgs is not the same as the arity of TypeCtor.
+ % The reverse mode returns a type constructor and its argument types,
+ % given a type_desc; the type constructor returned may be an equivalence
+ % type (and hence this reverse mode of make_type/2 may be more useful
% for some purposes than the type_ctor/1 function).
%
:- func make_type(type_desc__type_ctor_desc, list(type_desc__type_desc)) =
@@ -201,9 +197,9 @@
% det_make_type(TypeCtor, TypeArgs):
%
- % Returns the type formed by applying the specified type
- % constructor to the specified argument types. Aborts if the
- % length of `TypeArgs' is not the same as the arity of `TypeCtor'.
+ % Returns the type formed by applying the specified type constructor
+ % to the specified argument types. Aborts if the length of `TypeArgs'
+ % is not the same as the arity of `TypeCtor'.
%
:- func det_make_type(type_desc__type_ctor_desc, list(type_desc__type_desc)) =
type_desc__type_desc.
@@ -304,7 +300,7 @@
%-----------------------------------------------------------------------------%
- % Code for type manipulation.
+% Code for type manipulation.
pseudo_type_desc_is_ground(PseudoTypeDesc) :-
pseudo_type_ctor_and_args(PseudoTypeDesc, _TypeCtor, ArgPseudos),
@@ -402,10 +398,9 @@
TypeInfo = TypeInfo_for_T;
/*
- ** We used to collapse equivalences for efficiency here,
- ** but that's not always desirable, due to the reverse
- ** mode of make_type/2, and efficiency of type_infos
- ** probably isn't very important anyway.
+ ** We used to collapse equivalences for efficiency here, but that's not
+ ** always desirable, due to the reverse mode of make_type/2, and efficiency
+ ** of type_infos probably isn't very important anyway.
*/
#if 0
MR_save_transient_registers();
@@ -479,36 +474,35 @@
ArgTypes = [FuncRetType]
->
FuncRetTypeName = type_name(FuncRetType),
- string__append_list(
- ["((func) = ", FuncRetTypeName, ")"],
+ string__append_list(["((func) = ", FuncRetTypeName, ")"],
UnqualifiedTypeName)
;
type_arg_names(ArgTypes, IsFunc, ArgTypeNames),
- ( IsFunc = no ->
+ (
+ IsFunc = no,
list__append(ArgTypeNames, [")"], TypeStrings0)
;
+ IsFunc = yes,
TypeStrings0 = ArgTypeNames
),
TypeNameStrings = [Name, "(" | TypeStrings0],
- string__append_list(TypeNameStrings,
- UnqualifiedTypeName)
+ string__append_list(TypeNameStrings, UnqualifiedTypeName)
)
),
( ModuleName = "builtin" ->
TypeName = UnqualifiedTypeName
;
- string__append_list([ModuleName, ".",
- UnqualifiedTypeName], TypeName)
+ string__append_list([ModuleName, ".", UnqualifiedTypeName], TypeName)
).
- % Turn the types into a list of strings representing an argument
- % list, adding commas as separators as required. For example:
+ % Turn the types into a list of strings representing an argument list,
+ % adding commas as separators as required. For example:
% ["TypeName1", ",", "TypeName2"]
% If formatting a function type, we close the parentheses around
% the function's input parameters, e.g.
% ["TypeName1", ",", "TypeName2", ") = ", "ReturnTypeName"]
% It is the caller's reponsibility to add matching parentheses.
-
+ %
:- pred type_arg_names(list(type_desc__type_desc)::in, bool::in,
list(string)::out) is det.
@@ -582,8 +576,8 @@
} else {
type_ctor_info = MR_PSEUDO_TYPEINFO_GET_TYPE_CTOR_INFO(
pseudo_type_info);
- TypeCtor = (MR_Word) MR_make_type_ctor_desc_pseudo(
- pseudo_type_info, type_ctor_info);
+ TypeCtor = (MR_Word) MR_make_type_ctor_desc_pseudo(pseudo_type_info,
+ type_ctor_info);
SUCCESS_INDICATOR = MR_TRUE;
}
}").
@@ -620,8 +614,7 @@
while (type_list.data_tag == 1) {
((mercury.list.List_1.F_cons_2) type_list).F1 =
new mercury.type_desc.Type_desc_0(
- (TypeInfo_Struct)
- ((mercury.list.List_1.F_cons_2) type_list).F1);
+ (TypeInfo_Struct) ((mercury.list.List_1.F_cons_2) type_list).F1);
type_list = (mercury.list.List_1)
((mercury.list.List_1.F_cons_2) type_list).F2;
}
@@ -656,14 +649,10 @@
% The non-C backends can't (yet) handle pseudo_type_infos.
private_builtin__sorry("pseudo_type_ctor_and_args").
- /*
- ** This is the forwards mode of make_type/2:
- ** given a type constructor and a list of argument
- ** types, check that the length of the argument
- ** types matches the arity of the type constructor,
- ** and if so, use the type constructor to construct
- ** a new type with the specified arguments.
- */
+% This is the forwards mode of make_type/2: given a type constructor and
+% a list of argument types, check that the length of the argument types
+% matches the arity of the type constructor, and if so, use the type
+% constructor to construct a new type with the specified arguments.
:- pragma promise_pure(make_type/2).
:- pragma foreign_proc("C",
@@ -682,8 +671,7 @@
arity = MR_TYPECTOR_DESC_GET_VA_ARITY(type_ctor_desc);
} else {
type_ctor_info =
- MR_TYPECTOR_DESC_GET_FIXED_ARITY_TYPE_CTOR_INFO(
- type_ctor_desc);
+ MR_TYPECTOR_DESC_GET_FIXED_ARITY_TYPE_CTOR_INFO(type_ctor_desc);
arity = type_ctor_info->MR_type_ctor_arity;
}
@@ -696,8 +684,7 @@
SUCCESS_INDICATOR = MR_FALSE;
} else {
MR_save_transient_registers();
- TypeDesc = (MR_Word) MR_make_type(arity, type_ctor_desc,
- ArgTypes);
+ TypeDesc = (MR_Word) MR_make_type(arity, type_ctor_desc, ArgTypes);
MR_restore_transient_registers();
SUCCESS_INDICATOR = MR_TRUE;
}
@@ -744,8 +731,7 @@
MR_TypeCtorInfo type_ctor_info;
type_ctor_info =
- MR_TYPECTOR_DESC_GET_FIXED_ARITY_TYPE_CTOR_INFO(
- type_ctor_desc);
+ MR_TYPECTOR_DESC_GET_FIXED_ARITY_TYPE_CTOR_INFO(type_ctor_desc);
/*
** We cast away the const-ness of the module and type names,
@@ -783,12 +769,12 @@
%-----------------------------------------------------------------------------%
% This function returns the type_info for the builtin type "typeinfo"
- % itself. It is intended for use from C code, since Mercury code can
- % access this type_info easily enough even without this predicate.
+ % itself. It is intended for use from C code, since Mercury code can access
+ % this type_info easily enough even without this predicate.
%
% XXX This code relies on the type "type_desc:type_desc" being the
% same type as the builtin type "typeinfo".
-
+ %
:- func get_type_info_for_type_info = type_desc__type_desc.
:- pragma export(get_type_info_for_type_info = out,
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list