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