#!/usr/bin/env kettle
# -*- tcl -*-
kettle tcl
kettle critcl3
kettle tclapp bin/marpa-gen

}

int 
marpatcl_rtc_byteset_contains (marpatcl_rtc_byteset* s, unsigned char c)
{
    // sizeof (unsigned char) == 8 --> max(c) = 255, no assertion required
    TRACE_FUNC ("((byteset*) %p, byte %d)", s, c);
    // ATT: assert not required for (unsigned char) == byte, always true
    //ASSERT (c < MARPATCL_RTC_BSMAX, "Symbol beyond set capacity");
    TRACE_RETURN ("%d", (XL [c] < SZ) && (DE [XL [c]] == c));
}

Marpa_Symbol_ID*
marpatcl_rtc_byteset_dense (marpatcl_rtc_byteset* s)
{
    TRACE_FUNC ("((byteset*) %p)", s);

	    TRACE_RETURN ("(sym*) %p (len 0)", NULL);
	}
	TRACE ("(len*) %p = %d", len, *len);
	ASSERT_BOUNDS (1+offset+1+length-1, coding->size);
	TRACE_RETURN ("(sym*) %p", coding->data + 1 + offset + 1);
    }
    ASSERT (0, "Unsupported type of g1 coding");
    TRACE_RETURN ("(sym*) %p FAIL", 0);
}

marpatcl_rtc_stack_p
marpatcl_rtc_spec_setup_rd (marpatcl_rtc_rules* s)
{
#define PUSH(detail)					\
    marpatcl_rtc_stack_push (rule_data, pc - s->rcode); \

} {
    incr k
    test marpa-unicode-norm-class-2.$k "norm-class, $charclass" -body {
	marpa unicode norm-class $charclass
    } -result $normalized
}


set k 0
foreach {charclass message notes} {
    {-1}          {Point out of range (0...*): -1} {out of range, under}
    {500000000}   {Point out of range (0...*): 500000000} {out of range, over, regardless of mode}
    {2 {3 3 4} 4} {Expected 2-element list for range} {too many elements for interval/range}
    {2 {} 4}      {Expected 2-element list for range} {not enough element for interval/range}
    {2 {-1 3} 4}  {Range (start) out of range (0...*): -1} {out of range, under}
    {2 {3 500000000} 4} {Range (end) out of range (0...*): 500000000} {out of range, over, regardless of mode}
    {2 {5 2} 4} {Range empty (end (5) before start (2))} {}
    {2 {{} 3} 4} {expected integer but got ""} {}
    {2 {3 {}} 4} {expected integer but got ""} {}
    {bogus} {Expected 2-element list for range} {}
} {
    incr k
    test marpa-unicode-norm-class-3.$k "norm-class, bad $charclass" -body {
	marpa unicode norm-class $charclass
    } -returnCodes error -result $message -match glob
}

# # ## ### ##### ######## ############# #####################
## negate-class - Complement a char class.

test marpa-unicode-negate-class-1.0 {negate-class, wrong args, not enough} -body {
    marpa unicode negate-class
} -returnCodes error -result {wrong # args: should be "marpa unicode negate-class charclass"}

	    goto fail;
	}

	scr = marpatcl_scr_new (objc);
	TRACE ("CAP %d", objc);
	for (i = 0; i < objc; i++) {
	    Tcl_Obj* elt = objv[i];
	    TRACE ("PROCESS. [%02d] %p", i, elt);
	    
	    /*
	    // First handle objects which already have a suitable type.
	    // No conversions required, only data extraction and validation.
	    */

	    if (elt->typePtr == ctx->intType) {
		TRACE ("INT. ... [%02d] %p", i, elt);
		Tcl_GetIntFromObj(ip, elt, &start);

		process_int:
		TRACE ("INT. CHK [%02d] %p", i, elt);
		if (marpatcl_scr_bad_codepoint (ip, "Point", start)) {
		    goto fail;
		}
		TRACE ("++ (%d)", start);
		marpatcl_scr_add_range(scr, start, start);
		continue;

	    }

	    if (elt->typePtr == ctx->listType) {
		TRACE ("LIST ... [%02d] %p", i, elt);
		Tcl_ListObjGetElements(ip, elt, &robjc, &robjv);

		process_list:
		TRACE ("LIST CHK [%02d] %p", i, elt);
		if (robjc != 2) {
	    #define MSG "Expected 2-element list for range"
		    Tcl_SetErrorCode (ip, "MARPA", NULL);
		    Tcl_SetObjResult (ip, Tcl_NewStringObj(MSG,-1));
		    goto fail;
	    #undef MSG
		}
		if ((Tcl_GetIntFromObj (ip, robjv[0], &start) != TCL_OK) ||
		    marpatcl_scr_bad_codepoint (ip, "Range (start)", start) ||
		    (Tcl_GetIntFromObj (ip, robjv[1], &end) != TCL_OK) ||
		    marpatcl_scr_bad_codepoint (ip, "Range (end)", end) ||
		    marpatcl_scr_bad_range(ip, start, end)) {
		    goto fail;
		}
		TRACE ("++ (%d...%d)", start, end);
		marpatcl_scr_add_range(scr, start, end);
		continue;
	    }

	    /*
	    // While object has no suitable type, it may be
	    // convertible to such. Those which are convertable get
	    // dispatched to the handlers above.
	    */

	    if (Tcl_GetIntFromObj(ip, elt, &start) == TCL_OK) {
		TRACE ("INT. CVT [%02d] %p", i, elt);
		goto process_int;
	    }

	    if (Tcl_ListObjGetElements(ip, elt, &robjc, &robjv) == TCL_OK) {
		TRACE ("LIST CVT [%02d] %p", i, elt);
		goto process_list;
	    }

	    TRACE ("NO.. CVT [%02d] %p", i, elt);
	    /*
	    // No suitable type, and not convertible to such either.
	    */

	    Tcl_SetErrorCode (ip, "MARPA", NULL);
	    Tcl_SetObjResult (ip, Tcl_NewStringObj("Expected codepoint or range, got neither",-1));
	    goto fail;

critcl::subject marpa unicode {character class} charclass case-folding

# # ## ### ##### ######## #############
## Implementation.

critcl::tcl 8.5

critcl::ccode {
    TRACE_OFF;
}

# # ## ### ##### ######## #############
## Declare the Tcl layer

critcl::tsources tcl.tcl          ; # Tcl-level operations
critcl::source   unicode.tcl      ; # C-level support functions.
critcl::source   cc_objtype.tcl   ; # ObjType for uni-char classes (SCR).