1/************************************************************************* 2* * 3* YAP Prolog * 4* * 5* Yap Prolog was developed at NCCUP - Universidade do Porto * 6* * 7* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * 8* * 9************************************************************************** 10* * 11* File: chtypes.yap * 12* Last rev: 8/2/88 * 13* mods: * 14* comments: implementation of SWI's code_type/2 * 15* * 16*************************************************************************/ 17 18/* 19 20In addition, there is the library library(ctype) providing compatibility to some other Prolog systems. The predicates of this library are defined in terms of code_type/2. 21 22char_type(?Char, ?Type) 23 Tests or generates alternative Types or Chars. The character-types are inspired by the standard C <ctype.h> primitives. 24 25 alnum 26 Char is a letter (upper- or lowercase) or digit. 27 28 alpha 29 Char is a letter (upper- or lowercase). 30 31 csym 32 Char is a letter (upper- or lowercase), digit or the underscore (_). These are valid C- and Prolog symbol characters. 33 34 csymf 35 Char is a letter (upper- or lowercase) or the underscore (_). These are valid first characters for C- and Prolog symbols 36 37 ascii 38 Char is a 7-bits ASCII character (0..127). 39 40 white 41 Char is a space or tab. E.i. white space inside a line. 42 43 cntrl 44 Char is an ASCII control-character (0..31). 45 46 digit 47 Char is a digit. 48 49 digit(Weigth) 50 Char is a digit with value Weigth. I.e. char_type(X, digit(6) yields X = '6'. Useful for parsing numbers. 51 52 xdigit(Weigth) 53 Char is a haxe-decimal digit with value Weigth. I.e. char_type(a, xdigit(X) yields X = '10'. Useful for parsing numbers. 54 55 graph 56 Char produces a visible mark on a page when printed. Note that the space is not included! 57 58 lower 59 Char is a lower-case letter. 60 61 lower(Upper) 62 Char is a lower-case version of Upper. Only true if Char is lowercase and Upper uppercase. 63 64 to_lower(Upper) 65 Char is a lower-case version of Upper. For non-letters, or letter without case, Char and Lower are the same. See also upcase_atom/2 and downcase_atom/2. 66 67 upper 68 Char is an upper-case letter. 69 70 upper(Lower) 71 Char is an upper-case version of Lower. Only true if Char is uppercase and Lower lowercase. 72 73 to_upper(Lower) 74 Char is an upper-case version of Lower. For non-letters, or letter without case, Char and Lower are the same. See also upcase_atom/2 and downcase_atom/2. 75 76 punct 77 Char is a punctuation character. This is a graph character that is not a letter or digit. 78 79 space 80 Char is some form of layout character (tab, vertical-tab, newline, etc.). 81 82 end_of_file 83 Char is -1. 84 85 end_of_line 86 Char ends a line (ASCII: 10..13). 87 88 newline 89 Char is a the newline character (10). 90 91 period 92 Char counts as the end of a sentence (.,!,?). 93 94 quote 95 Char is a quote-character (", ', `). 96 97 paren(Close) 98 Char is an open-parenthesis and Close is the corresponding close-parenthesis. 99 100code_type(?Code, ?Type) 101 As char_type/2, but uses character-codes rather than one-character atoms. Please note that both predicates are as flexible as possible. They handle either representation if the argument is instantiated and only will instantiate with an integer code or one-character atom depending of the version used. See also the prolog-flag double_quotes, atom_chars/2 and atom_codes/2. 102 103*/ 104 105char_type(A, Spec) :- 106 var(A), !, 107 (ground(Spec), 108 '$handle_special_char_type'(Code, Spec) 109 -> 110 true 111 ; 112 '$char_spec_code_from_spec'(Spec, SpecCode), 113 '$code_enum'(Code, SpecCode), 114 '$spec_code_to_char'(SpecCode, Spec) 115 ), 116 atom_codes(A,[Code]). 117char_type(A, Spec) :- 118 atom(A), !, 119 atom_codes(A,[Code]), 120 '$code_type'(Code, SpecCode), 121 '$spec_code_to_char'(SpecCode, Spec). 122char_type(Code, Spec) :- 123 number(Code), !, 124 '$code_type'(Code, SpecCode), 125 '$spec_code_to_char'(SpecCode, Spec). 126char_type(Code, Spec) :- 127 '$do_error'(type_error(character,Code),char_type(Code, Spec)). 128 129'$char_spec_code_from_spec'(Spec, Spec) :- atom(Spec), !. 130'$char_spec_code_from_spec'(digit(Weight), digit(Weight)). 131'$char_spec_code_from_spec'(xdigit(Weight), xdigit(Weight)). 132'$char_spec_code_from_spec'(lower(Upper), lower(_)). 133'$char_spec_code_from_spec'(to_lower(Upper), to_lower(_)). 134'$char_spec_code_from_spec'(upper(Upper), upper(_)). 135'$char_spec_code_from_spec'(to_upper(Upper), to_upper(_)). 136 137code_type(Code, Spec) :- 138 var(Code), !, 139 (ground(Spec), 140 '$handle_special_char_type'(Code, Spec) 141 -> 142 true 143 ; 144 '$code_enum'(Code, Spec) 145 ). 146code_type(A, Spec) :- 147 atom(A), !, 148 atom_codes(A,[Code]), 149 '$code_type'(Code, Spec). 150code_type(Code, Spec) :- 151 number(Code), !, 152 '$code_type'(Code, Spec). 153code_type(Code, Spec) :- 154 '$do_error'(type_error(character,Code),char_type(Code, Spec)). 155 156'$code_enum'(Code, Spec) :- 157 '$for'(0, 256, Code), 158 '$code_type'(Code, Spec). 159 160'$for'(Min, Max, Min). 161'$for'(Min, Max, I) :- 162 Min < Max, 163 Min1 is Min+1, 164 '$for'(Min1, Max, I). 165 166 167'$code_type'(Code, Spec) :- 168 '$type_of_char'(Code, TypeCode), 169 '$code_type_name'(TypeCode, Type), 170 '$type_code'(Type, Code, Spec). 171 172'$code_type_name'( 1,uc). /* Upper case */ 173'$code_type_name'( 2,ul). /* Underline */ 174'$code_type_name'( 3,lc). /* Lower case */ 175'$code_type_name'( 4,nu). /* digit */ 176'$code_type_name'( 5,qt). /* single quote */ 177'$code_type_name'( 6,dc). /* double quote */ 178'$code_type_name'( 7,sy). /* Symbol character */ 179'$code_type_name'( 8,sl). /* Solo character */ 180'$code_type_name'( 9,bk). /* Brackets & friends */ 181'$code_type_name'(10,bs). /* Blank */ 182'$code_type_name'(11,ef). /* End of File marker */ 183'$code_type_name'(12,cc). /* comment char % */ 184 185'$spec_code_to_char'(lower(Code), lower(Char)) :- !, 186 atom_codes(Char, [Code]). 187'$spec_code_to_char'(to_lower(Code), to_lower(Char)) :- !, 188 atom_codes(Char, [Code]). 189'$spec_code_to_char'(upper(Code), upper(Char)) :- !, 190 atom_codes(Char, [Code]). 191'$spec_code_to_char'(to_upper(Code), to_upper(Char)) :- !, 192 atom_codes(Char, [Code]). 193'$spec_code_to_char'(Spec, Spec). 194 195 196'$type_code'(Type, _, alnum) :- 197 '$type_code_alnum'(Type). 198'$type_code'(Type, _, alpha) :- 199 '$type_code_alpha'(Type). 200'$type_code'(Type, _, csym) :- 201 '$type_code_csym'(Type). 202'$type_code'(Type, _, csymf) :- 203 '$type_code_csymf'(Type). 204'$type_code'(_, Code, ascii) :- 205 '$type_code_ascii'(Code). 206'$type_code'(_, Code, white) :- 207 '$type_code_white'(Code). 208'$type_code'(_, Code, cntrl) :- 209 '$type_code_cntrl'(Code). 210'$type_code'(Type, _, digit) :- 211 '$type_code_digit'(Type). 212'$type_code'(_, Code, digit(Weight)) :- 213 '$type_code_digit'(Code, Weight). 214'$type_code'(_, Code, xdigit(Weight)) :- 215 '$type_code_xdigit'(Code, Weight). 216'$type_code'(Type, _, graph) :- 217 '$type_code_graph'(Type). 218'$type_code'(Type, _, lower) :- 219 '$type_code_lower'(Type). 220'$type_code'(Type, Code, lower(UpCode)) :- 221 '$type_code_lower'(Type, Code, UpCode). 222'$type_code'(Type, Code, to_lower(UpCode)) :- 223 '$type_code_to_lower'(Type,Code,UpCode). 224'$type_code'(Type, _, upper) :- 225 '$type_code_upper'(Type). 226'$type_code'(Type, Code, upper(UpCode)) :- 227 '$type_code_upper'(Type,Code,UpCode). 228'$type_code'(Type, Code, to_upper(UpCode)) :- 229 '$type_code_to_upper'(Type,Code,UpCode). 230'$type_code'(Type, _, punct) :- 231 '$type_code_punct'(Type). 232'$type_code'(Type, _, space) :- 233 '$type_code_space'(Type). 234'$type_code'(Type, _, end_of_file) :- 235 '$type_code_end_of_file'(Type). 236'$type_code'(_, Code, end_of_line) :- 237 '$type_code_end_of_line'(Code). 238'$type_code'(_, Code, newline) :- 239 '$type_code_newline'(Code). 240'$type_code'(_, Code, period) :- 241 '$type_code_period'(Code). 242'$type_code'(_, Code, quote) :- 243 '$type_code_quote'(Code). 244 245 246'$type_code_alnum'(uc). 247'$type_code_alnum'(lc). 248'$type_code_alnum'(nu). 249 250'$type_code_alpha'(uc). 251'$type_code_alpha'(lc). 252 253'$type_code_csym'(uc). 254'$type_code_csym'(ul). 255'$type_code_csym'(lc). 256'$type_code_csym'(nu). 257 258'$type_code_csymf'(uc). 259'$type_code_csymf'(ul). 260'$type_code_csymf'(lc). 261 262'$type_code_ascii'(Cod) :- Cod < 128. 263 264'$type_code_white'(0' ). 265'$type_code_white'(0' ). 266 267'$type_code_cntrl'(C) :- C < 32. 268 269'$type_code_digit'(nu). 270 271'$type_code_digit'(0'0, 0). 272'$type_code_digit'(0'1, 1). 273'$type_code_digit'(0'2, 2). 274'$type_code_digit'(0'3, 3). 275'$type_code_digit'(0'4, 4). 276'$type_code_digit'(0'5, 5). 277'$type_code_digit'(0'6, 6). 278'$type_code_digit'(0'7, 7). 279'$type_code_digit'(0'8, 8). 280'$type_code_digit'(0'9, 9). 281 282'$type_code_xdigit'(0'0, 0). 283'$type_code_xdigit'(0'1, 1). 284'$type_code_xdigit'(0'2, 2). 285'$type_code_xdigit'(0'3, 3). 286'$type_code_xdigit'(0'4, 4). 287'$type_code_xdigit'(0'5, 5). 288'$type_code_xdigit'(0'6, 6). 289'$type_code_xdigit'(0'7, 7). 290'$type_code_xdigit'(0'8, 8). 291'$type_code_xdigit'(0'9, 9). 292'$type_code_xdigit'(0'a, 10). 293'$type_code_xdigit'(0'A, 10). 294'$type_code_xdigit'(0'b, 11). 295'$type_code_xdigit'(0'B, 11). 296'$type_code_xdigit'(0'c, 12). 297'$type_code_xdigit'(0'C, 12). 298'$type_code_xdigit'(0'd, 13). 299'$type_code_xdigit'(0'D, 13). 300'$type_code_xdigit'(0'e, 14). 301'$type_code_xdigit'(0'E, 14). 302'$type_code_xdigit'(0'f, 15). 303'$type_code_xdigit'(0'F, 15). 304 305'$type_code_graph'(uc). 306'$type_code_graph'(ul). 307'$type_code_graph'(lc). 308'$type_code_graph'(nu). 309'$type_code_graph'(qt). 310'$type_code_graph'(dc). 311'$type_code_graph'(sy). 312'$type_code_graph'(sl). 313'$type_code_graph'(bk). 314'$type_code_graph'(cc). 315 316'$type_code_lower'(lc). 317 318'$type_code_lower'(lc, Code, Upcode) :- 319 '$toupper'(Code, Upcode). 320 321'$type_code_to_lower'(uc, C, C). 322'$type_code_to_lower'(ul, C, C). 323'$type_code_to_lower'(lc, Code, Upcode) :- 324 '$toupper'(Code, Upcode). 325'$type_code_to_lower'(nu, C, C). 326'$type_code_to_lower'(qt, C, C). 327'$type_code_to_lower'(dc, C, C). 328'$type_code_to_lower'(sy, C, C). 329'$type_code_to_lower'(sl, C, C). 330'$type_code_to_lower'(bk, C, C). 331'$type_code_to_lower'(bs, C, C). 332'$type_code_to_lower'(ef, C, C). 333'$type_code_to_lower'(cc, C, C). 334 335'$type_code_upper'(uc). 336 337'$type_code_upper'(uc, Code, Upcode) :- 338 '$tolower'(Code, Upcode). 339 340'$type_code_to_upper'(uc, Code, Upcode) :- 341 '$tolower'(Code, Upcode). 342'$type_code_to_upper'(ul, C, C). 343'$type_code_to_upper'(lc, C, C). 344'$type_code_to_upper'(nu, C, C). 345'$type_code_to_upper'(qt, C, C). 346'$type_code_to_upper'(dc, C, C). 347'$type_code_to_upper'(sy, C, C). 348'$type_code_to_upper'(sl, C, C). 349'$type_code_to_upper'(bk, C, C). 350'$type_code_to_upper'(bs, C, C). 351'$type_code_to_upper'(ef, C, C). 352'$type_code_to_upper'(cc, C, C). 353 354'$type_code_punct'(ul). 355'$type_code_punct'(qt). 356'$type_code_punct'(dc). 357'$type_code_punct'(sy). 358'$type_code_punct'(sl). 359'$type_code_punct'(bk). 360'$type_code_punct'(cc). 361 362'$type_code_space'(bs). 363 364'$type_code_end_of_file'(ef). 365 366'$type_code_end_of_line'(10). 367'$type_code_end_of_line'(11). 368'$type_code_end_of_line'(12). 369'$type_code_end_of_line'(13). 370 371'$type_code_newline'(10). 372 373'$type_code_period'( 0). 374'$type_code_period'(0'!). 375'$type_code_period'(0'.). 376'$type_code_period'(0'?). 377 378'$type_code_quote'( 0). %' 379'$type_code_quote'(0'"). 380'$type_code_quote'(0''). 381'$type_code_quote'(0'`). 382 383'$type_code_paren'(0'{, 0'}). 384'$type_code_paren'(0'[, 0']). 385'$type_code_paren'(0'(, 0'(). %' 386 387'$handle_special_char_type'(Spec, digit(N)) :- 388 integer(N), 389 N >= 0, 390 N =< 9, 391 Spec is "0"+N. 392'$handle_special_char_type'(Spec, xdigit(N)) :- 393 integer(N), 394 N >= 0, 395 ( 396 N =< 9 397 -> 398 Spec is "0"+N 399 ; 400 N =< 15 401 -> 402 Spec is "a"+(N-10) 403 ). 404'$handle_special_char_type'(Spec, lower(Upper)) :- 405 Upper >= "A", 406 Upper =< "Z", 407 Spec is Upper + ("a"-"A"). 408'$handle_special_char_type'(Spec, to_lower(Upper)) :- 409 ( Upper >= "A", 410 Upper =< "Z" 411 -> 412 Spec is Upper + ("a"-"A") 413 ; 414 Spec = Upper 415 ). 416'$handle_special_char_type'(Spec, upper(Lower)) :- 417 Lower >= "a", 418 Lower =< "z", 419 Spec is Lower + ("A"-"a"). 420'$handle_special_char_type'(Spec, to_upper(Lower)) :- 421 ( Lower >= "a", 422 Lower =< "z" 423 -> 424 Spec is Lower + ("A"-"a") 425 ; 426 Spec = Lower 427 ). 428 429 430downcase_atom(U, D) :- 431 atom_codes(U, Codes), 432 '$downcase_codes'(Codes, DCodes), 433 atom_codes(D, DCodes). 434 435'$downcase_codes'([], []). 436'$downcase_codes'(C.Codes, D.DCodes) :- 437 code_type(D, to_lower(C)), 438 '$downcase_codes'(Codes, DCodes). 439 440upcase_atom(U, D) :- 441 atom_codes(U, Codes), 442 '$upcase_codes'(Codes, DCodes), 443 atom_codes(D, DCodes). 444 445'$upcase_codes'([], []). 446'$upcase_codes'(C.Codes, D.DCodes) :- 447 code_type(D, to_upper(C)), 448 '$upcase_codes'(Codes, DCodes). 449