From: notoria Date: Wed, 22 Apr 2020 18:44:10 +0000 (+0200) Subject: Implementation of the predicate char_type for a subset X-Git-Tag: v0.8.123~111^2 X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=4b506086422d5a19bccfa7f1900a899814c7226c;p=scryer-prolog.git Implementation of the predicate char_type for a subset --- diff --git a/src/prolog/lib/charsio.pl b/src/prolog/lib/charsio.pl index 0281e832..e09c2185 100644 --- a/src/prolog/lib/charsio.pl +++ b/src/prolog/lib/charsio.pl @@ -57,10 +57,36 @@ extend_var_list_([V|Vs], N, VarList, NewVarList, VarType) :- ). -char_type(C, T) :- - ( var(C) -> throw(error(instantiation_error, char_type/2)) - ; atom_length(C, 1) -> '$char_type'(C, T) - ; throw(error(type_error(in_character, C), char_type/2)) +char_type(Char, Type) :- + ( var(Char) -> throw(error(instantiation_error, char_type/2)) + ; atom_length(Char, 1) -> + ( ground(Type) -> '$char_type'(Char, Type) + ; Type = symbolic_control, '$char_type'(Char, Type) + ; Type = layout, '$char_type'(Char, Type) + ; Type = symbolic_hexadecimal, Char = x + ; Type = octal_digit, '$char_type'(Char, Type) + ; Type = binary_digit, '$char_type'(Char, Type) + ; Type = hexadecimal_digit, '$char_type'(Char, Type) + ; Type = exponent, '$char_type'(Char, Type) + ; Type = sign, '$char_type'(Char, Type) + ; Type = upper, '$char_type'(Char, Type) + ; Type = lower, '$char_type'(Char, Type) + ; Type = graphic, '$char_type'(Char, Type) + ; Type = alpha, '$char_type'(Char, Type) + ; Type = decimal_digit, '$char_type'(Char, Type) + ; Type = alnum, '$char_type'(Char, Type) + ; Type = meta, '$char_type'(Char, Type) + ; Type = solo, '$char_type'(Char, Type) + ; Type = prolog, '$char_type'(Char, Type) + ; Type = alphabetic, '$char_type'(Char, Type) + ; Type = whitespace, '$char_type'(Char, Type) + ; Type = control, '$char_type'(Char, Type) + ; Type = numeric, '$char_type'(Char, Type) + ; Type = ascii, '$char_type'(Char, Type) + ; Type = ascii_punctuation, '$char_type'(Char, Type) + ; Type = ascii_graphic, '$char_type'(Char, Type) + ) + ; throw(error(type_error(in_character, Char), char_type/2)) ). diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index e07c9eb7..fe88f062 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -1353,54 +1353,79 @@ impl MachineState { } _ => unreachable!() }; - macro_rules! call { + let chars = match a2 { + Addr::Con(h) if self.heap.atom_at(h) => { + if let HeapCellValue::Atom(name, _) = &self.heap[h] { + name.as_str().to_string() + } + else { + unreachable!() + } + } + Addr::Char(c) => { + c.to_string() + } + _ => unreachable!() + }; + self.fail = true; // This predicate fails by default. + macro_rules! macro_check { ($id:ident, $name:tt) => { - if $id!(c) { - // let string = $name; - // let chars = - // clause_name!(string.to_string(), indices.atom_tbl); - // let atom = self - // .heap - // .to_unifiable(HeapCellValue::Atom(chars, None)); - let atom = self.heap.to_unifiable( - HeapCellValue::Atom(clause_name!($name.to_string(), indices.atom_tbl), None) - ); + if $id!(c) && chars == $name { + self.fail = false; - self.unify(atom, a2); - } - } - } - call!(symbolic_control_char, "symbolic_control"); - call!(space_char, "space"); - call!(layout_char, "layout"); - call!(symbolic_hexadecimal_char, "symbolic_hexadecimal"); - call!(octal_digit_char, "octal_digit"); - call!(binary_digit_char, "binary_digit"); - call!(hexadecimal_digit_char, "hexadecimal_digit"); - call!(exponent_char, "exponent"); - call!(sign_char, "sign"); - //call!(new_line_char, "new_line"); - //call!(comment_1_char, "comment_1"); - //call!(comment_2_char, "comment_2"); - //call!(capital_letter_char, "upper"); - //call!(small_letter_char, "lower"); - //call!(variable_indicator_char, "variable_indicator"); - //call!(graphic_char, "graphic"); - //call!(graphic_token_char, "graphic_token"); - //call!(alpha_char, "alpha"); - //call!(decimal_digit_char, "decimal_digit"); - //call!(decimal_point_char, "decimal_point"); - call!(alpha_numeric_char, "alnum"); - //call!(cut_char, "cut"); - //call!(semicolon_char, "semicolon"); - //call!(backslash_char, "backslash"); - //call!(single_quote_char, "single_quote"); - //call!(double_quote_char, "double_quote"); - //call!(back_quote_char, "back_quote"); - //call!(meta_char, "meta"); - //call!(solo_char, "solo"); - //call!(prolog_char, "prolog"); - //self.fail = true; + return return_from_clause!(self.last_call, self); + } + } + } + macro_rules! method_check { + ($id:ident, $name:tt) => { + if c.$id() && chars == $name { + self.fail = false; + + return return_from_clause!(self.last_call, self); + } + } + } + macro_check!(symbolic_control_char, "symbolic_control"); + // macro_check!(space_char, "space"); + macro_check!(layout_char, "layout"); + macro_check!(symbolic_hexadecimal_char, "symbolic_hexadecimal"); + macro_check!(octal_digit_char, "octal_digit"); + macro_check!(binary_digit_char, "binary_digit"); + macro_check!(hexadecimal_digit_char, "hexadecimal_digit"); + macro_check!(exponent_char, "exponent"); + macro_check!(sign_char, "sign"); + // macro_check!(new_line_char, "new_line"); + // macro_check!(comment_1_char, "comment_1"); + // macro_check!(comment_2_char, "comment_2"); + // macro_check!(capital_letter_char, "upper"); + // macro_check!(small_letter_char, "lower"); + // macro_check!(variable_indicator_char, "variable_indicator"); + macro_check!(graphic_char, "graphic"); + macro_check!(graphic_token_char, "graphic_token"); + macro_check!(alpha_char, "alpha"); + macro_check!(decimal_digit_char, "decimal_digit"); + // macro_check!(decimal_point_char, "decimal_point"); + // macro_check!(alpha_numeric_char, "alnum"); + // macro_check!(cut_char, "cut"); + // macro_check!(semicolon_char, "semicolon"); + // macro_check!(backslash_char, "backslash"); + // macro_check!(single_quote_char, "single_quote"); + // macro_check!(double_quote_char, "double_quote"); + // macro_check!(back_quote_char, "back_quote"); + macro_check!(meta_char, "meta"); + macro_check!(solo_char, "solo"); + macro_check!(prolog_char, "prolog"); + method_check!(is_alphabetic, "alphabetic"); + method_check!(is_lowercase, "lower"); + method_check!(is_uppercase, "upper"); + method_check!(is_whitespace, "whitespace"); + method_check!(is_alphanumeric, "alnum"); + method_check!(is_control, "control"); + method_check!(is_numeric, "numeric"); + method_check!(is_ascii, "ascii"); + method_check!(is_ascii_punctuation, "ascii_ponctuaction"); + method_check!(is_ascii_graphic, "ascii_graphic"); } &SystemClauseType::CheckCutPoint => { let addr = self.store(self.deref(self[temp_v!(1)]));