From b041ae00c2902aed80c7184ca349e689014fb9d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Fri, 11 Feb 2011 19:00:59 +0000 Subject: [PATCH] use SWI code for char_type and friends. --- pl/chtypes.yap | 340 +------------------------------------------------ 1 file changed, 4 insertions(+), 336 deletions(-) diff --git a/pl/chtypes.yap b/pl/chtypes.yap index c22e63e23..109565525 100644 --- a/pl/chtypes.yap +++ b/pl/chtypes.yap @@ -103,346 +103,14 @@ code_type(?Code, ?Type) */ char_type(A, Spec) :- - var(A), !, - (ground(Spec), - '$handle_special_char_type'(Code, Spec) - -> - true - ; - '$char_spec_code_from_spec'(Spec, SpecCode), - '$code_enum'(Code, SpecCode), - '$spec_code_to_char'(SpecCode, Spec) - ), - atom_codes(A,[Code]). -char_type(A, Spec) :- - atom(A), !, - atom_codes(A,[Code]), - '$code_type'(Code, SpecCode), - '$spec_code_to_char'(SpecCode, Spec). -char_type(Code, Spec) :- - number(Code), !, - '$code_type'(Code, SpecCode), - '$spec_code_to_char'(SpecCode, Spec). -char_type(Code, Spec) :- - '$do_error'(type_error(character,Code),char_type(Code, Spec)). - -'$char_spec_code_from_spec'(Spec, Spec) :- atom(Spec), !. -'$char_spec_code_from_spec'(digit(Weight), digit(Weight)). -'$char_spec_code_from_spec'(xdigit(Weight), xdigit(Weight)). -'$char_spec_code_from_spec'(lower(Upper), lower(_)). -'$char_spec_code_from_spec'(to_lower(Upper), to_lower(_)). -'$char_spec_code_from_spec'(upper(Upper), upper(_)). -'$char_spec_code_from_spec'(to_upper(Upper), to_upper(_)). + swi_char_type(A, Spec). code_type(Code, Spec) :- - var(Code), !, - (ground(Spec), - '$handle_special_char_type'(Code, Spec) - -> - true - ; - '$code_enum'(Code, Spec) - ). -code_type(A, Spec) :- - atom(A), !, - atom_codes(A,[Code]), - '$code_type'(Code, Spec). -code_type(Code, Spec) :- - number(Code), !, - '$code_type'(Code, Spec). -code_type(Code, Spec) :- - '$do_error'(type_error(character,Code),char_type(Code, Spec)). - -'$code_enum'(Code, Spec) :- - '$for'(0, 256, Code), - '$code_type'(Code, Spec). - -'$for'(Min, Max, Min). -'$for'(Min, Max, I) :- - Min < Max, - Min1 is Min+1, - '$for'(Min1, Max, I). - - -'$code_type'(Code, Spec) :- - '$type_of_char'(Code, TypeCode), - '$code_type_name'(TypeCode, Type), - '$type_code'(Type, Code, Spec). - -'$code_type_name'( 1,uc). /* Upper case */ -'$code_type_name'( 2,ul). /* Underline */ -'$code_type_name'( 3,lc). /* Lower case */ -'$code_type_name'( 4,nu). /* digit */ -'$code_type_name'( 5,qt). /* single quote */ -'$code_type_name'( 6,dc). /* double quote */ -'$code_type_name'( 7,sy). /* Symbol character */ -'$code_type_name'( 8,sl). /* Solo character */ -'$code_type_name'( 9,bk). /* Brackets & friends */ -'$code_type_name'(10,bs). /* Blank */ -'$code_type_name'(11,ef). /* End of File marker */ -'$code_type_name'(12,cc). /* comment char % */ - -'$spec_code_to_char'(lower(Code), lower(Char)) :- !, - atom_codes(Char, [Code]). -'$spec_code_to_char'(to_lower(Code), to_lower(Char)) :- !, - atom_codes(Char, [Code]). -'$spec_code_to_char'(upper(Code), upper(Char)) :- !, - atom_codes(Char, [Code]). -'$spec_code_to_char'(to_upper(Code), to_upper(Char)) :- !, - atom_codes(Char, [Code]). -'$spec_code_to_char'(Spec, Spec). - - -'$type_code'(Type, _, alnum) :- - '$type_code_alnum'(Type). -'$type_code'(Type, _, alpha) :- - '$type_code_alpha'(Type). -'$type_code'(Type, _, csym) :- - '$type_code_csym'(Type). -'$type_code'(Type, _, csymf) :- - '$type_code_csymf'(Type). -'$type_code'(_, Code, ascii) :- - '$type_code_ascii'(Code). -'$type_code'(_, Code, white) :- - '$type_code_white'(Code). -'$type_code'(_, Code, cntrl) :- - '$type_code_cntrl'(Code). -'$type_code'(Type, _, digit) :- - '$type_code_digit'(Type). -'$type_code'(_, Code, digit(Weight)) :- - '$type_code_digit'(Code, Weight). -'$type_code'(_, Code, xdigit(Weight)) :- - '$type_code_xdigit'(Code, Weight). -'$type_code'(Type, _, graph) :- - '$type_code_graph'(Type). -'$type_code'(Type, _, lower) :- - '$type_code_lower'(Type). -'$type_code'(Type, Code, lower(UpCode)) :- - '$type_code_lower'(Type, Code, UpCode). -'$type_code'(Type, Code, to_lower(UpCode)) :- - '$type_code_to_lower'(Type,Code,UpCode). -'$type_code'(Type, _, upper) :- - '$type_code_upper'(Type). -'$type_code'(Type, Code, upper(UpCode)) :- - '$type_code_upper'(Type,Code,UpCode). -'$type_code'(Type, Code, to_upper(UpCode)) :- - '$type_code_to_upper'(Type,Code,UpCode). -'$type_code'(Type, _, punct) :- - '$type_code_punct'(Type). -'$type_code'(Type, _, space) :- - '$type_code_space'(Type). -'$type_code'(Type, _, end_of_file) :- - '$type_code_end_of_file'(Type). -'$type_code'(_, Code, end_of_line) :- - '$type_code_end_of_line'(Code). -'$type_code'(_, Code, newline) :- - '$type_code_newline'(Code). -'$type_code'(_, Code, period) :- - '$type_code_period'(Code). -'$type_code'(_, Code, quote) :- - '$type_code_quote'(Code). - - -'$type_code_alnum'(uc). -'$type_code_alnum'(lc). -'$type_code_alnum'(nu). - -'$type_code_alpha'(uc). -'$type_code_alpha'(lc). - -'$type_code_csym'(uc). -'$type_code_csym'(ul). -'$type_code_csym'(lc). -'$type_code_csym'(nu). - -'$type_code_csymf'(uc). -'$type_code_csymf'(ul). -'$type_code_csymf'(lc). - -'$type_code_ascii'(Cod) :- Cod < 128. - -'$type_code_white'(0' ). -'$type_code_white'(0' ). - -'$type_code_cntrl'(C) :- C < 32. - -'$type_code_digit'(nu). - -'$type_code_digit'(0'0, 0). -'$type_code_digit'(0'1, 1). -'$type_code_digit'(0'2, 2). -'$type_code_digit'(0'3, 3). -'$type_code_digit'(0'4, 4). -'$type_code_digit'(0'5, 5). -'$type_code_digit'(0'6, 6). -'$type_code_digit'(0'7, 7). -'$type_code_digit'(0'8, 8). -'$type_code_digit'(0'9, 9). - -'$type_code_xdigit'(0'0, 0). -'$type_code_xdigit'(0'1, 1). -'$type_code_xdigit'(0'2, 2). -'$type_code_xdigit'(0'3, 3). -'$type_code_xdigit'(0'4, 4). -'$type_code_xdigit'(0'5, 5). -'$type_code_xdigit'(0'6, 6). -'$type_code_xdigit'(0'7, 7). -'$type_code_xdigit'(0'8, 8). -'$type_code_xdigit'(0'9, 9). -'$type_code_xdigit'(0'a, 10). -'$type_code_xdigit'(0'A, 10). -'$type_code_xdigit'(0'b, 11). -'$type_code_xdigit'(0'B, 11). -'$type_code_xdigit'(0'c, 12). -'$type_code_xdigit'(0'C, 12). -'$type_code_xdigit'(0'd, 13). -'$type_code_xdigit'(0'D, 13). -'$type_code_xdigit'(0'e, 14). -'$type_code_xdigit'(0'E, 14). -'$type_code_xdigit'(0'f, 15). -'$type_code_xdigit'(0'F, 15). - -'$type_code_graph'(uc). -'$type_code_graph'(ul). -'$type_code_graph'(lc). -'$type_code_graph'(nu). -'$type_code_graph'(qt). -'$type_code_graph'(dc). -'$type_code_graph'(sy). -'$type_code_graph'(sl). -'$type_code_graph'(bk). -'$type_code_graph'(cc). - -'$type_code_lower'(lc). - -'$type_code_lower'(lc, Code, Upcode) :- - '$toupper'(Code, Upcode). - -'$type_code_to_lower'(uc, C, C). -'$type_code_to_lower'(ul, C, C). -'$type_code_to_lower'(lc, Code, Upcode) :- - '$toupper'(Code, Upcode). -'$type_code_to_lower'(nu, C, C). -'$type_code_to_lower'(qt, C, C). -'$type_code_to_lower'(dc, C, C). -'$type_code_to_lower'(sy, C, C). -'$type_code_to_lower'(sl, C, C). -'$type_code_to_lower'(bk, C, C). -'$type_code_to_lower'(bs, C, C). -'$type_code_to_lower'(ef, C, C). -'$type_code_to_lower'(cc, C, C). - -'$type_code_upper'(uc). - -'$type_code_upper'(uc, Code, Upcode) :- - '$tolower'(Code, Upcode). - -'$type_code_to_upper'(uc, Code, Upcode) :- - '$tolower'(Code, Upcode). -'$type_code_to_upper'(ul, C, C). -'$type_code_to_upper'(lc, C, C). -'$type_code_to_upper'(nu, C, C). -'$type_code_to_upper'(qt, C, C). -'$type_code_to_upper'(dc, C, C). -'$type_code_to_upper'(sy, C, C). -'$type_code_to_upper'(sl, C, C). -'$type_code_to_upper'(bk, C, C). -'$type_code_to_upper'(bs, C, C). -'$type_code_to_upper'(ef, C, C). -'$type_code_to_upper'(cc, C, C). - -'$type_code_punct'(ul). -'$type_code_punct'(qt). -'$type_code_punct'(dc). -'$type_code_punct'(sy). -'$type_code_punct'(sl). -'$type_code_punct'(bk). -'$type_code_punct'(cc). - -'$type_code_space'(bs). - -'$type_code_end_of_file'(ef). - -'$type_code_end_of_line'(10). -'$type_code_end_of_line'(11). -'$type_code_end_of_line'(12). -'$type_code_end_of_line'(13). - -'$type_code_newline'(10). - -'$type_code_period'( 0). -'$type_code_period'(0'!). -'$type_code_period'(0'.). -'$type_code_period'(0'?). - -'$type_code_quote'( 0). %' -'$type_code_quote'(0'"). -'$type_code_quote'(0''). -'$type_code_quote'(0'`). - -'$type_code_paren'(0'{, 0'}). -'$type_code_paren'(0'[, 0']). -'$type_code_paren'(0'(, 0'(). %' - -'$handle_special_char_type'(Spec, digit(N)) :- - integer(N), - N >= 0, - N =< 9, - Spec is "0"+N. -'$handle_special_char_type'(Spec, xdigit(N)) :- - integer(N), - N >= 0, - ( - N =< 9 - -> - Spec is "0"+N - ; - N =< 15 - -> - Spec is "a"+(N-10) - ). -'$handle_special_char_type'(Spec, lower(Upper)) :- - Upper >= "A", - Upper =< "Z", - Spec is Upper + ("a"-"A"). -'$handle_special_char_type'(Spec, to_lower(Upper)) :- - ( Upper >= "A", - Upper =< "Z" - -> - Spec is Upper + ("a"-"A") - ; - Spec = Upper - ). -'$handle_special_char_type'(Spec, upper(Lower)) :- - Lower >= "a", - Lower =< "z", - Spec is Lower + ("A"-"a"). -'$handle_special_char_type'(Spec, to_upper(Lower)) :- - ( Lower >= "a", - Lower =< "z" - -> - Spec is Lower + ("A"-"a") - ; - Spec = Lower - ). + swi_code_type(A, Spec). downcase_atom(U, D) :- - atom_codes(U, Codes), - '$downcase_codes'(Codes, DCodes), - atom_codes(D, DCodes). - -'$downcase_codes'([], []). -'$downcase_codes'(C.Codes, D.DCodes) :- - code_type(D, to_lower(C)), - '$downcase_codes'(Codes, DCodes). + swi_downcase_atom(U, D). upcase_atom(U, D) :- - atom_codes(U, Codes), - '$upcase_codes'(Codes, DCodes), - atom_codes(D, DCodes). - -'$upcase_codes'([], []). -'$upcase_codes'(C.Codes, D.DCodes) :- - code_type(D, to_upper(C)), - '$upcase_codes'(Codes, DCodes). + swi_upcase_atom(U, D).