1% ----------------------------------------------------------------------
2% BEGIN LICENSE BLOCK
3% Version: CMPL 1.1
4%
5% The contents of this file are subject to the Cisco-style Mozilla Public
6% License Version 1.1 (the "License"); you may not use this file except
7% in compliance with the License.  You may obtain a copy of the License
8% at www.eclipse-clp.org/license.
9%
10% Software distributed under the License is distributed on an "AS IS"
11% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
12% the License for the specific language governing rights and limitations
13% under the License.
14%
15% The Original Code is  The ECLiPSe Constraint Logic Programming System.
16% The Initial Developer of the Original Code is  Cisco Systems, Inc.
17% Portions created by the Initial Developer are
18% Copyright (C) 1989-2006 Cisco Systems, Inc.  All Rights Reserved.
19%
20% Contributor(s): ECRC GmbH
21% Contributor(s): IC-Parc, Imperal College London
22%
23% END LICENSE BLOCK
24%
25% System:	ECLiPSe Constraint Logic Programming System
26% Version:	$Id: tconv.pl,v 1.3 2013/02/12 00:41:44 jschimpf Exp $
27% ----------------------------------------------------------------------
28
29/*
30 * SEPIA PROLOG SOURCE MODULE
31 *
32 * IDENTIFICATION:	tconv.pl, part of module(sepia_kernel)
33 *
34 * DESCRIPTION:
35 *
36 *
37 * CONTENTS:
38 *
39 */
40
41%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
42
43:- system.		% compiler directive to add the SYSTEM flag
44
45:- export
46	name/2,
47	get_var_info/3,
48	term_string/2.
49
50:- skipped term_string/2.
51
52%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
53
54
55name(Const, List) :-
56	var(Const),
57	!,
58	chk_nmbr_lst(List, name(Const, List)),
59	string_list(String, List),
60	(	number_string(Const,String) -> true
61	;	atom_string(Const,String)
62	).
63name(Const, List) :-
64	number(Const),
65	!,
66	number_string(Const, String),
67	string_list(String, List).
68name(Const, List) :-
69	atom(Const),
70	!,
71	atom_string(Const, String),
72	string_list(String, List).
73name(Const, List) :-
74	string(Const),
75	!,
76	string_list(Const, List).
77name(Const, List) :-
78	error(5, name(Const, List)).
79
80
81% The list must be finite and all elements instantiated to valid character codes
82
83chk_nmbr_lst(X, Goal) :-
84	var(X), !,
85	error(4, Goal).
86chk_nmbr_lst([], _) :- !.
87chk_nmbr_lst([H|T], Goal) :- !,
88	( integer(H) ->
89	    ( H < 0 -> error(6, Goal)
90	    ; H > 255 -> error(6, Goal)
91	    ; chk_nmbr_lst(T, Goal)
92	    )
93	; var(H) ->
94	    error(4, Goal)
95	;
96	    error(5, Goal)
97	).
98chk_nmbr_lst(_, Goal) :-
99	error(5, Goal).
100
101
102%
103% term_string(?Term, ?String)
104%
105
106term_string_body(T, S, Module) :- var(S), !,
107	open(string(""), write, Stream),
108	writeq_(Stream, T, Module),
109	stream_info_(Stream, 0, S),  % = get_stream_info(Stream,name,S)
110	close(Stream).
111term_string_body(T, S, Module) :- string(S), !,
112	( S \== "" ->
113	    open(string(S), read, Stream),
114	    (
115		read_(Stream, T0, Module),
116		read_token_(Stream, end_of_file, _, Module)
117	    ->
118		close(Stream),
119		T = T0
120	    ;
121		close(Stream),
122		error(7, term_string(T, S))
123	    )
124	;
125	    error(7, term_string(T, S))
126	).
127term_string_body(T, S, _Module) :-
128	error(5, term_string(T, S)).
129
130
131%
132% get_var_info(?Var, ?InfoName, ?Value)
133%
134
135get_var_info(Var, Info, Value) :-
136	not(atom(Value); var(Value)),
137	!,
138	error(5, get_var_info(Var, Info, Value)).
139get_var_info(Var, Info, Value) :-
140	do_get_var_info(Var, Info, Value).
141
142do_get_var_info(Var, Info, Value) :-
143	var(Info),
144	var_infos(Info),
145	do_get_var_info1(Var, Info, Value).
146do_get_var_info(Var, Info, Value) :-
147	atom(Info),
148	do_get_var_info1(Var, Info, Value).
149do_get_var_info(Var, Info, Value) :-
150	not(atom(Info); var(Info)),
151	error(5, get_var_info(Var, Info, Value)).
152
153do_get_var_info1(Var, name, Value) :-
154	!,
155	get_var_name(Var, Value).
156do_get_var_info1(Var, type, Value) :-
157	!,
158	get_var_type(Var, Value).
159do_get_var_info1(Var, Info, Value) :-
160	error(6, get_var_info(Var, Info, Value)).
161
162var_infos(type).
163var_infos(name).
164
165
166%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
167