diff --git a/src/prolog/clause_types.rs b/src/prolog/clause_types.rs index c3d79b63..53d0f8e1 100644 --- a/src/prolog/clause_types.rs +++ b/src/prolog/clause_types.rs @@ -158,6 +158,7 @@ pub enum SystemClauseType { BindFromRegister, CallContinuation, CharCode, + CharType, CharsToNumber, ClearAttributeGoals, CloneAttributeGoals, @@ -278,6 +279,7 @@ impl SystemClauseType { &SystemClauseType::BindFromRegister => clause_name!("$bind_from_register"), &SystemClauseType::CallContinuation => clause_name!("$call_continuation"), &SystemClauseType::CharCode => clause_name!("$char_code"), + &SystemClauseType::CharType => clause_name!("$char_type"), &SystemClauseType::CharsToNumber => clause_name!("$chars_to_number"), &SystemClauseType::CheckCutPoint => clause_name!("$check_cp"), &SystemClauseType::ClearAttributeGoals => clause_name!("$clear_attribute_goals"), @@ -432,6 +434,7 @@ impl SystemClauseType { ("$assertz", 4) => Some(SystemClauseType::AssertDynamicPredicateToBack), ("$call_continuation", 1) => Some(SystemClauseType::CallContinuation), ("$char_code", 2) => Some(SystemClauseType::CharCode), + ("$char_type", 2) => Some(SystemClauseType::CharType), ("$chars_to_number", 2) => Some(SystemClauseType::CharsToNumber), ("$clear_attribute_goals", 0) => Some(SystemClauseType::ClearAttributeGoals), ("$clone_attribute_goals", 1) => Some(SystemClauseType::CloneAttributeGoals), diff --git a/src/prolog/lib/charsio.pl b/src/prolog/lib/charsio.pl index 717bbaaa..e09c2185 100644 --- a/src/prolog/lib/charsio.pl +++ b/src/prolog/lib/charsio.pl @@ -1,4 +1,4 @@ -:- module(charsio, [get_single_char/1, +:- module(charsio, [char_type/2, get_single_char/1, read_term_from_chars/2, write_term_to_chars/3]). @@ -57,6 +57,39 @@ extend_var_list_([V|Vs], N, VarList, NewVarList, VarType) :- ). +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)) + ). + + get_single_char(C) :- ( var(C) -> '$get_single_char'(C) ; atom_length(C, 1) -> '$get_single_char'(C) diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index 63bb8c79..fe88f062 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -1337,6 +1337,96 @@ impl MachineState { } }; } + &SystemClauseType::CharType => { + let a1 = self.store(self.deref(self[temp_v!(1)])); + let a2 = self.store(self.deref(self[temp_v!(2)])); + + let c = match a1 { + Addr::Char(c) => c, + Addr::Con(h) if self.heap.atom_at(h) => { + if let HeapCellValue::Atom(name, _) = &self.heap[h] { + name.as_str().chars().next().unwrap() + } + else { + unreachable!() + } + } + _ => unreachable!() + }; + 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) && chars == $name { + self.fail = false; + + 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)]));