%%
%% %CopyrightBegin%
%%
%% SPDX-License-Identifier: Apache-2.0
%%
%% Copyright Ericsson AB 2006-2025. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%%     http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
%% %CopyrightEnd%
%%
%%----------------------------------------------------------------------
-module(xmerl_xsd).
-moduledoc """
Interface module for XML Schema validation.

It handles the W3.org [specifications](http://www.w3.org/XML/Schema#dev) of
XML Schema second edition 28 october 2004.  For an introduction to
XML Schema please study [part 0](http://www.w3.org/TR/xmlschema-0/).

An XML structure is validated by [`xmerl_xsd:validate/[2,3]`](`validate/2`).
""".

%%----------------------------------------------------------------------
%% Include files
%%----------------------------------------------------------------------
-include("xmerl.hrl").
-include("xmerl_internal.hrl").
-include("xmerl_xsd.hrl").
-include_lib("kernel/include/file.hrl").

%%----------------------------------------------------------------------
%% External exports
%%----------------------------------------------------------------------
-export([validate/2,validate/3,process_validate/2,process_validate/3,
	 process_schema/1,process_schema/2,
	 process_schemas/1,process_schemas/2,
	 state2file/1,state2file/2,file2state/1,format_error/1]).

%%----------------------------------------------------------------------
%% Internal exports
%%----------------------------------------------------------------------
-export([print_table/1]).
%%-export([whitespace/1]).

%%----------------------------------------------------------------------
%% Imports
%%----------------------------------------------------------------------
-import(xmerl_lib,[is_facet/1, is_builtin_simple_type/1, is_xsd_string/1]).
-import(xmerl_xsd_type,[facet_fun/2]).
-import(lists,[reverse/1,reverse/2,foldl/3,member/2,filter/2,flatten/1,map/2,
	       splitwith/2,mapfoldl/3,keysearch/3,keymember/3,
	       keyreplace/4,keydelete/3]).

%%----------------------------------------------------------------------
%% Types
%%----------------------------------------------------------------------

-compile({nowarn_hidden_doc, [xsd_state/0]}).
-doc hidden.
-type xsd_state() :: #xsd_state{}.

-doc """
The global state of the validator.

It is represented by the `#xsd_state{}` record.
""".
-type global_state() :: xsd_state().

-doc """
Options that allow to customize the behaviour of the validation.

Possible options are :

<dl>
  <dt><code>{tab2file,boolean()}</code></dt>
     <dd>Enables saving of abstract structure on file for debugging
        purpose.</dd>
  <dt><code>{xsdbase,filename()}</code></dt>
     <dd>XSD Base directory.</dd>
  <dt><code>{fetch_fun,FetchFun}</code></dt>
     <dd>Call back function to fetch an external resource.</dd>
  <dt><code>{fetch_path,PathList}</code></dt>
     <dd>PathList is a list of directories to search when fetching files.
         If the file in question is not in the fetch_path, the URI will
         be used as a file name.</dd>
  <dt><code>{state,State}</code></dt>
     <dd>It is possible by this option to provide a state with process
         information from an earlier validation.</dd>
</dl>
""".
-type option_list() :: [{xsdbase,filename()} |
                        {atom(),term()}].

-type filename() :: string().


%%======================================================================
%% Functions
%%======================================================================

-doc(#{ equiv => validate(Element, State, []) }).
-spec validate(Element :: xmerl:element(), State :: global_state()) -> _.
validate(Xml,State) ->
    validate(Xml,State,[]).

-doc """
Validate a parsed well-formed XML element (`Element`).

A call to `validate/2` or `validate/3` must provide a well formed
parsed XML [`Element :: #xmlElement{}`](`t:xmerl:xmlElement/0`)
and a State, `t:global_state/0`, which holds necessary information
from an already processed schema.  Thus validate enables reuse
of the schema information and therefore if one shall validate
several times towards the same schema it reduces time consumption.

The result, `ValidElement`, is the valid element that conforms to the
post-schema-validation infoset. When the validator finds an error it tries to
continue and reports a list of all errors found. In those cases an unexpected
error is found it may cause a single error reason.

Usage example:
``` erlang
1>{E,_} = xmerl_scan:file("my_XML_document.xml").
2>{ok,S} = xmerl_xsd:process_schema("my_XML_Schema.xsd").
3>{E2,_} = xmerl_xsd:validate(E,S).
```

Observe that E2 may differ from E if for instance there are default values
defined in `my_XML_Schema.xsd`.
""".
-spec validate(Element, global_state(), Options) -> Result when
      Element      :: xmerl:xmlElement(),
      Options      :: option_list(),
      Result       :: {ValidElement,global_state()} | {error,Reasons},
      ValidElement :: xmerl:xmlElement(),
      Reasons      :: [ErrorReason] | ErrorReason,
      ErrorReason  :: term().
validate(Xml,State,Opts) when is_record(State,xsd_state) ->
    S2 = initiate_state2(State,Opts),
    S3 = validation_options(S2,Opts),
    validate3(S3#xsd_state.schema_name,Xml,S3).


-doc """
Equivalent to [`state2file(State, SchemaName)`](`state2file/2`).

`SchemaName` is the name of the schema in `State`.
""".
-spec state2file(State :: global_state()) -> ok | {error,Reason} when
      Reason :: term().
state2file(S=#xsd_state{schema_name=SN}) ->
    state2file(S,filename:rootname(SN)).

-doc """
Save the schema processing state to a file.

Saves the schema state with all information of the processed schema in a file.
You can provide the file name for the saved state. FileName is saved with the
`.xss` extension added.
""".
-spec state2file(global_state(), FileName :: string()) ->
          ok | {error,Reason} when
      Reason :: term().
state2file(S,FileName) when is_record(S,xsd_state) ->
    save_xsd_state(S),
    try
        ets:tab2file(S#xsd_state.table,lists:append(FileName,".xss"))
    catch
	error:Reason:StackTrace ->
	    {error,{[],?MODULE,{Reason, StackTrace}}}
    end.


-doc """
Read the schema processing state from a file.

Reads the schema state with all information of the processed schema from
a file created with `state2file/[1,2]`. The format of this file is internal.
The state can then be used validating an XML document.
""".
-spec file2state(FileName :: string()) ->
          {ok,State} | {error,Reason} when
      State  :: global_state(),
      Reason :: term().
file2state(FileName) ->
    try ets:file2tab(FileName) of
	{ok,Tab} ->
	    case load_xsd_state(Tab) of
		[{state,S}] when is_record(S,xsd_state) ->
		    xmerl_xsd_vsn_check(S);
%%		    {ok,S};
		Other ->
		    {error,{[],?MODULE,{incomplete_file,FileName,Other}}}
	    end;
	{error,Reason} ->
	    {error,{[],?MODULE,Reason}}
    catch
        error:Reason:StackTrace ->
	    {error,{[],?MODULE,{'EXIT', {Reason, StackTrace}}}}
    end.

save_xsd_state(S) ->
    try
        ets:insert(S#xsd_state.table,{state,S})
    catch
        _:_ -> ok
    end.
load_xsd_state(Table) ->
    try
        ets:lookup(Table,state)
    catch
        error:Reason:StackTrace -> {'EXIT', {Reason, StackTrace}}
    end.
   
xmerl_xsd_vsn() ->
    case lists:keysearch(vsn,1,xmerl_xsd:module_info(attributes)) of
	{value,{_,MD5_VSN}} ->
	    MD5_VSN;
	_ ->
	    undefined
    end.
xmerl_xsd_vsn_check(S=#xsd_state{vsn=MD5_VSN}) ->
    case [V||{vsn,V}<-xmerl_xsd:module_info(attributes)] of
	[MD5_VSN] ->
	    {ok,S};
	_ ->
	    {error,{[],?MODULE,{different_version_of_xmerl_xsd_module_used,
		    state_not_reliable}}}
    end.


-doc(#{ equiv => process_validate(Schema, Element, []) }).
-spec process_validate(Schema :: string(), Element :: xmerl:element()) -> _.
process_validate(Schema,Xml) ->
    process_validate(Schema,Xml,[]).

-doc """
Validate a parsed well-formed XML element towards an XML schema.

Validates in two steps. First it processes the schema, saves the type and
structure info in an ETS table and then validates the element towards the
schema.

Usage example:

`1>{E,_} = xmerl_scan:file("my_XML_document.xml").`
`2>{E2,_} = xmerl_xsd:process_validate("my_XML_Schema.xsd",E).`

Observe that E2 may differ from E if for instance there are default values
defined in `my_XML_Schema.xsd`.
""".
-spec process_validate(Schema, Element, Options) -> Result when
      Schema       :: string(),
      Element      :: xmerl:element(),
      Options      :: option_list(),
      Result       :: {ValidElement,global_state()} | {error,Reasons},
      ValidElement :: xmerl:element(),
      Reasons      :: [Reason :: term()] | Reason :: term().
process_validate(Schema,Xml,Opts) ->
    TargetNamespace = target_namespace(Xml),
    case Schema of
	[H|_] when is_list(H); is_tuple(H) ->
	    case process_schemas(Schema,
				 [{target_namespace,TargetNamespace}|Opts]) of
		{ok,S} ->
		    S2 = validation_options(S,Opts),
		    validate3(S2#xsd_state.schema_name,Xml,S2);
		Err ->
		    Err
	    end;
	_ ->
	    process_validate2(xmerl_scan:file(Schema),Schema,Xml,Opts)
    end.

process_validate2(Err={error,_},_,_,_) ->
    Err;
process_validate2({SE,_},Schema,Xml,Opts) ->
    S = initiate_state(Opts,Schema),
    S1 = validate_schema(SE,S),
    S2 = validate_schema_ph2(S1),
    S3 = schema_concistence_checks(S2),
    S4 = validation_options(S3,Opts),
    validate3(Schema,Xml,S4).

validate3(Schema, Xml,S =#xsd_state{errors=[]}) -> 
    Ret = {_, S2} = 
	try validate_xml(Xml, S) of
	    _Err = {error, Reason} ->
		{Xml, acc_errs(S, Reason)};
	    {XML2, Rest, Sx} ->
		case lists:dropwhile(fun(X) when is_record(X, xmlComment) -> true; (_) -> false end, Rest) of
		    [] ->
			case XML2 of
			    [XML3] ->
				{XML3,Sx};
			    XML3 ->
				{XML3,Sx}
			end;
		    UnValidated ->
			{Xml,acc_errs(Sx,{error_path(UnValidated,Xml#xmlElement.name),?MODULE,
					  {unvalidated_rest,UnValidated}})}
		end
        catch
            error:Reason:StackTrace -> 
                {Xml, acc_errs(S, {error_path(Xml, Xml#xmlElement.name), ?MODULE,
                                   {undefined, {internal_error, {Reason, StackTrace}}}})};
	    exit:Reason ->
		{Xml, acc_errs(S, {error_path(Xml, Xml#xmlElement.name), ?MODULE,
                                   {undefined, {internal_error, Reason}}})}            
	end,
    save_to_file(S2,filename:rootname(Schema)++".tab2"),
    case S2#xsd_state.errors of
	[] ->
	    Ret;
	L ->
	    %%delete_table(S2),
	    return_error(L)
    end;
validate3(_,_,S) ->
    return_schema_error(S#xsd_state.errors).


-doc(#{ equiv => process_schema(Schema, []) }).
-spec process_schema(Schema :: string()) -> _.
process_schema(Schema) ->
    process_schema(Schema,[]).

-doc """
Read an XML schema and check that it is valid.

Reads the referenced XML schema and checks that it is valid. Returns the
`t:global_state/0` with schema info or an error reason. The error reason
may be a list of several errors or a single error encountered
during the processing.
""".
-spec process_schema(Schema :: string(), Options :: option_list()) ->
          {ok, State} | {error, Reasons} when
      State   :: global_state(),
      Reasons :: [Reason :: term()] | Reason :: term().
process_schema(Schema,Options) when is_list(Options) ->
    State = initiate_state(Options,Schema),
    process_schema2(Schema, State).
%%
process_schema2(Schema, State=#xsd_state{fetch_fun=Fetch})->
    case Fetch(Schema, State) of
	{ok,{file,File},_} ->
	    process_schema2(xmerl_scan:file(File), State, Schema);
	{ok,{string,Str},_} ->
	    process_schema2(xmerl_scan:string(Str), State, Schema);
	{ok,[],_} ->
	    {error,enoent};
	Err ->
	    Err
    end.
%%
process_schema2(Err={error,_},_,_) ->
    Err;
process_schema2({SE,_},State,_Schema) ->
    S1 = validate_schema(SE,State),
    S2 = validate_schema_ph2(S1),
    case schema_concistence_checks(S2) of
	S3 = #xsd_state{errors=[]} ->
	    {ok,S3};
	S3 ->
	    _ = delete_table(S3),
	    return_error(S3#xsd_state.errors)
    end.


-doc(#{ equiv => process_schemas(Schemas, []) }).
-spec process_schemas(Schemas :: list()) -> _.
process_schemas(Schemas) ->
    process_schemas(Schemas,[]).

-doc """
Read XML schemas and check that they are valid.

Reads the referenced XML schemas and controls they are valid. Returns the
`t:global_state/0` with schema info or an error reason. The error reason may be
a list of several errors or a single error encountered during the processing.
""".
-spec process_schemas(Schemas, Options) ->
          {ok, State} | {error, Reasons} when
      Schemas   :: nonempty_list({NameSpace, Schema}),
      Options   :: option_list(),
      NameSpace :: term(),
      Schema    :: string(),
      State     :: global_state(),
      Reasons   :: [Reason :: term()] | Reason :: term().
process_schemas(Schemas=[{_,Schema}|_],Options) when is_list(Options) ->
    State = initiate_state(Options,Schema),
    process_schemas2(Schemas, State).
%%%
process_schemas2([{_NS,Schema}|Rest],State=#xsd_state{fetch_fun=Fetch}) ->
    Res=
    case Fetch(Schema,State) of
	{ok,{file,File},_} ->
	    process_schema2(xmerl_scan:file(File),State,Schema);
	{ok,{string,Str},_} ->
	    process_schema2(xmerl_scan:string(Str),State,Schema);
	{ok,[],_} ->
	    {ok,State};
	Err ->
	    Err
    end,
    case Res of
	{ok,S2} ->
	    process_schemas2(Rest,S2);
	_ ->
	    Res
    end;
process_schemas2([],State=#xsd_state{}) ->
    {ok,State}.

initiate_state(Opts,Schema) ->
    XSDBase = filename:dirname(Schema),
    {{state,S},RestOpts}=new_state(Opts),
    S2 = create_tables(S),
    initiate_state2(S2#xsd_state{schema_name = Schema, xsd_base=XSDBase,
				 fetch_fun = fun fetch/2},
		    RestOpts).

initiate_state2(S,[]) ->
    S;
initiate_state2(S,[{tab2file,Bool}|T]) ->
    initiate_state2(S#xsd_state{tab2file=Bool},T);
initiate_state2(S,[{xsdbase, XSDBase}|T]) ->
    initiate_state2(S#xsd_state{xsd_base=XSDBase, external_xsd_base=true},T);
initiate_state2(S,[{fetch_fun,FetchFun}|T]) ->
    initiate_state2(S#xsd_state{fetch_fun=FetchFun},T);
initiate_state2(S,[{fetch_path,FetchPath}|T]) ->
    initiate_state2(S#xsd_state{fetch_path=FetchPath},T);
initiate_state2(S,[{schema_preprocessed,Bool}|T]) ->
    initiate_state2(S#xsd_state{schema_preprocessed=Bool},T);
initiate_state2(S,[{target_namespace,_NS}|T]) ->
%%    initiate_state2(S#xsd_state{targetNamespace=if_list_to_atom(NS)},T);
    initiate_state2(S,T); %% used in validation phase
initiate_state2(S,[H|T]) ->
    error_msg("~w: invalid option: ~p~n",[?MODULE, H]),
    initiate_state2(S,T).

validation_options(S,[{target_namespace,NS}|T]) ->
    validation_options(S#xsd_state{targetNamespace=if_list_to_atom(NS)},T);
validation_options(S,[_H|T]) ->
    validation_options(S,T);
validation_options(S,[]) ->
    S.

new_state(Opts) ->
    XSD_VSN = xmerl_xsd_vsn(),
    keysearch_delete(state,1,Opts,{state,#xsd_state{vsn=XSD_VSN}}).


%% validate_schema/2 traverses the shema element to save necessary
%% information as defined elements and types.
validate_schema(E=#xmlElement{},
		    S) ->
    %% namespace is always a xmlNamespace record, attributes a list of
    %% #xmlAttributes and content a list of #xmlElements|#xmlText|...

    %% Have to save namespace nodes. Use of namespace in paths for
    %% unique,key and keyref are used after the schema is processed.

    S1 = S#xsd_state{targetNamespace=target_namespace(E)},
    case is_already_processed(S1#xsd_state.targetNamespace,S1) of
	true ->
	    save_namespace_definition(S1#xsd_state.targetNamespace,S1);
	_ ->
	    S2 = S1,%save_namespace_definition(S1#xsd_state.targetNamespace,S1),
	    {CM,S3} = traverse_content(E,S2),
	    save_schema_element(CM,S3),
	    S3
    end.

validate_schema_ph2(S=#xsd_state{derived_types=[]}) ->
    S;
validate_schema_ph2(S=#xsd_state{derived_types=DT}) ->
    deduce_derived_types(DT,S).

%% traverse_content/2 creates the content model of the schema.
%% content model depends on (1) the type:
%% complex type:
%%       sequence, choice, all
%% simple type: no content other than characters
%% (2) minOccurs/maxOccurs attributes.
%% The schema for schemas content model is:
%% schema:	  ((include | import | redefine | annotation)*,
%%		  (((simpleType | complexType | group | attributeGroup)
%%		   | element | attribute | notation), annotation*)*)
%% attribute:	  (annotation?, simpleType?)
%% element:	  (annotation?, ((simpleType | complexType)?, (unique |
%%		   key | keyref)*))
%% complexType:	  (annotation?, (simpleContent | complexContent |
%%		  ((group | all | choice | sequence)?,
%%		  ((attribute | attributeGroup)*,anyAttribute?))))
%% attributeGroup:(annotation?,
%%                 ((attribute | attributeGroup)*, anyAttribute?))
%% group:	  (annotation?, (all | choice | sequence)?)
%% all:		  (annotation?, element*)
%% sequence:	  (annotation?,
%%                 (element | group | choice | sequence | any)*)
%% choice:	  (annotation?, (element | group | choice | sequence |
%%		   any)*)
%% any:		  (annotation?) any wellformed xml inside "any"
%% unique:	  (annotation?, (selector, field+))
%% key:		  (annotation?, (selector, field+))
%% keyref:	  (annotation?, (selector, field+))
%% selector:	  (annotation?)
%% field:	  (annotation?)
%% notation:	  (annotation?)
%% annotation:	  (appinfo | documentation)*
%% appinfo:	  ({any})*
%% documentation: ({any})*
%% simpleType:	  (annotation?, (restriction | list | union))
%% restriction:	  (annotation?, (simpleType?, (minExclusive |
%%		   minInclusive | maxExclusive | maxInclusive |
%%		   totalDigits | fractionDigits | length | minLength |
%%		   maxLength | enumeration | whiteSpace | pattern)*))
%% list:	  (annotation?, simpleType?)
%% union:	  (annotation?, simpleType*)
%% include:	  (annotation?)
%% import:	  (annotation?)
%% redefine:	  (annotation | (simpleType | complexType | group |
%%		   attributeGroup))*
traverse_content(E=#xmlElement{name=Name},S) ->
    case local_name(Name) of
	schema ->
	    Content = E#xmlElement.content,
%%	    S1 = S#xsd_state{targetNamespace=target_namespace(E)},
	    ThisNS = {"#this#",S#xsd_state.schema_name,
		      S#xsd_state.targetNamespace},
	    S2 = S#xsd_state{checked_namespace_nodes=
			      add_once(ThisNS,S#xsd_state.checked_namespace_nodes)},
	    S3 = namespace_nodes(E,S2),
	    S4 = element_form_default(E,S3),
	    S5 = attribute_form_default(E,S4),
	    S6 = substitution_default(finalDefault,E,S5),
	    S7 = substitution_default(blockDefault,E,S6),
	    traverse_content2(Content,S7,[]);
	Err ->
	    exit({error,{[],?MODULE,{schema_error,Err}}})
    end.


traverse_content2([],S,Acc) ->
    {reverse(remove_annotation(Acc)),reset_scope(S)};
traverse_content2([El|Els],S,Acc) when is_record(El,xmlElement) ->
    %% element declaration: save name, type, scope.
    {Object,S2} = element_content(kind(El,S),El,S#xsd_state.scope),%% Object={Kind,Obj}
    traverse_content2(Els,S2,[Object|Acc]);
traverse_content2([_T|Els],S,Acc) -> %% xmlText,xmlPI ...
    traverse_content2(Els,S,Acc).

target_namespace(E) ->
    case get_attribute_value(targetNamespace,E,undefined) of
	URI when is_list(URI) ->
	    list_to_atom(URI);
	URI ->
	    URI
    end.

%% namespace_nodes/2 ->
%%     NS.
namespace_nodes(#xmlElement{namespace=#xmlNamespace{nodes=NS}},
		S=#xsd_state{namespace_nodes=NSN,
			     global_namespace_nodes=GNSN}) ->
    S2 =S#xsd_state{namespace_nodes=foldl(fun add_once/2,NSN,NS)},
    S2#xsd_state{global_namespace_nodes=
		 add_key_once(S#xsd_state.targetNamespace,1,
			      {S#xsd_state.targetNamespace,NS},
			      GNSN)}.

attribute_form_default(#xmlElement{attributes=Atts},S)->
    Def=form_default(attributeFormDefault,Atts,S),
    S#xsd_state{attributeFormDefault=Def}.
element_form_default(#xmlElement{attributes=Atts},S) ->
    Def=form_default(elementFormDefault,Atts,S),
    S#xsd_state{elementFormDefault=Def}.
form_default(Key,Atts,_S) ->
    case keyNsearch(Key,#xmlAttribute.name,Atts,unqualified) of
	#xmlAttribute{value=V} when is_list(V) -> list_to_atom(V);
	#xmlAttribute{value=V} ->V;
	 _-> unqualified
    end.

substitution_default(Subst = finalDefault,El,S) ->
    S#xsd_state{finalDefault = substitution(Subst,El,S)};
substitution_default(Subst = blockDefault,El,S) ->
    S#xsd_state{blockDefault = substitution(Subst,El,S)}.
substitution(Subst,El,_S) ->
    split_by_whitespace(get_attribute_value(Subst,El,[]),[]).


%% element_content may be one of: annotation, type def(simple or
%% complex), import, unique, key, keyref, attribute def, attribute
%% group, all, group, complexContent, simpleContent, choice, sequence
element_content({attribute,S=#xsd_state{scope=Scope}},Att,Env) ->
    case qualify_NCName(Att,S) of
	no_name ->
	    Ref = attribute_ref(Att),
	    AttRef =
		{attribute,get_QName(Ref,Att#xmlElement.namespace, %%QQQ
				     reset_scope(S))},
	    {AttRef,add_ref(S,AttRef)};
	Name ->
	    {AttrType,S2} = attribute_type(Att,[Name|Env],S),
	    S3 = check_cm(attribute,allowed_content(attribute,Env),AttrType,S2),
	    {Attr,S4} = attribute_properties(Att#xmlElement.attributes,
					#schema_attribute{type=AttrType},S3),
	    Object = {attribute,
		      Attr#schema_attribute{name=Name,scope=Scope}},
	    S5 = save_object(Object,S4),
	    {{attribute,Name},S5}
    end;
element_content({element,S},El,Env) ->
    %% The type of an element may be a simple or complex type (named
    %% or anonymous), a referenced name or member of a substitution group.
    case qualify_NCName(El,S) of
	no_name ->
	    Ref = particle_ref(El),
	    {Occ,S2} = occurrence(El,{1,1},S),
	    %% 3.3.3 bullet 2.2
	    S3 = element_forbidden_properties(El,S2),
	    S4 = element_forbidden_content(El#xmlElement.content,S3),
	    ElRef =
		{element,
		 {get_QName(Ref,El#xmlElement.namespace,reset_scope(S)),
		  Occ}},
	    {ElRef,add_ref(S4,ElRef)};
	Name ->
	    {Type,S2} = element_type(El,[Name|Env],S),
	    S3 = check_cm(element,allowed_content(element,Env),Type,S2),
	    Type2 = remove_annotation(Type),
	    Unique = [X||X={unique,_} <- Type2],
	    Key = [X||X={K,_} <- Type2,K == key orelse K==keyref],
	    {Occur,S4} = occurrence(El,{1,1},S3),
	    {SE,S5} = element_properties(El#xmlElement.attributes,
					 #schema_element{},El,S4),
	    CM = remove_attributes([X||X={Y,_}<-Type2,
				       unique=/=Y,key=/=Y,
				       keyref=/=Y,annotation=/=Y]),
	    %% take care of key/keyref later
	    SE2 = SE#schema_element{name=Name,type=CM,uniqueness=Unique,
				    key=Key, occurrence=Occur,
				    scope=S5#xsd_state.scope},
	    S6 = insert_substitutionGroup(SE2,S5),
	    S7 = save_object({element,SE2},S6),
	    {{element,{Name,Occur}},S7}
    end;
element_content({complexType,S},CT,Env) ->
    %% complex type definition without a name is returned and added to
    %% the content model at this level. A complex type may also contain
    %% attributes or attribute group references in the end of its content.
    %%?debug("complexType content: ~p~nenv: ~p~n",[CT,Env]),
    {SCT,S1} = c_t_properties(CT,#schema_complex_type{},S),
    {Mixed,S2} = mixed(CT,S1),
    Complexity = complexity(CT#xmlElement.content),
    {Object,Name,S7} =
    case qualify_NCName(CT,S2) of
	no_name ->
	    {CM,S3} = type(CT#xmlElement.content,
			   in_scope(anonymous,S2),[complexType|Env]),
	    S4 = check_cm(complexType,allowed_content(complexType,Env),CM,S3),
	    Name1 = get_QName('_xmerl_no_name_',CT#xmlElement.namespace,S4),
	    S5 = set_scope(S#xsd_state.scope,S4),
	    {Content,Attributes}=split_content(remove_annotation(CM)),
	    SCT2 = base_type(Content,SCT),
	    CTObj =
		{complexType,
		 SCT2#schema_complex_type{name=Name1,
					  scope=S5#xsd_state.scope,
					  attributes=Attributes,
					  complexity=Complexity,
					  content=mixify(Mixed,Content)}},
	    {CTObj,Name1,S5};
        Name2 ->
	    S3 = in_scope(Name2,S2),
	    S3a = push_circularity_mark({typeDef,Name2},S3),
	    {CM,S4} = type(CT#xmlElement.content,S3a,
				[complexType|Env]),
	    S4a = pop_circularity_mark({typeDef,Name2},S4),
	    S5 = check_cm(complexType,allowed_content(complexType,Env),
			  CM,S4a),
	    S6 = set_scope(S#xsd_state.scope,S5),
	    {Content,Attributes}=split_content(remove_annotation(CM)),
	    SCT2 = base_type(Content,SCT),
	    {{complexType,
	      SCT2#schema_complex_type{name=Name2,
				      scope=S6#xsd_state.scope,
				      attributes=Attributes,
				       complexity=Complexity,
				      content=mixify(Mixed,Content)}},
	     Name2,S6}
    end,
    S8 = save_object(Object,S7),
    S9 = derived_type(Object,S8),
    {{complexType,Name},S9};
element_content({attributeGroup,S},AG,Env) ->
    %% an attribute group always have a name or a ref, the content is
    %% (annotation?,(attribute | attributGroup)*, anyAttribute?).
    case qualify_NCName(AG,S) of
	no_name ->
	    %% an attribute group ref inside complex type def or attr
	    %% group def ( XSD1:3.6.2).
	    Ref = attributeGroup_ref(AG),
	    AGRef =
		{attributeGroup,get_QName(Ref,AG#xmlElement.namespace,%%QQQ
					  reset_scope(S))},
	    {AGRef,add_ref(S,AGRef)};
	Name ->
	    %% must occur on top level of schema( XSD1:3.6.2). The
	    %% only thing needed in content are the names of all
	    %% attributes or referenced attribute groups.
	    {CM,S2} = type(AG#xmlElement.content,in_scope(Name,S),
			       [attributeGroup|Env]),
	    S2_1 = out_scope(Name,S2),
	    S3 = check_cm(attributeGroup,allowed_content(attributeGroup,Env),CM,S2_1),
	    S4 = save_object({attributeGroup,
			 #schema_attribute_group{name=Name,
						 content=keep_attributes(CM)}},S3),
	    {{attributeGroup,Name},S4}
    end;
element_content({group,S},G,Env) ->
    %% a model group associates a name with a content model. It can be
    %% a reference or a definition.
    %% content is one of all, choice or sequence.
    case qualify_NCName(G,S) of
	no_name -> % reference.
	    %% If reference is a recursive ref to a group with the
	    %% same name as this group points at the redefined valid
	    %% schema group. See XMLSchema part 1, section 4.2.2
	    %% "Schema Representation Constraint: Individual Component
	    %% Redefinition"
	    Ref = particle_ref(G),
	    {Occur,S2} = occurrence(G,{1,1},S),
	    GRef =
		{group,
	      {get_QName(Ref,G#xmlElement.namespace,reset_scope(S2)),%%QQQ
	       Occur}},
	    {GRef,add_ref(S2,GRef)};
	Name -> % definition, always schema or redefine as parent
	    {CM,S2} = type(G#xmlElement.content,in_scope(Name,S),[group|Env]),
	    CM2 = recursive_redefine(Name,CM,S2),
	    S2_1 = out_scope(Name,S2),
	    S3 = check_cm(group,allowed_content(group,Env),CM2,S2_1),
	    S4 = save_object({group,#schema_group{name=Name,
					     content=remove_annotation(CM2)}},S3),
	    {{group,Name},S4}
    end;
element_content({all,S},All,Env) ->
    %% each element occurs 0 or 1 times in any order
    %% {all,[{element_name,occurrence}]}
%%    CM = content_model(Seq#xmlElement.content,S,[all|Env]),
    {Occur,S1} = occurrence(All,{1,1},S),
    {CM,S2} = type(All#xmlElement.content,S1,[all|Env]),
    S3 = check_cm(all,allowed_content(all,Env),CM,S2),
    {{all,{[X||X = {element,_} <- CM],Occur}},S3};
element_content({sequence,S},Seq,Env) ->
    %% {sequence,[{element_name,occurrence}]}
%%    CM = content_model(Seq#xmlElement.content,S,[sequence|Env]),
    {Occur,S1} = occurrence(Seq,{1,1},S),
    {CM,S2} = type(Seq#xmlElement.content,S1,[sequence|Env]),
    S3 = check_cm(sequence,allowed_content(sequence,Env),CM,S2),
    {{sequence,{remove_annotation(CM),Occur}},S3};
element_content({choice,S},Choice,Env) ->
    %% allowed content: (annotation?,
    %%                   (element | group | choice | sequence | any)*)
    %% returns: {choice,[element_name]}
%%    CM = content_model(Choice#xmlElement.content,S,[choice|Env]),
    {Occur,S1} = occurrence(Choice,{1,1},S),
    {CM,S2} = type(Choice#xmlElement.content,S1,[choice|Env]),
    S3 = check_cm(choice,allowed_content(choice,Env),CM,S2),
    {{choice,{remove_annotation(CM),Occur}},S3};
element_content({any,S},Any,_Env) ->
    {Occur,S1} = occurrence(Any,{1,1},S),
    NameSpace = wildcard_namespace(Any,S1),
    PC = processor_contents(Any),
    ?debug("element_content, any: Any content:~p~n",[Any#xmlElement.content]),
    Pred = fun(E=#xmlElement{}) -> case kind(E) of
				       annotation -> false;
				       _ -> true
				   end;
	      (_) ->
		   false
	   end,
    S2 = case filter(Pred,Any#xmlElement.content) of
	     [] -> S1;
	     Err -> %% report error
		 acc_errs(S1,{error_path(Any,Any#xmlElement.name),?MODULE,
			      {unexpected_content_in_any,Err}})
	 end,
    {{any,{NameSpace,Occur,PC}},S2};
element_content({IDC,S},El,Env)
  when IDC==unique;IDC==key;IDC==keyref->
    QName = qualify_NCName(El,reset_scope(S)),
    Ref = keyrefer(IDC,El,S),
    {SelField,S2} = type(El#xmlElement.content,S,[IDC|Env]),
    case {[X||X={selector,_} <- SelField],[X||X={field,_} <- SelField]} of
	{[Sel],Fields=[_H|_T]} ->
	    IDConstr = #id_constraint{category=IDC,name=QName,refer=Ref,
				      selector=Sel,fields=Fields},
	    S3=save_idc(IDC,IDConstr,S2),
	    {{IDC,IDConstr},S3};
	Err ->
	    S3 = acc_errs(S2,{error_path(El,El#xmlElement.name),?MODULE,
			      {erroneous_content_in_identity_constraint,IDC,Err}}),
	    {{IDC,[]},S3}
    end;
element_content({selector,S},Sel,_Env) ->
    case get_attribute_value(xpath,Sel,error) of
	error ->
	    S2 = acc_errs(S,{error_path(Sel,Sel#xmlElement.name),?MODULE,
			     {missing_xpath_attribute,selector}}),
	    {{selector,[]},S2};
	XPath ->
	    {{selector,XPath},S}
    end;
element_content({field,S},F,_Env) ->
    case get_attribute_value(xpath,F,error) of
	error ->
	    S2 = acc_errs(S,{error_path(F,F#xmlElement.name),?MODULE,
			     {missing_xpath_attribute,field}}),
	    {{field,[]},S2};
	XPath ->
	    {{field,XPath},S}
    end;
element_content({notation,S},_N,_Env) ->
    {{notation,[]},S};
element_content({annotation,S},_Ann,_Env) ->
    {{annotation,[]},S};
element_content({appinfo,S},_AI,_Env) ->
    {{appinfo,[]},S};
element_content({documentation,S},_D,_Env) ->
    {{documentation,[]},S};
element_content({simpleType,S},ST,Env) ->
    Name = case qualify_NCName(ST,S) of
	       no_name ->
		   get_QName('_xmerl_no_name_',ST#xmlElement.namespace,
			     in_scope('_xmerl_no_name_',S));%%---
	       QName ->
		   QName
	   end,
    {Type,S2} = type(ST#xmlElement.content,
		     push_circularity_mark({typeDef,Name},in_scope(Name,S)),
		      [simpleType|Env]),
    S2_1 = pop_circularity_mark({typeDef,Name},S2),
    S3 = set_scope(S#xsd_state.scope,S2_1),
    S4 = check_cm(simpleType,allowed_content(simpleType,Env),Type,S3),
    {BaseType,Facets} = facets(Type,S4),
    Variety = variety(Type),
    Final = simpleType_final(ST,S4),
    Object = {simpleType,#schema_simple_type{name=Name,
					     base_type=BaseType,
					     final=Final,
					     facets=Facets,
					     variety=Variety,
					     content=remove_annotation(Type),
					     scope=S4#xsd_state.scope}},
    S5 = save_object(Object,S4),
    S6 = derived_type(Object,S5),
    {{simpleType,Name},S6};
element_content({restriction,S},R,Env) ->
    %% If complexContent, all element definitions of base type must be
    %% repeated. However, attributes are inherited.
    %% possible parents are simpleType or complexType (grand parent)
    %% If parent is simpleType the base type is either the attribute
    %% base (resolved by base_type/1) or the type defined in content.
    {CM,S2} = type(R#xmlElement.content,S,[restriction|Env]),
    S3 = check_cm(restriction,allowed_content(restriction,Env),CM,S2),
    {BaseTypeName,CM2,S4} = restriction_base_type(R,CM,S3), %% a QName
%%    S5 = add_circularity_mark(BaseTypeName,S4),
    BaseTypeType = base_type_type(Env),
    {{restriction,{BaseTypeName,remove_annotation(CM2)}},
     add_ref(S4,{BaseTypeType,BaseTypeName})}; %% Does not return name but content model
element_content({list,S=#xsd_state{scope=Scope}},L,Env) ->
    {Type,S2} = list_type(L,S,[list|Env]),
    S3 = check_cm(list,allowed_content(list,Scope),Type,S2),
    {{list,remove_annotation(Type)},S3};
element_content({union,S=#xsd_state{scope=Scope}},U,Env) ->
    {Types,S2} = union_types(U,S,[union|Env]),
    S3 = check_cm(union,allowed_content(union,Scope),Types,S2),
    {{union,Types},S3};
element_content({include,S=#xsd_state{schema_name=ThisSchema,
				      targetNamespace=TNS}},I,_Env) ->
    S2 = process_external_schema_once(I,S#xsd_state.targetNamespace,S),
    {{include,[]},S2#xsd_state{schema_name=ThisSchema,targetNamespace=TNS}};
element_content({import,S=#xsd_state{schema_name=ThisSchema,
				     targetNamespace=ThisNameS}},I,_Env) ->
    %% import unlike include and redefine may include definitions from
    %% other namespaces than the target namespace of the including
    %% schema.

    %% namespace and schemaLocation
    Namespace =
	case get_attribute_value(namespace,I,undefined) of
	    L when is_list(L) ->
		list_to_atom(L);
	    A -> A
	end,
    %% If Namespace is absent, then the import allows unqualified
    %% reference to components with no target namespace.

    SchemaLocation = get_attribute_value(schemaLocation,I,absent),
    %% If SchemaLocation is absent, the identification of that schema
    %% is leaved to the instance, application or user, via the
    %% mechanisms described §4.3 in XML Schema Part 1.

    S2 = process_external_schema_once(SchemaLocation,Namespace,S),
    {{import,[]},S2#xsd_state{schema_name=ThisSchema,
			      targetNamespace=ThisNameS}};
element_content({redefine,S=#xsd_state{schema_name=ThisSchema}},RD,Env) ->
    %% Must be a child of "schema" element
    %% redefine of simple and complex types, groups and attribute
    %% groups obtained from external files.
    %% Brings in all definitions of external schema and redefines one.
    %% External schema must be in same namespace as current schema or
    %% no namespace.
    S2 = process_external_schema_once(RD,S#xsd_state.targetNamespace,
				      S#xsd_state{errors=[]}),
    case S2#xsd_state.errors of
	[] ->
%%	    RedefSource = S2#xsd_state.schema_name,
	    S3 = S2#xsd_state{schema_name=ThisSchema,
%%			      global_element_source=add_once({ThisSchema,RedefSource},GES),
			      errors=S#xsd_state.errors},
	    {CM,S4} = type(RD#xmlElement.content,
				 S3#xsd_state{redefine=true},[redefine|Env]),
	    S5 = S4#xsd_state{redefine=false},
	    S6 = check_cm(redefine,allowed_content(redefine,Env),CM,S5),
	    S7 = redefine(CM,S6),
	    {{redefine,[]},S7};
	Errs ->
	    S3 = S2#xsd_state{schema_name=ThisSchema,
			      errors=Errs++S#xsd_state.errors},
	    {{redefine,[]},S3}
    end;
element_content({anyAttribute,S},AA,_Env) ->
    %% has attributes processContents = (lax | skip | strict) : strict
    %% namespace = ((##any | ##other) |
    %%               List of (anyURI | (##targetNamespace | ##local)) )  : ##any

    NameSpace = wildcard_namespace(AA,S),
    PC = processor_contents(AA),
    Pred = fun(E=#xmlElement{}) -> case kind(E) of
			 annotation -> false;
			 _ -> true
		     end;
	      (_) -> false
	   end,
    S2 =
	case filter(Pred,AA#xmlElement.content) of
	    [] -> S;
	    Err -> %% report error
		acc_errs(S,{error_path(AA,AA#xmlElement.name),?MODULE,
			    {content_in_anyAttribute,Err}})
	end,
    {{anyAttribute,{NameSpace,PC}},S2};
element_content({simpleContent,S},SC,Env) ->
    %% only as child of complexType.
    %% allowed content: (annotation?, (restriction | extension))
    S2 = pre_check_cm(simpleContent,SC#xmlElement.content,mk_name(S#xsd_state.scope),S),
    case filter(fun(X=#xmlElement{}) ->
			case kind(X) of
			    restriction -> true;
			    extension -> true;
			    _ -> false
			end;
		   (_) -> false
		end,
		SC#xmlElement.content) of
	[E] ->
	    element_content(kind(E,S2),E,[simpleContent|Env]);
	Err ->
	    {[],acc_errs(S2,{error_path(SC,SC#xmlElement.name),?MODULE,
			     {content_in_simpleContent,Err}})}
    end;
element_content({complexContent,S},CC,Env) ->
    S2 = pre_check_cm(complexContent,CC#xmlElement.content,
		      mk_name(S#xsd_state.scope),S),
    %% the mixed attribute was fetched in the complexType element that
    %% held this complexContent
    case filter(fun(X=#xmlElement{}) -> case kind(X) of
					    restriction -> true;
					    extension -> true;
					    _ -> false
					end;
		   (_) -> false
		end,CC#xmlElement.content) of
	[E] ->
	    element_content(kind(E,S2),E,[complexContent|Env]);
	Err ->
	    {[],acc_errs(S2,{error_path(CC,CC#xmlElement.name),?MODULE,
			     {complexContent_content_failure,Err}})}
    end;
element_content({extension,S},Ext,Env) ->
    %% may be used in both simple and complex content with different
    %% content allowed.
    %% this should be returned and checked for allowed content in
    %% parent, but we don't know if base type is a forward reference.
    BaseType = base_type(Ext),
    {CM,S2} = type(Ext#xmlElement.content,S,[extension|Env]),
    S3 = check_cm(extension,allowed_content(extension,S#xsd_state.scope),CM,S2),
    BaseTypeName = get_QName(BaseType,Ext#xmlElement.namespace,reset_scope(S)),%%QQQ
    BaseTypeType = base_type_type(Env),
    {{extension,{BaseTypeName,CM}},add_ref(S3,{BaseTypeType,BaseTypeName})};
%% The following are facets
element_content({minExclusive,S},CF,_Env) ->
    Value = get_value(CF),
    {{minExclusive,Value},S};
element_content({minInclusive,S},CF,_Env) ->
    Value = get_value(CF),
    {{minInclusive,Value},S};
element_content({maxExclusive,S},CF,_Env) ->
    Value = get_value(CF),
    {{maxExclusive,Value},S};
element_content({maxInclusive,S},CF,_Env) ->
    Value = get_value(CF),
    {{maxInclusive,Value},S};
element_content({totalDigits,S},CF,_Env) ->
    Value = get_value(CF),
    {{totalDigits,Value},S};
element_content({fractionDigits,S},CF,_Env) ->
    Value = get_value(CF),
    {{fractionDigits,Value},S};
element_content({length,S},CF,_Env) ->
    Value = get_value(CF),
    {{length,Value},S};
element_content({minLength,S},CF,_Env) ->
    Value = get_value(CF),
    {{minLength,Value},S};
element_content({maxLength,S},CF,_Env) ->
    Value = get_value(CF),
    {{maxLength,Value},S};
element_content({enumeration,S},CF,_Env) ->
    Value = get_value(CF),
    {{enumeration,Value},S};
element_content({whiteSpace,S},CF,_Env) ->
    Value = get_value(CF),
    {{whiteSpace,Value},S};
element_content({pattern,S},CF,_Env) ->
    Value = get_value(CF),
    {{pattern,Value},S};
element_content({Other,S=#xsd_state{errors=Errs}},C,_Env) ->
    case Errs of
	[] ->
	    {[],acc_errs(S,{error_path(C,C#xmlElement.name),?MODULE,
			    {unknown_content,Other}})};
	_ ->
	    {[],S}
    end.


type(C,S,Env) ->
    type(C,S,Env,[]).
type([E=#xmlElement{}|Els],S,Env,Acc) ->
    {CM,S2} = element_content(kind(E,S),E,Env),
    type(Els,set_scope(S#xsd_state.scope,S2),
	 Env,[CM|Acc]);
type([_H|Els],S,Env,Acc) ->
    type(Els,S,Env,Acc);
type([],S,_Env,Acc) ->
    {flatten(reverse(Acc)),S}.

simpleUrType() ->
    {anySimpleType,[]}.
%% simpleUrTypeRef() ->
%%     {anySimpleType,[],'http://www.w3.org/2001/XMLSchema'}.
urType() ->
    {anyType,[]}.


attribute_type(Att,Env=[Name|_],S) ->
    %% The attribute type may be referenced by the type attribute or
    %% explicitly defined as a simpleType inside the attribute
    %% element. In the latter case the type must be saved with the
    %% unique name of the scope and name attribute combined.
    {CM,S2} = type(Att#xmlElement.content,in_scope(Name,S),Env),
    case remove_annotation(CM) of
	[] ->
	    case keyNsearch(type,#xmlAttribute.name,
			    Att#xmlElement.attributes,[]) of
		#xmlAttribute{value=SimpleTypeName} -> %% a QName as string
		    %% This name may be a forward reference to a simple type.
		    TypeRef = {simpleType,get_QName(SimpleTypeName, %%QQQ
						    Att#xmlElement.namespace,
						    reset_scope(S))},
		    {[TypeRef],
		     set_scope(S#xsd_state.scope,add_ref(S2,TypeRef))};
		_ -> {[{simpleType,simpleUrType()}],
		      set_scope(S#xsd_state.scope,S2)}
	    end;
	Type  ->
	    {Type,set_scope(S#xsd_state.scope,S2)}
    end.

element_type(El,Env=[Name|_],S) ->
    %% In the top environment of the schema there may exist: global
    %% element declarations, substitution group members.
    %% Other element declarations are local
    {CM,S2} = type(El#xmlElement.content,in_scope(Name,S),Env),
    case remove_annotation(CM) of
	[] -> %% no simple or complex type definition
	    case {get_attribute_value(type,El,no_name),
		  get_attribute_value(substitutionGroup,El,undefined)} of
		{no_name,SGName} when is_list(SGName) ->
		    QN = get_QName(SGName,El#xmlElement.namespace,reset_scope(S)),%%QQQ
		    case is_simple_type(QN,S2) of
			true ->
			    exit(this_can_never_happen),
			    %% A substitutionGroup is an element, and
			    %% the type of this element is the
			    %% resolved type of the referenced
			    %% element.
			    TRef = {simpleType,QN},
			    {[TRef],
			     add_ref(set_scope(S#xsd_state.scope,S2),TRef)};
			_ ->
			    {[{substitutionGroup,QN}],
			     set_scope(S#xsd_state.scope,S2)}
		    end;
		{TName,_} when is_list(TName) ->
		    QN = get_QName(TName,El#xmlElement.namespace,reset_scope(S2)),%%QQQ
		    case is_simple_type(QN,S2) of
			true ->
			    TRef={simpleType,QN},
			    {[TRef],
			     add_ref(set_scope(S#xsd_state.scope,S2),TRef)};
			_ ->
			    TRef = {simple_or_complex_Type,QN},
			    {[TRef],
			     add_ref(set_scope(S#xsd_state.scope,S2),TRef)}
		    end;
		_ ->
		    case {get_attribute_value(ref,El,no_name),
			  is_global_env(Env)} of
			{Ref,false} when is_list(Ref) ->
			    %% a ref attribute references an element
			    {[{element,
			      get_QName(Ref,El#xmlElement.namespace,%%QQQ
					reset_scope(S))}],
			     set_scope(S#xsd_state.scope,S2)};
			_ ->
			    {[urType()],
			     set_scope(S#xsd_state.scope,S2)}
		    end
	    end;
%% 	Type ->
%% 	    {Type,set_scope(S#xsd_state.scope,S2)}
	_Type ->
	    {CM,set_scope(S#xsd_state.scope,S2)}
    end.

%% list_type/3 -> list() | name()
list_type(L,S,Env) ->
    case keyNsearch(itemType,#xmlAttribute.name,L#xmlElement.attributes,[]) of
	[] ->
%%	    {element(1,type(L#xmlElement.content,S,Env)),S};
	    type(L#xmlElement.content,S,Env);
	#xmlAttribute{value=V} ->
	    %% this type should be preliminary saved and checked after
	    %% the parsing of the schema.
	    TypeRef ={simpleType,
		      get_QName(V,L#xmlElement.namespace,reset_scope(S))},
	    {[TypeRef],add_ref(S,TypeRef)}
    end.
union_types(U,S,Env) ->
    {MemberTypes,S2} =
	case keyNsearch(memberTypes,#xmlAttribute.name,U#xmlElement.attributes,[]) of
	    [] ->
		{[],S};
	    #xmlAttribute{value = NameString} ->
		Names = namestring2namelist(NameString),
		UTypeRefs =
		    [{simpleType,get_QName(X,U#xmlElement.namespace,
					   reset_scope(S))}||X<-Names],
		{UTypeRefs,foldl(fun(X,S_in) -> add_ref(S_in,X) end,S,UTypeRefs)}
	end,
    {DefinedTypes,S3} = union_types1(U#xmlElement.content,S2,Env),
    {MemberTypes++DefinedTypes,S3}.

union_types1(C,S,Env) ->
    union_types1(C,S,Env,[]).
union_types1([],S,_Env,Acc) ->
    {Acc,S};
union_types1([C=#xmlElement{}|Cs],S,Env,Acc) ->
    case element_content(kind(C,S),C,Env) of
	{ST={simpleType,_},S2} ->
	    union_types1(Cs,S2,Env,[ST|Acc]);
	{{annotation,_},S2} ->
	    union_types1(Cs,S2,Env,Acc);
	{IllegalType,S2} ->
	    Err = {error_path(C,C#xmlElement.name),?MODULE,
		   {union_member_type_not_simpleType,IllegalType}},
	    union_types1(Cs,acc_errs(S2,Err),Env,Acc)
    end;
union_types1([_H|T],S,Env,Acc) ->
    union_types1(T,S,Env,Acc).

%% If a group in a redefine refer to itself the reference is to the
%% "old" definition of the group. See XMLSchema part 1, section 4.2.2
%% "Schema Representation Constraint: Individual Component
%% Redefinition"
recursive_redefine(Name,CM,S=#xsd_state{redefine=true}) ->
    case remove_annotation(CM) of
	[{MG,{C,Occ}}] ->
	    [{MG,{recursive_redefine2(Name,C,S),Occ}}];
	_ ->
	    CM
    end;
recursive_redefine(_,CM,_) ->
    CM.
recursive_redefine2(Name,[{group,{Name,Occ}}|T],S) ->
    %% Rename old group definition
    case rename_redef_group(Name,S) of
	failed ->
	    [{group,{Name,Occ}}|T];
	NewName ->
	    [{group,{NewName,Occ}}|T]
    end;
recursive_redefine2(Name,[{MG,{C,Occ}}|T],S)
  when MG =:= sequence; MG =:= choice; MG=:= all; MG=:= group ->
    C2 = recursive_redefine2(Name,C,S),
    [{MG,{C2,Occ}}|recursive_redefine2(Name,T,S)];
recursive_redefine2(Name,[H|T],S) ->
    [H|recursive_redefine2(Name,T,S)];
recursive_redefine2(_,[],_) ->
    [].

rename_redef_group(Name={LN,Scope,NS},S) ->
    %% Scope must be []
    NewName = {LN,['#redefine'|Scope],NS},
    case resolve({group,NewName},S) of
	{SG=#schema_group{name=Name},_} ->
	    _ = save_object({group,SG#schema_group{name=NewName}},S),
	    NewName;
	_ ->
	    failed
    end.


add_ref(S=#xsd_state{unchecked_references=UR},STRef={simpleType,Ref}) ->
    case {is_builtin_simple_type(Ref),Ref} of
	{true,_} ->
	    S;
	{_,{'',_,_}} ->
	    S;
	_ ->
	    S2 = S#xsd_state{unchecked_references=add_once(STRef,UR)},
	    add_circularity_ref(STRef,S2)
    end;
add_ref(S=#xsd_state{unchecked_references=UR},STRef={simple_or_complex_Type,Ref}) ->
    case {is_builtin_simple_type(Ref),Ref} of
	{true,_} ->
	    S;
	{_,{'',_,_}} ->
	    S;
	{_,{anyType,_,?XSD_NAMESPACE}} ->
	    S;
	{_,{anySimpleType,_,?XSD_NAMESPACE}} ->
	    S;
	_ ->
	    S2 = S#xsd_state{unchecked_references=add_once(STRef,UR)},
	    add_circularity_ref(STRef,S2)
    end;
add_ref(S,{complexType,{anyType,_,?XSD_NAMESPACE}}) ->
    S;
add_ref(S=#xsd_state{unchecked_references=UR},Ref) ->
    S2 = S#xsd_state{unchecked_references=add_once(Ref,UR)},
    add_circularity_ref(Ref,S2).
%% add_ref(S=#xsd_state{unchecked_references=UR},Ref) ->
%%     S#xsd_state{unchecked_references=add_once(Ref,UR)}.

%% Name of simpleType/complexType is unique within the whole
%% environment, which is checked elsewhere, so ignore the kind of type
%% for simplicity.
add_circularity_ref(Ref={Kind,To},S=#xsd_state{circularity_disallowed=CD,
					       redefine=false})
  when Kind==simpleType;Kind==simple_or_complex_Type;Kind==complexType ->
    case get_circularity_mark(Ref,S) of
	[] ->
	    S;
	From -> %% This is the node from which the graph reaches Ref
	    S#xsd_state{circularity_disallowed=add_once({From,{typeDef,To}},CD)}
    end;
add_circularity_ref(_,S) ->
    S.
get_circularity_mark({TD,_},S)
  when TD==simpleType;TD==complexType;TD==simple_or_complex_Type ->
    case S#xsd_state.circularity_stack of
	[From={typeDef,_}|_] ->
	    From;
	_ -> []
    end;
get_circularity_mark(_,_S) ->
    [].

push_circularity_mark(Mark,S=#xsd_state{circularity_stack=CS,
					redefine=false}) ->
    S#xsd_state{circularity_stack=[Mark|CS]};
push_circularity_mark(_,S) ->
    S.
pop_circularity_mark(Mark,S=#xsd_state{redefine=false}) ->
    case S#xsd_state.circularity_stack of
	[Mark|Rest] ->
	    S#xsd_state{circularity_stack=Rest};
	_ ->
	    S
    end;
pop_circularity_mark(_,S) ->
    S.

derived_type({complexType,#schema_complex_type{name=Name,content=C}},
	     S=#xsd_state{derived_types=DT}) ->
    case {keymember(restriction,1,C),keymember(extension,1,C)} of
	{false,false} ->
	    S;
	_ ->
	    S#xsd_state{derived_types=[{complexType,Name}|DT]}
    end;
derived_type({simpleType,#schema_simple_type{name=Name,content=C}},
	     S=#xsd_state{derived_types=DT}) ->
    case keymember(restriction,1,C) of
	true ->
	    S#xsd_state{derived_types=[{simpleType,Name}|DT]};
	_ ->
	    S
    end.

facets([{annotation,_}|Rest],S) ->
    facets(Rest,S);
facets([{restriction,{BaseType,CM}}],_S) ->
    Facets = [X||X={F,_} <- CM,is_facet(F)],
    GroupFacets = group_facets(Facets),
    {BaseType,GroupFacets};
facets(_,_S) ->
    {undefined,[]}.

group_facets(Facets) ->
    group_facets(Facets,[]).
group_facets(L=[{enumeration,_}|_Rest],Acc) ->
    {Enums,Rest} = splitwith(fun({enumeration,_}) -> true;
				       (_) -> false
				    end,
				    L),
    group_facets(Rest,[{enumeration,[X||{enumeration,X}<-Enums]}|Acc]);
group_facets([H|T],Acc) ->
    group_facets(T,[H|Acc]);
group_facets([],Acc) ->
    reverse(Acc).

simpleType_final(ST,_S) ->
    Final = get_attribute_value(final,ST,[]),
    split_by_whitespace(Final,[]).

%% A redefine may contain (simpleType | complexType | group |
%% attributeGroup)*
%%{simpleType,Name},{complexType,Name},{group,Name},{attributeGroup,Name}
redefine([CM|Rest],S) ->
    S2=redefine(CM,S),
    redefine(Rest,S2);
redefine(ST={Type,_Name},S)
  when Type==simpleType ; Type==complexType ->
    %% Get the original definition
    {OriginalType,S2} = resolve(ST,S),
    %% unnecessary to delete saved object, it will be overwritten.
    {RedefinedType,S3} = load_redefine_object(ST,S2),
    {_MergedType,S4} = merge_derived_types(OriginalType,RedefinedType,redefine,S3),
    S4;
redefine(_,S) ->
    %% attributeGroup and group redefines are already redefined
    S.

keyrefer(keyref,El,S) ->
    Ref=get_attribute_value(refer,El,undefined),
    get_QName(Ref,El#xmlElement.namespace,reset_scope(S));
keyrefer(_,_,_) ->
    undefined.

remove_annotation(CM) when is_list(CM) ->
    [X||X = {K,_} <- CM, K=/=annotation].
remove_attributes(CM) when is_list(CM) ->
    [X||X = {K,_} <- CM, K=/=attribute,K=/=anyAttribute,K=/=attributeGroup].
keep_attributes(CM) when is_list(CM) ->
    [X||X = {K,_} <- CM, K==attribute orelse K==anyAttribute orelse K==attributeGroup].
split_content([{restriction,{BaseT,CM}}]) ->
    {[{restriction,{BaseT,remove_attributes(CM)}}],keep_attributes(CM)};
split_content([{extension,{BaseT,CM}}]) ->
    {[{extension,{BaseT,remove_attributes(remove_annotation(CM))}}],
     keep_attributes(CM)};
split_content(CM) ->
    {remove_attributes(CM),keep_attributes(CM)}.

restriction_base_type(R,CM,S) ->
    case base_type(R) of
	[] ->
	    case [X||X={simpleType,_}<-CM] of
		[{simpleType,TypeName}] ->
		    {TypeName,keydelete(simpleType,1,CM),S};
		Other ->
		    Err = {error_path(R,R#xmlElement.name),?MODULE,
			   {missing_base_type,restriction,Other}},
		    {{[],[],[]},CM,acc_errs(S,Err)}
	    end;
	BT ->
	    {get_QName(BT,R#xmlElement.namespace,reset_scope(S)),CM,S}
    end.

base_type([{restriction,{BaseT,_}}],SCT) ->
    SCT#schema_complex_type{base_type=BaseT};
base_type([{extension,{BaseT,_}}],SCT) ->
    SCT#schema_complex_type{base_type=BaseT};
base_type(_,SCT) ->
    SCT.

variety([{list,_ItemType}]) ->
    list;
variety([{union,_ItemType}]) ->
    union;
variety(_) ->
    atomic.

%% pre_check_cm/2 is for now only for simpleContent | complexContent
%% which allow content: (annotation?, (restriction | extension))
pre_check_cm(Kind,Cs=[C=#xmlElement{}|RestC],Name,S) ->
    case kind(C,S) of
	{annotation,_} ->
	    pre_check_cm2(Kind,RestC,Name,C,S,0);
	{_,S2} ->
	    pre_check_cm2(Kind,Cs,Name,C,S2,0)
    end;
pre_check_cm(Kind,[_C|Cs],Name,S) ->
    pre_check_cm(Kind,Cs,Name,S);
pre_check_cm(Kind,[],Name,S) ->
    Err = {[],?MODULE,{content_failure,Kind,[],Name}},
    acc_errs(S,Err).

pre_check_cm2(Kind,[C=#xmlElement{}|Cs],Name,_El,S,N) ->
    S2 =
    case kind(C,S) of
	{restriction,_} ->
	    S;
	{extension,_} ->
	    S;
	{Other,S1} ->
	    Err = {error_path(C,C#xmlElement.name),?MODULE,
		   {illegal_element,Kind,Other,Name}},
	    acc_errs(S1,Err)
    end,
    pre_check_cm2(Kind,Cs,Name,C,S2,N+1);
pre_check_cm2(Kind,[_H|T],Name,El,S,N) ->
    pre_check_cm2(Kind,T,Name,El,S,N);
pre_check_cm2(_,[],_,_,S,N) when N==1 ->
    S;
pre_check_cm2(Kind,[],Name,El,S,N) ->
    Err =
	case N of
	    0 ->
		{error_path(El,El#xmlElement.name),?MODULE,
		 {content_failure_expected_restriction_or_extension,
		  Kind,Name}};
	    _ ->
		{error_path(El,El#xmlElement.name),?MODULE,
		 {content_failure_only_one_restriction_or_extension_allowed,
		  Kind,Name}}
	end,
    acc_errs(S,Err).


%% check_cm(Arg1,Arg2,Arg3)
%% Arg1 - The allowed content for this type according to schema for schemas
%% Arg2 - The content model of this particular schema
check_cm(Kind,S4SCM,ContentModel,S) ->
    case check_cm2(Kind,S4SCM,ContentModel,S) of
	{[],_S} ->
	    S;
	{[_,[]|_],_S} ->
	    S;
	{_CM,S2} ->
	    S2;
	Err ->
	    exit({error,{[],?MODULE,{internal_error,Err}}})
    end.

check_cm2(Kind,#chain{content=S4SCM,occurrence=Occ},
	 ContentModel,S) ->
    case occurance_loop(Occ,fun check_chain/1,
			[S4SCM,ContentModel,Kind,S],0) of
  	{ok,[]} ->
 	    {[],S};
	{ok,[S4SCMRest,CMRest|_]} ->
	    case all_optional(S4SCMRest) of
		true ->
		    {CMRest,S};
		_ ->
		    Err = {[],?MODULE,
			   {mandatory_component_missing,S4SCMRest,Kind}},
		    acc_errs(S,Err)
	    end;
	{error,{_,_,Reason}} ->
	    Err = {[],?MODULE,{illegal_content,Reason,Kind}},
	    {ContentModel,acc_errs(S,Err)}
    end;
check_cm2(Kind,#alternative{content=S4SCM,occurrence=Occ},
	 ContentModel,S) ->
    case occurance_loop(Occ,fun check_alternative/1,
			[S4SCM,ContentModel,Kind,S],0) of
	{ok,[]} ->
	    {[],S};
	{ok,[_,CMRest|_]} ->
	    {CMRest,S};
	{error,Reason} ->
	    {ContentModel,acc_errs(S,Reason)}
    end;
check_cm2(_,{Kind,Occ},CM,S) ->
    case occurance_loop(Occ,fun check_simple_cm/1,[Kind,CM],0) of
 	{ok,[]} ->
	    {[],S};
	{ok,[_,CMRest|_]} ->
	    {CMRest,S};
	{error,Reason} ->
	    {CM,acc_errs(S,Reason)};
	Err ->
	    {CM,acc_errs(S,Err)}
    end.

%% check_simple_cm
check_simple_cm([Kind,CM]) ->
    check_simple_cm(Kind,CM).


check_simple_cm(Kind,[]) ->
    {error,{[],?MODULE,{no_match,{Kind,[]}}}};
check_simple_cm(Kind,[{Kind,_}|Rest]) ->
    {ok,[Kind,Rest]};
check_simple_cm(Kind,[{Other,_}|Rest])
  when Kind==simpleType;Kind==complexType ->
    case Other of
	simple_or_complex_Type -> {ok,[Kind,Rest]};
	_ -> {error,{[],?MODULE,{no_match,Other}}}
    end;
check_simple_cm(_Kind,[{Other,_}|_]) ->
    {error,{[],?MODULE,{no_match,Other}}}.


check_chain([S4SCM,ContentModel,Kind,S]) ->
    check_chain(Kind,S4SCM,ContentModel,S).
check_chain(Kind,[S4SC|S4SCs],ChainCM=[_H|_T],
	    S=#xsd_state{errors=Errs}) ->
    NewKind =
	case S4SC of
	    {NK,_} -> NK;
	    _ -> Kind
	end,
    case check_cm2(NewKind,S4SC,ChainCM,S) of
	{ChainCMRest,#xsd_state{errors=Errs}} ->
	    check_chain(Kind,S4SCs,ChainCMRest,S);
	{_ChainCMRest,_S2} ->
	    case optional(S4SC) of
		true ->
		    check_chain(Kind,S4SCs,ChainCM,S);
		_ ->
		    {error,{[],?MODULE,{unmatched_mandatory_object,Kind,S4SC}}}
	    end
    end;
check_chain(Kind,[],CM,S) ->
    {ok,[[],CM,Kind,S]};
check_chain(Kind,Rest,CM,S) ->
    case all_optional(Rest) of
	true ->
	    {ok,[Rest,CM,Kind,S]}; %% or {ok,[[],CM,Kind,S]}
	_ ->
	    {error,{[],?MODULE,{bad_match,Rest,CM}}}

    end.


check_alternative([S4SC,CM,Kind,S]) ->
    check_alternative(Kind,S4SC,CM,S).
check_alternative(Kind,[S4SC|S4SCs],AltCM = [_H|_T],
		  S=#xsd_state{errors=Err})  ->
    NewKind =
	case S4SC of
	    {NK,_} -> NK;
	    _ -> Kind
	end,
    case check_cm2(NewKind,S4SC,AltCM,S) of
	{AltCMRest,#xsd_state{errors=Err}} ->
	    {ok,[[S4SC],AltCMRest,Kind,S]};
	{AltCMRest,_S2} ->
	    check_alternative(Kind,S4SCs,AltCMRest,S)
    end;
check_alternative(Kind,[],_AltCM,_S) ->
    {error,{[],?MODULE,{no_match,Kind}}}.


%% occurance_loop keeps track of the right number of elements
%% Third argument is a list: [S4SContent,ContentModel]
%% returns {ok,Rest} where Rest is the next unmatched abstract
%% structure.
occurance_loop({Min,Max},_CheckFun,[_,[]|_Rest],N)
  when Min =< N, Max >= N ->
    {ok,[]};
occurance_loop(Occ={Min,Max},CheckFun,Args,N) ->
    Nplus1 = N+1,
    case CheckFun(Args) of
	{error,{_,_,{no_match,_}}} when Min =< N, Max >= N  ->
	    {ok,Args};
	Err = {error,_} ->
	    Err;
	{ok,Args} ->
	    {error,{[],?MODULE,{no_match,occurance_kind(Args)}}};
	{ok,NewArgs} when Nplus1 < Max ->
	    occurance_loop(Occ,CheckFun,NewArgs,Nplus1);
	Ret = {ok,_NewArgs} ->
	    Ret
    end.

occurance_kind([Kind,_]) ->
    Kind;
occurance_kind([_,_,Kind,_]) ->
    Kind;
occurance_kind(_) ->
    [].
%% if_simple_hd(S4SCM,ConstrCM)
%%   when is_record(S4SCM,chain);is_record(S4SCM,alternative);is_list(S4SCM) ->
%%     ConstrCM;
%% if_simple_hd(_,[H|_Tl]) ->
%%     H.

%% if_simple_tl(S4SCM,_ConstrCM)
%%   when is_record(S4SCM,chain);is_record(S4SCM,alternative);is_list(S4SCM) ->
%%     [];
%% if_simple_tl(_,[_|Tl]) ->
%%     Tl.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

count_occur({Min,Max}) ->
%    {decrease(Min),decrease(Max)};
    {decrease(Min),Max};
count_occur(Other) ->
    Other.

decrease(I) when is_integer(I), I > 0 ->
    I-1;
decrease(I) ->
    I.

decrease_occurance({K,{ID,Occ}}) ->
    {K,{ID,count_occur(Occ)}};
decrease_occurance(Other) ->
    Other.

get_occur({_,{_,Occ={Min,_}}}) when is_integer(Min) ->
    Occ;
get_occur({_,{_,Occ={Min,_},_}}) when is_integer(Min) ->
    Occ;
get_occur(Other) ->
    Other.

%% remove_whitespace(L=[T=#xmlText{}|Rest]) ->
%%     case is_whitespace(T) of
%% 	true ->
%% 	    remove_whitespace(Rest);
%% 	_ -> L
%%     end;
%% remove_whitespace(L) ->
%%     L.

optional(optional_text) ->
    true;
optional({_,{0,_}}) ->
    true;
optional({_,{_,{0,_}}}) ->
    true; %% sequence, all or choice
optional({any,{_,{0,_},_}}) ->
    true;
optional(#chain{occurrence={0,_}}) ->
    true;
optional(#alternative{occurrence={0,_}}) ->
    true;
optional(#chain{content=Content}) ->
    try
        is_optional_content(Content)
    catch
        throw:false -> false
    end;
optional(#alternative{content=Content}) ->
    try
        is_optional_content(Content)
    catch
        throw:false -> false
    end;
optional({all,{Content,_}}) ->
    try
        is_optional_content(Content)
    catch
        throw:false -> false
    end;
optional(_) ->
    false.

is_optional_content([H|T]) ->
    case optional(H) of
	true ->
	    is_optional_content(T);
	false ->
	    throw(false)
    end;
is_optional_content([]) ->
    true.

not_optional(X) ->
    case optional(X) of
	true ->
	    false;
	_ ->
	    true
    end.

all_optional([]) ->
    true;
all_optional(L) ->
    case filter(fun not_optional/1,L) of
	[] ->
	    true;
	_ ->
	    false
    end.


%% allowed_content/2 returns a representation of the allowed content
%% model for that object
allowed_content(element,_Parents) ->
    #chain{content=
	      [{annotation,{0,1}},
	       #chain{content=
			 [#alternative{content=
				  [{simpleType,{1,1}},{complexType,{1,1}}],
				  occurrence={0,1}},
			  #alternative{content=
				  [{unique,{1,1}},{key,{1,1}},{keyref,{1,1}}],
				  occurrence={0,unbounded}}]
			}]
	     };
allowed_content(attribute,_Parents) ->
    #chain{content=[{annotation,{0,1}},{simpleType,{0,1}}]};
allowed_content(complexType,Parents) ->
    #chain{content=
	[{annotation,{0,1}},
	 #alternative{content=
	    [set_occurance(allowed_content(simpleContent,Parents),{1,1}),
	     set_occurance(allowed_content(complexContent,Parents),{1,1}),
	     #chain{content=
		    [#alternative{content=
				  [{group,{1,1}},{all,{1,1}},
				   {choice,{1,1}},{sequence,{1,1}}],
				  occurrence={0,1}},
		     #chain{content=
			    [#alternative{content=
					  [{attribute,{1,1}},
					   {attributeGroup,{1,1}}],
					  occurrence={0,unbounded}},
			     {anyAttribute,{0,1}}]
			   }
		    ]
		   }
	    ]
		     }
	]
	  };
allowed_content(attributeGroup,Parents) ->
    case member(simpleContent,Parents) of
	true ->
	    {annotation,{0,1}};
	_ ->
	    #chain{content=
		      [{annotation,{0,1}},
		       #chain{content=
				 [#alternative{content=
					  [{attribute,{1,1}},
					   {attributeGroup,{1,1}}],
					  occurrence={0,unbounded}},
				  {anyAttribute,{0,1}}]}]}
    end;
allowed_content(group,_Parents) ->
    #chain{content=
	      [{annotation,{0,1}},
	       #alternative{content=
		       [{all,{1,1}},{choice,{1,1}},{sequence,{1,1}}],
		       occurrence={0,1}}]};
allowed_content(all,_Parents) ->
    #chain{content=[{annotation,{0,1}},{element,{0,unbounded}}]};
allowed_content(SorC,_Parents) when SorC==sequence;SorC==choice ->
    #chain{content=
	      [{annotation,{0,1}},
	       #alternative{content=
		       [{element,{1,1}},{group,{1,1}},
			{choice,{1,1}},{sequence,{1,1}},
			{any,{1,1}}],
		       occurrence={0,unbounded}}]};
%% allowed_content(E,_Parents)
%%   when E==any;E==selector;E==field;E==notation;E==include;E==import;
%%        E==anyAttribute ->
%%     {annotation,{0,1}};
%% allowed_content(UKK,_Parents) when UKK==unique;UKK==key;UKK==keyref->
%%     #chain{content=
%% 	      [{annotation,{0,1}},
%% 	       #chain{content=
%% 			 [{selector,{1,1}},{selector,{1,unbounded}}]}]};
%% allowed_content(annotation,_Parents) ->
%%     #alternative{content=[{appinfo,{1,1}},{documentation,{1,1}}],
%% 	    occurrence={0,unbounded}};
%% allowed_content(E,_Parents) when E==appinfo;E==documentation ->
%%     {any,{0,unbounded}};
allowed_content(simpleType,_Parents) ->
    #chain{content=
	      [{annotation,{0,1}},
	       #alternative{content=[{restriction,{1,1}},{list,{1,1}},
				{union,{1,1}}]}]};
allowed_content(restriction,Parents) ->
    case member(simpleType,Parents) of
	true ->
	    allowed_content2(restriction,simpleType);
	_ ->
	    case member(simpleContent,Parents) of
		true ->
		    allowed_content2(restriction,simpleContent);
		_ ->
		    allowed_content2(restriction,complexContent)
	    end
    end;
allowed_content(LU,_Parent) when LU==list;LU==union ->
    #chain{content=[{annotation,{0,1}},{simpleType,{0,1}}]};
%% allowed_content(schema,_) ->
%%     #chain{content=
%% 	      [#alternative{content=
%% 		       [{include,{1,1}},{import,{1,1}},
%% 			{redefine,{1,1}},{annotation,{1,1}}],
%% 		       occurrence={0,1}},
%% 	       #chain{content=
%% 			 [#alternative{content=
%% 				  [#alternative{content=
%% 					   [{simpleType,{1,1}},{complexType,{1,1}},
%% 					    {group,{1,1}},{attributeGroup,{1,1}}]},
%% 				   {element,{1,1}},
%% 				   {attribute,{1,1}},
%% 				   {notation,{1,1}}]},
%% 			  {annotation,{0,unbounded}}],
%% 			 occurrence={0,unbounded}}]};
allowed_content(redefine,_Parents) ->
    #alternative{content=
	    [{annotation,{1,1}},
	     #alternative{content=
		     [{simpleType,{1,1}},{complexType,{1,1}},
		      {group,{1,1}},{attributeGroup,{1,1}}]}],
	    occurrence={0,unbounded}};
allowed_content(E,_Parents) when E==simpleContent;
				 E==complexContent ->
    #chain{content=
	      [{annotation,{0,1}},
	       #alternative{content=
		       [{restriction,{1,1}},{extension,{1,1}}]}]};
allowed_content(extension,Parents) ->
    case member(simpleContent,Parents) of
	true ->
	    allowed_content2(extension,simpleContent);
	_ ->
	    allowed_content2(extension,complexContent)
    end.
%% allowed_content(minExclusive,_Parents) ->
%%     [];
%% allowed_content(minInclusive,_Parents) ->
%%     [];
%% allowed_content(maxExclusive,_Parents) ->
%%     [];
%% allowed_content(maxInclusive,_Parents) ->
%%     [];
%% allowed_content(totalDigits,_Parents) ->
%%     [];
%% allowed_content(fractionDigits,_Parents) ->
%%     [];
%% allowed_content(length,_Parents) ->
%%     [];
%% allowed_content(minLength,_Parents) ->
%%     [];
%% allowed_content(maxLength,_Parents) ->
%%     [];
%% allowed_content(enumeration,_Parents) ->
%%     [];
%% allowed_content(whiteSpace,_Parents) ->
%%     [];
%% allowed_content(pattern,_Parents) ->
%%     [].




allowed_content2(restriction,simpleType) ->
    #chain{content=
	      [{annotation,{0,1}},
	       #chain{content=
			 [{simpleType,{0,1}},
			  #alternative{content=
				  [{minExclusive,{1,1}},{minInclusive,{1,1}},
				   {maxExclusive,{1,1}},{maxInclusive,{1,1}},
				   {totalDigits,{1,1}},{fractionDigits,{1,1}},
				   {length,{1,1}},{minLength,{1,1}},
				   {maxLength,{1,1}},{enumeration,{1,1}},
				   {whiteSpace,{1,1}},{pattern,{1,1}}],
				  occurrence={0,unbounded}}]}]};
allowed_content2(restriction,simpleContent) ->
    #chain{content=
	      [{annotation,{0,1}},
	       #chain{content=
			[{simpleType,{0,1}},
			 #alternative{content=
				 [{minExclusive,{1,1}},{minInclusive,{1,1}},
				  {maxExclusive,{1,1}},{maxInclusive,{1,1}},
				  {totalDigits,{1,1}},{fractionDigits,{1,1}},
				  {length,{1,1}},{minLength,{1,1}},
				  {maxLength,{1,1}},{enumeration,{1,1}},
				  {whiteSpace,{1,1}},{pattern,{1,1}}],
				 occurrence={0,unbounded}}],
			 occurrence={0,1}},
	       #chain{content=
			 [#alternative{content=
				 [{attribute,{1,1}},{attributeGroup,{1,1}}],
				  occurrence={0,unbounded}},
			  {anyAttribute,{0,1}}]}]};
allowed_content2(restriction,complexContent) ->
    #chain{content=
	      [{annotation,{0,1}},
	       #alternative{content=
		       [{group,{1,1}},{all,{1,1}},{choice,{1,1}},
			{sequence,{1,1}}],
		       occurrence={0,1}},
	       #chain{content=
			 [#alternative{content=
				  [{attribute,{1,1}},{attributeGroup,{1,1}}],
				  occurrence={0,unbounded}},
			  {anyAttribute,{0,1}}]}]};
allowed_content2(extension,simpleContent) ->
    #chain{content=
	      [{annotation,{0,1}},
	       #chain{content=
			 [#alternative{content=
				  [{attribute,{1,1}},{attributeGroup,{1,1}}],
				  occurrence={0,unbounded}},
			  {anyAttribute,{0,1}}]}]};
allowed_content2(extension,complexContent) ->
    #chain{content=
	      [{annotation,{0,1}},
	       #chain{content=
			 [#alternative{content=
				  [{group,{1,1}},{all,{1,1}},{choice,{1,1}},
				   {sequence,{1,1}}],
				  occurrence={0,1}},
			  #chain{content=
				    [#alternative{content=
					     [{attribute,{1,1}},
					      {attributeGroup,{1,1}}],
					     occurrence={0,1}},
				     {anyAttribute,{0,1}}]}]}]}.


set_occurance(Ch = #chain{},Occ) ->
    Ch#chain{occurrence=Occ};
set_occurance(Alt = #alternative{},Occ) ->
    Alt#alternative{occurrence=Occ};
set_occurance({Name,_},Occ) when is_atom(Name) ->
    {Name,Occ}.
%% set_occurance(CM,_) ->
%%     CM.


process_external_schema_once(E,Namespace,S) when is_record(E,xmlElement) ->
    case get_attribute_value(schemaLocation,E,[]) of
	[] ->
	    Err = {missing_schemalocation_attribute,E#xmlElement.name},
	    acc_errs(S,Err);
	Path ->
	    process_external_schema_once(Path,Namespace,S)
    end;
process_external_schema_once(SchemaLocation,Namespace,S) ->
    case fetch_external_schema(SchemaLocation,S) of
	{E=#xmlElement{},S2} ->
	    case is_already_processed(Namespace,S2) of
		true ->
		    save_namespace_definition(Namespace,S2);
		_ ->
		    S3 = save_namespace_definition(Namespace,S2),
		    traverse_ext_schema(E,S3#xsd_state{targetNamespace=Namespace})
	    end;
	{_,S2} ->
	    S2
    end.

%% process_external_schema/2 returns:
%% {ok,some_result()} | {error,reason()}
process_external_schema(Path,S) when is_list(Path) ->
    case fetch_external_schema(Path,S) of
	{E=#xmlElement{},S2} ->
	    traverse_ext_schema(E,S2);
	{_,S2} ->
	    S2
    end;
process_external_schema(absent,S) ->
    S.

fetch_external_schema(Path,S) when is_list(Path) ->
    FetchFun = S#xsd_state.fetch_fun,
    %%    {ExtXSD,S2} =
	case FetchFun(Path,S) of
	    {ok,{file,File},_} ->
		?debug("scanning file: ~p~n",[File]),
		case xmerl_scan:file(File,S#xsd_state.xml_options) of
		    {error,Reason} ->
			{error,acc_errs(S,{[],?MODULE,{parsing_external_schema_failed,File,Reason}})};
		    {EXSD,_} ->
			{EXSD,S#xsd_state{schema_name=File}}
		end;
	    {_,{string,String},_} -> %% this is for a user defined fetch fun that returns an xml document on string format.
		?debug("scanning string: ~p~n",[String]),
                {EXSD,_} = xmerl_scan:string(String,S#xsd_state.xml_options),
                {EXSD,S#xsd_state{schema_name=Path}};
	    {ok,[],_} ->
		{ok,S};
	    {_,Other,_} ->
		{error,acc_errs(S,{[],?MODULE,{fetch_fun_failed,Other}})}
	end;
fetch_external_schema(absent,S) ->
    {ok,S}.


%% The schema name is also important here because a schema may import
%% and must include from the same namespace as the target namespace of
%% the including schema.
is_already_processed(NameSpace,#xsd_state{schema_name=SchemaName,
					  checked_namespace_nodes=CNS}) ->
%%     case {keymember(SchemaName,2,CNS),keymember(NameSpace,3,CNS)} of
%% 	{true,true} ->
    case keysearch(SchemaName,2,CNS) of
	{_,{_,_,NameSpace}} ->
	    true;
	_ ->
	    false
    end.

%%
save_namespace_definition(NameSpace,
			  S=#xsd_state{targetNamespace=TNS,
				       global_namespace_nodes=GNS,
				       checked_namespace_nodes=CNS}) ->
    %% 1) Have to find a matching namespace in the global list for
    %% this schema, and get the associated prefix. 2) Then check
    %% whether a schema with this prefix - namespace combination
    %% already is checked, if so do nothing. 3a) If this namespace is
    %% checked but with another prefix only add the prefix - namespace
    %% pair to the checked namespace list. 3b) Otherwise add the
    %% prefix - namespace pair.
    {Prefix,S2} =
	case keysearch(TNS,1,GNS) of
	    {value,{_,ImportedNodes}} ->
		case keysearch(NameSpace,2,ImportedNodes) of
		    {value,{_P,_}} -> {_P,S};
		    _ -> {none,S}
		end;
	    _ ->
		Err = {[],?MODULE,{imported_namespace_wo_namespace_definition,NameSpace}},
		{none,acc_errs(S,Err)}
	end,
    %% Instead of 2, 3a and 3b just add_once
    case Prefix of
	none ->
	    S2;
	_ ->
	    S#xsd_state{checked_namespace_nodes=
			add_once({Prefix,S#xsd_state.schema_name,NameSpace},CNS)}
    end.

%% prefix_namespace_2global

%% adds {Prefix,Namespace} to the global namespace nodes list for the
%% targetnamespace. Prefix is the right one found in Nodes.
prefix_namespace_2global(Namespace,
			 #xmlNamespace{nodes=Nodes},
			 S=#xsd_state{targetNamespace=TNS,
				     global_namespace_nodes=GNS}) ->
    case keysearch(Namespace,2,Nodes) of
	{value,{Prefix,_}} ->
	    case keysearch(TNS,1,GNS) of
		{value,{_,DefinedNamespaces}} ->
		    S#xsd_state{global_namespace_nodes=
				keyreplace(TNS,1,GNS,
					   {TNS,add_once({Prefix,Namespace},
							 DefinedNamespaces)})};
		_ ->
		    S#xsd_state{global_namespace_nodes=
				[{TNS,[{Prefix,Namespace}|default_namespace_by_convention()]}]}
	    end;
	_ ->
	    S
    end;
prefix_namespace_2global(_,_,S) ->
    S.


traverse_ext_schema(E,S) ->
    TargetNS = target_namespace(E),
    case {TargetNS,S#xsd_state.targetNamespace} of
	{undefined,_} ->
	    traverse_ext_schema2(E,S);
	{TNS,TNS} ->
	    traverse_ext_schema2(E,S);
	_ ->
	    Err = {error_path(E,schema),?MODULE,{illegal_target_namespace_external_schema,E#xmlElement.name}},
	    acc_errs(S,Err)
    end.
traverse_ext_schema2(E,S) ->

    S1 = namespace_nodes(E,S),
    S2 = element_form_default(E,S1),
    S3 = attribute_form_default(E,S2),
    S4 = substitution_default(finalDefault,E,S3),
    S5 = substitution_default(blockDefault,E,S4),
    {CM,S6} = traverse_content2(E#xmlElement.content,S5,[]),
%%    ?debug("External schema S6:~n~p~n",[S6]),
    save_schema_element(CM,S6),
    S6.


attribute_properties([#xmlAttribute{name=default,value=Default}|Rest],
		     Attr,S) ->
    attribute_properties(Rest,Attr#schema_attribute{default=Default},S);
attribute_properties([#xmlAttribute{name=fixed,value=Fixed}|Rest],Attr,S) ->
    attribute_properties(Rest,Attr#schema_attribute{fixed=Fixed},S);
attribute_properties([#xmlAttribute{name=use,value=Use}|Rest],Attr,S) ->
    {Use2,S2} = attribute_use(Use,S),
    attribute_properties(Rest,Attr#schema_attribute{use=Use2},S2);
attribute_properties([#xmlAttribute{name=form,value=Form}|Rest],Attr,S) ->
    {Form2,S2} = attribute_form(Form,S),
    attribute_properties(Rest,Attr#schema_attribute{form=Form2},S2);
attribute_properties([#xmlAttribute{name=id,value=ID}|Rest],Attr,S) ->
    S2 = check_and_save_ID(ID,S),
    attribute_properties(Rest,Attr#schema_attribute{id=ID},S2);
attribute_properties([_H|Rest],Attr,S) ->
    attribute_properties(Rest,Attr,S);
attribute_properties([],Attr,S) ->
    {Attr,S}.
attribute_use(Use,S) when Use=="optional";Use=="prohibited";Use=="required" ->
    {list_to_atom(Use),S};
attribute_use(Use,S) ->
    {Use,acc_errs(S,{[],?MODULE,{illegal_use_value,Use}})}.
attribute_form(Form,S) when Form=="qualified";Form=="unqualified" ->
    {list_to_atom(Form),S};
attribute_form(Form,S) ->
    {Form,acc_errs(S,{[],?MODULE,{illegal_form_value,Form}})}.

element_properties([#xmlAttribute{name=default,value=Default}|Rest],SE,El,S) ->
    case SE#schema_element.value_constraint of
	{fixed,_} ->
	    Err = {error_path(El,schema),?MODULE,{"only one of final/default attributes allowed",
		   El#xmlElement.name}},
	    element_properties(Rest,SE,El,acc_errs(S,Err));
	_ ->
	    element_properties(Rest,SE#schema_element{value_constraint=
						      {default,Default}},El,S)
    end;
element_properties([#xmlAttribute{name=fixed,value=Fixed}|Rest],SE,El,S) ->
    case SE#schema_element.value_constraint of
	{default,_} ->
	    Err = {error_path(El,schema),?MODULE,
		   {"only one of final/default attributes allowed",
		    El#xmlElement.name}},
	    element_properties(Rest,SE,El,acc_errs(S,Err));
	_ ->
	    element_properties(Rest,SE#schema_element{value_constraint=
						      {fixed,Fixed}},El,S)
    end;
element_properties([#xmlAttribute{name=substitutionGroup,value=SG}|Rest],
		   SE,El,S) ->
    SGName = get_QName(SG,El#xmlElement.namespace,reset_scope(S)),
    element_properties(Rest,SE#schema_element{substitutionGroup=SGName},El,
		       add_ref(S,{element,SGName}));
element_properties([#xmlAttribute{name=form,value=F}|Rest],SE,El,S) ->
    {Form,S2} = attribute_form(F,S),
    element_properties(Rest,SE#schema_element{form=Form},El,S2);
element_properties([#xmlAttribute{name=id,value=ID}|Rest],SE,El,S) ->
    S2 = check_and_save_ID(ID,S),
    element_properties(Rest,SE#schema_element{id=ID},El,S2);
element_properties([#xmlAttribute{name=nillable,value=N}|Rest],SE,El,S) ->
    case boolean_to_atom(N) of
	error ->
	    element_properties(Rest,SE,El,
			       acc_errs(S,{error_path(El,schema),?MODULE,{illegal_nillable_value,N}}));
	N_atom ->
	    element_properties(Rest,SE#schema_element{nillable=N_atom},El,S)
    end;
element_properties([#xmlAttribute{name=abstract,value=A}|Rest],SE,El,S) ->
    case boolean_to_atom(A) of
	error ->
	    element_properties(Rest,SE,El,
			       acc_errs(S,{error_path(El,schema),?MODULE,{illegal_abstract_value,A}}));
	A_atom ->
	    element_properties(Rest,SE#schema_element{abstract=A_atom},El,S)
    end;
element_properties([#xmlAttribute{name=block,value=B}|Rest],SE,El,S) ->
    BlockValues = split_by_whitespace(B,[]),
    case legal_block_values(element,BlockValues) of
	{error,Reason} ->
	    element_properties(Rest,SE,El,
			       acc_errs(S,{error_path(El,schema),?MODULE,{illegal_block_values,Reason}}));
	_ ->
	    element_properties(Rest,SE#schema_element{block=BlockValues},El,S)
    end;
element_properties([#xmlAttribute{name=final,value=F}|Rest],SE,El,S) ->
    FinalValues = split_by_whitespace(F,[]),
    case legal_final_values(element,FinalValues) of
	{error,Reason} ->
	    element_properties(Rest,SE,El,
			       acc_errs(S,{error_path(El,schema),?MODULE,{illegal_final_values,Reason}}));
	_ ->
	    element_properties(Rest,SE#schema_element{final=FinalValues},El,S)
    end;
element_properties([_H|T],SE,El,S) ->
    element_properties(T,SE,El,S);
element_properties([],SE,_El,S) ->
    {SE,S}.

%% 3.3.3 bullet 2.2
%% nillable, default, fixed, form, block and type properties must be
%% absent in element with ref.
element_forbidden_properties(El,S) ->
    element_forbidden_properties(El#xmlElement.attributes,El,S).
element_forbidden_properties([#xmlAttribute{name=nillable,value=V}|Atts],El,S) ->
    element_forbidden_properties(Atts,El,acc_errs(S,{error_path(El,schema),?MODULE,{forbidden_property,nillable,V}}));
element_forbidden_properties([#xmlAttribute{name=default,value=V}|Atts],El,S) ->
    element_forbidden_properties(Atts,El,acc_errs(S,{error_path(El,schema),?MODULE,{forbidden_property,default,V}}));
element_forbidden_properties([#xmlAttribute{name=fixed,value=V}|Atts],El,S) ->
    element_forbidden_properties(Atts,El,acc_errs(S,{error_path(El,schema),?MODULE,{forbidden_property,fixed,V}}));
element_forbidden_properties([#xmlAttribute{name=form,value=V}|Atts],El,S) ->
    element_forbidden_properties(Atts,El,acc_errs(S,{error_path(El,schema),?MODULE,{forbidden_property,form,V}}));
element_forbidden_properties([#xmlAttribute{name=block,value=V}|Atts],El,S) ->
    element_forbidden_properties(Atts,El,acc_errs(S,{error_path(El,schema),?MODULE,{forbidden_property,block,V}}));
element_forbidden_properties([#xmlAttribute{name=type,value=V}|Atts],El,S) ->
    element_forbidden_properties(Atts,El,acc_errs(S,{error_path(El,schema),?MODULE,{forbidden_property,type,V}}));
element_forbidden_properties([#xmlAttribute{}|Atts],El,S) ->
    element_forbidden_properties(Atts,El,S);
element_forbidden_properties([],_,S) ->
    S.

%% 3.3.3 bullet 2.2
%% complexType, simpleType, key, keyref and unique must be absent in
%% element with ref.
element_forbidden_content([],S) ->
    S;
element_forbidden_content([El=#xmlElement{}|Els],S) ->
    case kind(El) of
	K when K==complexType;K==simpleType;K==key;K==keyref;K==unique ->
	    acc_errs(S,{error_path(El,schema),?MODULE,{element_content_must_not_contain,K,El}});
	annotation ->
	    element_forbidden_content(Els,S);
	Other ->
	    acc_errs(S,{error_path(El,schema),?MODULE,{illegal_element_content,Other}})
    end;
element_forbidden_content([T=#xmlText{}|Rest],S) ->
    case is_whitespace(T) of
	true ->
	    element_forbidden_content(Rest,S);
	_ ->
	    acc_errs(S,{error_path(T,schema),?MODULE,{illegal_element_content,T}})
    end.

c_t_properties(El,CT,S) ->
    c_t_properties(El#xmlElement.attributes,El,CT,S).
c_t_properties([#xmlAttribute{name=final,value=V}|Rest],El,CT,S) ->
    FinalValues = split_by_whitespace(V,[]),
    case legal_final_values(complexType,FinalValues) of
	{error,Reason} ->
	    Err = {error_path(El,schema),?MODULE,{illegal_final_values,Reason}},
	    c_t_properties(Rest,El,CT,acc_errs(S,Err));
	_ ->
	    c_t_properties(Rest,El,
			   CT#schema_complex_type{final=FinalValues},S)
    end;
c_t_properties([#xmlAttribute{name=block,value=V}|Rest],El,CT,S) ->
    BlockValues = split_by_whitespace(V,[]),
    case legal_block_values(complexType,BlockValues) of
	{error,Reason} ->
	    Err = {error_path(El,schema),?MODULE,
		   {illegal_block_values,Reason}},
	    c_t_properties(Rest,El,CT,acc_errs(S,Err));
	_ ->
	    c_t_properties(Rest,El,CT#schema_complex_type{block=BlockValues},S)
    end;
c_t_properties([#xmlAttribute{name=abstract,value=V}|Rest],El,CT,S) ->
    case boolean_to_atom(V) of
	error ->
	    Err = {error_path(El,schema),?MODULE,
		   {illegal_abstract_value,V}},
	    c_t_properties(Rest,El,CT,acc_errs(S,Err));
	V_atom ->
	    c_t_properties(Rest,El,CT#schema_complex_type{abstract=V_atom},S)
    end;
c_t_properties([_H|T],El,CT,S) ->
    c_t_properties(T,El,CT,S);
c_t_properties([],_,CT,S) ->
    {CT,S}.


legal_block_values(_,['#all']) ->
    true;
legal_block_values(element,BlockValues) ->
    list_members(BlockValues,[extension,restriction,substitution]);
legal_block_values(complexType,BlockValues) ->
    list_members(BlockValues,[extension,restriction]).

legal_final_values(_,['#all']) ->
    true;
legal_final_values(_,FinalValues) ->
    list_members(FinalValues,[extension,restriction]).

boolean_to_atom(B) when B=="1";B=="true" ->
    true;
boolean_to_atom(B) when B=="0";B=="false" ->
    false;
boolean_to_atom(_) ->
    error.


count_num_el(S=#xsd_state{num_el=N}) ->
    S#xsd_state{num_el=N+1}.
set_num_el(S=#xsd_state{},I) when is_integer(I) ->
    S#xsd_state{num_el=I};
set_num_el(S=#xsd_state{},#xsd_state{num_el=I}) ->
    S#xsd_state{num_el=I}.


occurrence(El=#xmlElement{attributes=Atts},{Min,Max},S) ->
    AttVal=fun(#xmlAttribute{value=V},Sin) -> 
		   try mk_int_or_atom(V) of
		       IAV -> {IAV,Sin}
                   catch
		       error:_ ->
			   Err = {error_path(El,schema),?MODULE,
				  {illegal_occurance_value,V}},
			   {V,acc_errs(Sin,Err)}
		   end;
	      (V1,Sin) -> {V1,Sin}
	   end,
    {MinVal,S2} = AttVal(keyNsearch(minOccurs,#xmlAttribute.name,
				    Atts,Min),S),
    {MaxVal,S3} = AttVal(keyNsearch(maxOccurs,#xmlAttribute.name,
				    Atts,Max),S2),
    {{MinVal,MaxVal},S3}.

mk_int_or_atom(V="unbounded") ->
    list_to_atom(V);
mk_int_or_atom(V) when is_list(V) ->
    list_to_integer(V);
mk_int_or_atom(V) ->
    V.

%% E is a complexType, possible kind of content is A)simpleContent, B)
%% complexContent or C) one or zero of 1)group,2)all,3)choice or
%% 4)sequence, followed by any number of attribute or attributeGroup
%% and finally one optional anyAttribute
mixed(E=#xmlElement{content=C},S) ->
    case {get_attribute_value(mixed,E,undefined),
	  [Y||Y=#xmlElement{}<-C,kind(Y)==simpleContent]} of
	{_,[_SCE]} ->
	    {false,S}; %% mixed is false in simpleContent
	{undefined,_} ->
	    case [X||X=#xmlElement{}<-C,
		     kind(X)==complexContent] of
		[E2] ->
%%		    {get_attribute_value(mixed,E2,false),S};
		    mixed(E2,S);
		_ ->
		    {false,S}
	    end;
	{M,_} when M=="1";M=="true" -> {true,S};
	{M,_} when M=="0";M=="false" -> {false,S};
	{M,_} ->
	    Err = {error_path(E,schema),?MODULE,{invalid_mixed_value,M}},
	    {false,acc_errs(S,Err)}
    end.

mixify(false,CM) ->
    CM;
mixify(true,CM) ->
    mixify2(CM,[optional_text]).
mixify2([],Acc) ->
    reverse(Acc);
mixify2([H|T],Acc) ->
    mixify2(T,[optional_text,H|Acc]).

complexity([]) ->
    undefined;
complexity([#xmlText{}|T]) ->
    complexity(T);
complexity([#xmlComment{}|T]) ->
    complexity(T);
complexity([H|T]) ->
    case kind(H) of
	simpleContent ->
	    simple;
	complexContent ->
	    complex;
	_ ->
	    complexity(T)
    end.

%% Validation takes care of the following:
%% 1)	a) Check that targetNamespace attribute in schema matches
%% 	namespace URI if the element.
%% 	b) If schema don't have a targetNamespace the instance element
%% 	must not be namespace-qualified

%% 2)	a) Examine type of the element according to the schema and block
%%           attributes in the element decl.
%% 	b) Default values and other infoset contributions are applied.

%% 3)	Check the immediate attributes and contents of the element
%%         comparing these against the attributes and contents
%%         permitted.
%% 	a) simple type:
%% 	   -verify there are no attributes or elements.
%% 	   -verify character content matches rules for type.
%% 	b) complex type:
%% 	   -verify attributes present and values ok.
%% 	   -check subelements according to content model.
%% validate_xml/2
validate_xml(El = #xmlElement{name=Name},
	     S=#xsd_state{table=Tab,schemaLocations=SchemaLocations}) ->
    ElQName = {_,_,Namespace} = mk_EII_QName(Name,El,S),
    SchemaCM = get_schema_cm(Tab,Namespace),
    case [X||X={element,{QName,Occ}} <- SchemaCM#schema.content,
	     cmp_name(ElQName,QName,S),
	     at_least_one(Occ)] of
	[Obj] ->
	    {Object,S2} = load_object(Obj,S),
	    validate_xml(El,Object,S2);
	_ ->
	    %% In case the namespace in El is not processed even
	    %% though it is present.
	    case is_already_processed(Namespace,S) of
		true -> %% nothing more to do
		    {error,{error_path(El,Name),?MODULE,
			    {element_not_in_schema,[Name,ElQName,SchemaCM]}}};
		_ ->
		    case keysearch(if_atom_to_list(Namespace),1,SchemaLocations) of
			{value,{_,Location}} ->
			    %% namespace present by schemaLocation
			    %% attribute in instance.
			    S1 = prefix_namespace_2global(Namespace,El#xmlElement.namespace,S),
			    S2 = save_namespace_definition(Namespace,S1),
			    S3 = process_external_schema(Location,S2#xsd_state{targetNamespace=Namespace}),
			    validate_xml(El,S3);
			_ -> %% namespace not imported in schema or instance.
			    {error,{error_path(El,Name),?MODULE,
				    {element_not_in_schema,[Name,ElQName,SchemaCM]}}}
		    end
	    end
    end.
%% validate_xml/3
validate_xml(XMLEl=#xmlElement{},SEl=#schema_element{},S) ->
    %% check that targetNamespace of schema matches URI of the element.
    case check_target_namespace(XMLEl,S) of
	ok ->
	    %% Extract the schemaLocation links in the instance,
	    %% examine type of the element according to the schema and
	    %% the block attributes in the element declaration
	    S2 = schemaLocations(XMLEl,S),
	    ?debug("schemaLocations: ~p~n",[S2#xsd_state.schemaLocations]),
	    #schema_element{name=_Name,type=_Type,block=Bl} = SEl,
	    Block = blocking(Bl,S2#xsd_state.blockDefault), %% complex types, elements
	    Ret = check_element_type([XMLEl],SEl,[],Block,S2,[]),
	    case Ret of
		{ValXML,UnvalRest,S3} ->
%%		    S4 = schema_concistence_checks(S3),
		    {ValXML,UnvalRest,S3};
		_ ->
		    Ret
	    end;
	_ ->
	    Err = {error_path(XMLEl,XMLEl#xmlElement.name),?MODULE,
		   {target_namespace_missmatch}},
	    {XMLEl,[],acc_errs(S,Err)}
    end.

%% check_element_type/3
%% examine type according to schema including info of block
%% attributes. If complex type do test recursively
%% 2 often
check_element_type(XML=[XMLTxt=#xmlText{}|Rest],CM=[CMEl|CMRest],Env,
		   Block,S,Checked) ->
    %% XMLTxt is the first part of the elements content,
    %% CMEl is the allowed type according to the schema
    case is_whitespace(XMLTxt) of
	true -> %% Ignore XMLEl
	    check_element_type(Rest,CM,Env,Block,S,[XMLTxt|Checked]);
	_ -> %% CMEl allows optional_text or is an absent optional element
	    {ResolvedT,S2} = resolve(CMEl,S),
	    case check_text_type(XML,ResolvedT,S2) of
		{error,Reason} ->
		    case is_optional(CMEl,S) of
			true ->
			    check_element_type(XML,CMRest,Env,Block,S,Checked);
			_ ->
			    check_element_type(Rest,CM,Env,Block,
					       acc_errs(S,Reason),Checked)
		    end;
		{Ret,Rest2,S3} ->
		    check_element_type(Rest2,CMRest,Env,Block,S3,reverse(Ret,Checked))
	    end
    end;
%% If CMEl is a sequence more than the first element of the XML list
%% may match.
check_element_type(XML=[#xmlElement{}|_],[{sequence,{CM,Occ}}|_CMRest],
		   Env,_Block,S,Checked) ->
    ?debug("calling sequence/6~n",[]),
    check_sequence(XML,CM,Occ,Env,set_num_el(S,0),Checked);
check_element_type(XML=[#xmlElement{}|_],[{choice,{CM,Occ}}|_CMRest],
		   Env,_Block,S,Checked) ->
    ?debug("calling choice/6~n",[]),
    check_choice(XML,CM,Occ,Env,set_num_el(S,0),Checked);
check_element_type(XML=[#xmlElement{}|_],[{all,{CM,Occ}}|_CMRest],
		   Env,_Block,S,Checked) ->
    ?debug("calling choice/6~n",[]),
    check_all(XML,CM,Occ,Env,set_num_el(S,0),Checked,XML); %%LTH
%% 3 often. CMEL may be ((simpleType | complexType)?, (unique | key | keyref)*))
check_element_type(XML=[XMLEl=#xmlElement{}|_],[CMEl|CMRest],Env,
		   Block,S,Checked) ->
    %% Three possible relations between XMLEl - CMEl:
    %% (1) XMLEl matches CMEl.
    %% (2) XMLEl don't matches CMEl and CMEl is optional.
    %% (3) XMLEl don't matches CMEl, CMEl mandatory, - error.
    %% On the other side may CMEl also match more elements in
    %% Rest. This should come down to 2) next function call.

    {ResolvedT,S2} = resolve(CMEl,S),
    case check_element_type(XML,ResolvedT,Env,Block,S2,[]) of
	{error,Reason} -> % 3
	    check_element_type(tl(XML),CMRest,Env,Block,
			       acc_errs(S,Reason),[XMLEl|Checked]);
	{[],_,_} -> % 2
	    check_element_type(XML,CMRest,Env,Block,S,Checked);
	{XMLEl2,RestXML,S3} -> % 1 This return value does not conform to the others
	    check_element_type(RestXML,[decrease_occurance(CMEl)|CMRest],Env,
			       Block,S3,XMLEl2++Checked)
    end;
check_element_type([],[],_Env,_Block,S,Checked) ->
    {Checked,[],S};
check_element_type([],[CMEl|CMRest],Env,Block,S,Checked) ->
    case is_optional(CMEl,S) of
	true ->
	    check_element_type([],CMRest,Env,Block,S,Checked);
	_ ->
	    Err = {error_path(Checked,undefined),?MODULE,
		   {missing_mandatory_element,CMEl}},
	    {Checked,[],acc_errs(S,Err)}
    end;
check_element_type(_XML=[],
		   #schema_complex_type{name=_Name,base_type=BT,
					complexity=simple,
					content=_C} = CT,
		   _Env,_Block,S,Checked) ->

    %% maybe check attributes here as well.
    {ResolvedType,_} = resolve({simple_or_complex_Type,BT},S),
    case ResolvedType of
	#schema_simple_type{} ->
	    {NewVal,S2} = check_type(ResolvedType,[],unapplied,S),
	    {NewVal,[],S2};
	{simpleType,_} ->
	    {NewVal,S2} = check_type(ResolvedType,[],unapplied,S),
	    {NewVal,[],S2};
	_ ->
	    {error,{error_path(Checked,undefined),?MODULE,
		    {empty_content_not_allowed,CT}}}
    end;
check_element_type([],#schema_complex_type{name=_Name,block=_Bl,content=C},
		   _Env,_Block,S,Checked) ->
    %% This type must have an empty content to be valid
    case allow_empty_content(C) of
	true -> {[],[],S};
	false ->
	    {error,{error_path(Checked,undefined),?MODULE,
		    {empty_content_not_allowed,C}}}
    end;
check_element_type(C, {anyType, _}, _Env, _Block, S, _Checked) ->
    %% permitt anything
    {lists:reverse(C), [], S};

check_element_type(XML=[#xmlText{}|_],Type=#schema_simple_type{},
		    _Env,_Block,S,_Checked) ->
    check_text_type(XML,Type,S);
check_element_type(XML=[#xmlText{}|_],Type={simpleType,_NameNS},
		    _Env,_Block,S,_Checked) ->
    check_text_type(XML,Type,S);

check_element_type(XML=[#xmlText{}|_],
		   #schema_complex_type{name=_Name,base_type=BT,
					complexity=simple,
					content=_C},Env,Block,S,Checked) ->

    %% maybe check attributes here as well.
    {ResolvedType,_} = resolve({simple_or_complex_Type,BT},S),
    check_element_type(XML,ResolvedType,Env,Block,S,Checked);

%% single schema object
check_element_type(XML=[_H|_],
		   #schema_complex_type{name=Name,block=Bl,content=C},
		   Env,_Block,S,Checked) ->
    EnvName = case Name of
		  {LN,_Scope,_NS} -> LN;
		  _ -> anonymous
	      end,
    Block = blocking(Bl,S#xsd_state.blockDefault),
    check_element_type(XML,C,[EnvName|Env],Block,name_scope(Name,S),Checked);

%% 1
check_element_type(XML=[XMLEl=#xmlElement{name=Name}|RestXML],
		   CMEl=#schema_element{name=CMName,type=Type},
		   Env,Block,S,Checked) ->
    ElName = mk_EII_QName(Name,XMLEl,S#xsd_state{scope=element(2,CMName)}),
    {Min,Max} = CMEl#schema_element.occurrence,
    case cmp_name(ElName,CMName,S) of %% substitutionGroup
	true when S#xsd_state.num_el =< Max ->
	    S1 = id_constraints(CMEl,XMLEl,S),
	    %% If CMEl element has a substitutionGroup we have to
	    %% switch to the right element and type here.
	    {CMEl2,Type2,S2} =
		if
		    ElName =:= CMName ->
			{CMEl,Type,S1};
		    true ->
			case resolve({element,ElName},S1) of
			    {SESub=#schema_element{type=SubType},Ssub} ->
				{SESub,SubType,Ssub};
			    {_,Ssub} ->
				{CMEl,Type,Ssub}
			end
		end,

	    {ResolvedType,S3} = resolve(Type2,XMLEl,S2),
	    %% What's the value of Resolve?: It must be a simpleType,
	    %% complexType or an identity-constraint object
	    XsiFactors  = xsi_factors(CMEl2),
	    {XMLEl2,S4} = check_attributes(XMLEl,ResolvedType,
					   XsiFactors,S3),
	    S5 = check_abstract(ElName,XMLEl,CMEl,S4),
	    S6 = check_form(ElName,Name,XMLEl,
			    actual_form_value(CMEl#schema_element.form,
					      S5#xsd_state.elementFormDefault),
			    S5),
	    %Step into content of XML element.
	    {Content,_,S7} =
		case
		    check_element_type(XMLEl2#xmlElement.content,
				       ResolvedType,Env,
				       Block,S6,Checked) of
		    {error,Reason} ->
			{XMLEl2#xmlElement.content,[],acc_errs(S6,Reason)};
		    Result ={_,[],_} -> Result;
		    {_,UnexpectedRest,_} ->
			Err = {error_path(XMLEl,Name),?MODULE,
			       {unexpected_rest,UnexpectedRest}},
			{XMLEl2#xmlElement.content,[],
			 acc_errs(S6,Err)}
		end,
	    {[XMLEl2#xmlElement{content=reverse(Content)}],
	     RestXML,
	     set_scope(S5#xsd_state.scope,set_num_el(S7,S6))};
	true ->
	    {error,{error_path(XMLEl, Name), ?MODULE,
		    {element_not_suitable_with_schema, ElName, S}}};
	_ when S#xsd_state.num_el >= Min ->
	    %% it may be a match error or an optional element not
	    %% present
	    {[], XML, S#xsd_state{num_el=0}};
	_ ->
	    {error,{error_path(XMLEl,Name),?MODULE,
		    {element_not_suitable_with_schema,ElName,CMName,CMEl,S}}}
    end;
check_element_type(XML,#schema_group{content=[CM]},Env,Block,S,Checked) ->
    %% content may contain one of all | choice | sequence or empty
    check_element_type(XML,CM,Env,Block,S,Checked);
check_element_type(XML,#schema_group{content=[]},_Env,_Block,_S,_Checked) ->
    {error,{error_path(XML,undefined),?MODULE,{no_element_expected_in_group,XML}}};
check_element_type(XML=[#xmlElement{content=_Content}|_Rest],
		   {sequence,{Els,Occ}},Env,_Block,S,Checked) ->
    ?debug("calling sequence/6~n",[]),
    case check_sequence(XML,Els,Occ,Env,S#xsd_state{num_el=0},Checked) of
	Err = {error,_} ->
	    Err;
	{ValidContent,Rest2,S2} ->
	    %% The sequence may consume more than one element
	    %%{ValidContent,Rest,acc_errs(S2,{sequence_unexpected_rest_objects,UnexpRest})}
	    {ValidContent,Rest2,S2}
    end;
check_element_type(XML=[#xmlElement{}|_Rest],
		   {choice,{Els,Occ}},Env,_Block,S,Checked) ->
    ?debug("calling choice/6~n",[]),

    case check_choice(XML,Els,Occ,Env,S#xsd_state{num_el=0},Checked) of
	Err = {error,_} ->
	    Err;
	{ValidContent,Rest2,S2} ->
	    %% The choice may consume more than one element
	    {ValidContent,Rest2,S2}
    end;
check_element_type(XML=[E=#xmlElement{name=Name}|Rest],
		   Any={any,{Namespace,_Occ={Min,_},ProcessorContents}},Env,
		   _Block,S,_Checked) ->
    ?debug("check any: {any,{~p,~p,~p}}~n",[Namespace,_Occ,ProcessorContents]),
    %% ProcessorContents any of lax | strict | skip
    %% lax: may validate if schema is found
    %% strict: must validate
    ElName = mk_EII_QName(Name,E,S),
    case cmp_any_namespace(ElName,Namespace,S) of
	true ->
	    case ProcessorContents of
		skip ->
		    {[E],Rest,S};
		lax ->
		    {[E],Rest,S};
%%		strict when Namespace==['##local'] ->
		strict ->
		    case member(absent,Namespace) of
			true ->
			    %% unqualified well-formed xml is required. The
			    %% xml is well-formed, check that it is
			    %% unqualified.
			    Traverse =
				fun(#xmlElement{nsinfo=[],
						attributes=Atts,
						content=C},
				    Sin,Fun) ->
					Sin2 = Fun(Atts,Sin,Fun),
					Fun(C,Sin2,Fun);
				   (#xmlAttribute{namespace=[]},Sin,_Fun) ->
					Sin;
				   (#xmlText{},Sin,_Fun) -> Sin;
				   ([H|T],Sin,Fun) ->
					Sin2 = Fun(H,Sin,Fun),
					Fun(T,Sin2,Fun);
				   ([],Sin,_Fun) ->
					Sin;
				   (El,Sin,_Fun) ->
					Err = {error_path(E,Name),?MODULE,
					       {illegal_component_in_any,El}},
					acc_errs(Sin,Err)
				end,
			    S2 = Traverse(E,S,Traverse),
			    {[E],Rest,S2};
		       _ ->
			    {Result,S2}=check_any(E,Any,Env,S),
			    {[Result],Rest,S2}
		    end
	    end;
	false when S#xsd_state.num_el >= Min ->
	    {[],XML,S};
	_ ->
	    {error,{error_path(E,Name),?MODULE,{element_bad_match,E,Any,Env}}}
    end;
check_element_type([],CM,_Env,_Block,S,Checked) ->
    %% #schema_complex_type, any, #schema_group, anyType and lists are
    %% caught above.
    case CM of
	#schema_simple_type{} ->
	    {NewVal,S2} = check_type(CM,[],unapplied,S),
	    {NewVal,[],S2};
	{simpleType,_} ->
	    {NewVal,S2} = check_type(CM,[],unapplied,S),
	    {NewVal,[],S2};
	_ ->
	    {error,{error_path(Checked,undefined),?MODULE,
		    {empty_content_not_allowed,CM}}}
    end;
check_element_type([C = #xmlComment{} |Rest],CM,Env,Block,S,Checked) ->
     check_element_type(Rest,CM,Env,Block,S,[C |Checked]);
check_element_type(XML,CM,_Env,_Block,S,_Checked) ->
    {error,{error_path(XML,undefined),?MODULE,{match_failure,XML,CM,S}}}.

%% single xml content object and single schema object
check_text_type(XML=[#xmlText{}|_],optional_text,S) ->
%    {XMLTxt,optional_text};
    {XMLText,Rest} = split_xmlText(XML),
    {XMLText,Rest,S};
check_text_type(XML=[Txt=#xmlText{}|_],Type={simpleType,_},S) ->
    {XMLText,Rest} = split_xmlText(XML),
    {NewVal,S2}=check_type(Type,flatten([X||#xmlText{value=X}<-XMLText]),unapplied,S),
    {[Txt#xmlText{value=NewVal}],Rest,S2};
check_text_type(XML=[Txt=#xmlText{}|_],Type=#schema_simple_type{},S) ->
    {XMLText,Rest} = split_xmlText(XML),
    {NewVal,S2}=check_type(Type,flatten([X||#xmlText{value=X}<-XMLText]),unapplied,S),
    {[Txt#xmlText{value=NewVal}],Rest,S2};
check_text_type([XMLTxt=#xmlText{}|_],CMEl,_S) ->
    {error,{error_path(XMLTxt,undefined),?MODULE,
	    {cannot_contain_text,XMLTxt,CMEl}}}.

split_xmlText(XML) ->
    splitwith(fun(#xmlText{}) -> true;(#xmlComment{}) -> true;(_) -> false end,XML).

%% Sequence
check_sequence([T=#xmlText{}|Rest],Els,Occ,Env,S,Checked) ->
    check_sequence(Rest,Els,Occ,Env,S,[T|Checked]);
check_sequence(Seq=[_InstEl=#xmlElement{}|_],[El|Els],Occ={_Min,_Max},Env,S,Checked) ->
    %% El any of (element | group | choice | sequence | any)*

    {ResolvedT,S2} = resolve(El,S),
    case check_element_type(Seq,ResolvedT,Env,[],count_num_el(S2),[]) of
	{[],_,S3} -> %% An optional element not present or maybe content == [].
	    case is_optional(El,S3) of
		true ->
		    check_sequence(Seq,Els,Occ,Env,set_num_el(S3,0),Checked);
		_ ->
		    {error,{error_path(Checked,undefined),?MODULE,
			    {missing_mandatory_elements,El}}}
	    end;
	Err={error,_Reason} ->
	    case {is_optional(El,S),S#xsd_state.num_el,get_occur(El)} of
		{true,_,_} ->
		    check_sequence(Seq,Els,Occ,Env,set_num_el(S,0),Checked);
		{_,N,{_Min2,Max}} when N>=Max ->
		    check_sequence(Seq,Els,Occ,Env,set_num_el(S,0),Checked);
		_ ->
		    Err
	    end;
%% 	{error,_Reason} when Min==0 -> %% optional element
%% 	    {[],Seq,S}; %% {Checked,Seq,S}
%% 	{error,_Reason} when S#xsd_state.num_el >= Max ->
%% 	    %% This failure because of number limit
%% 	    {Checked,Seq,S};
%% 	Err = {error,_Reason} ->
%% 	    %% Even though this match failed
%%	    Err;
	{Ret,UnValRest,S3} ->
	    %% must also take care of more elements of same name
	    %% decrease occurrence in El for the optional measurements
	    %% when Seq is empty.
	    check_sequence(UnValRest,[decrease_occurance(El)|Els],Occ,Env,
			   count_num_el(set_num_el(S3,S2)),
			   Ret++Checked)
    end;
check_sequence([C = #xmlComment{} |Rest], Els, Occ, Env, S, Checked) ->
    check_sequence(Rest,Els,Occ,Env,S,[C |Checked]);
check_sequence(Rest,[],_Occ,_Env,S,Checked) ->
    {Checked,Rest,set_num_el(S,0)};
check_sequence([],Els,_Occ,_Env,S,Checked) ->
    case [X||X={_,Y={_,_}} <- Els,optional(Y)==false] of
	[] ->
	    {Checked,[],set_num_el(S,0)};
	MandatoryEls ->
	    {error,{error_path(Checked,undefined),?MODULE,
		    {missing_mandatory_elements,MandatoryEls}}}
    end.
%%check_sequence(Seq,[],_Occ,_Env,_S,_Checked) ->
    %%{error,{unmatched_elements,Seq}}.


%% Choice one alternative must occur unless all alternatives are
%% optional or the entire choice is optional.
check_choice([T=#xmlText{}|Rest],Els,Occ,Env,S,Checked) ->
    case is_whitespace(T) of
	true ->
	    check_choice(Rest,Els,Occ,Env,S,[T|Checked]);
	_ ->
	    {error,{error_path(T,undefined),?MODULE,
		    {choice_missmatch,T,Els}}}
    end;
check_choice(Ch=[#xmlElement{}|_],[El|Els],Occ,Env,S,Checked) ->
    {ResolvedT,S2} = resolve(El,S),
    case check_element_type(Ch,ResolvedT,Env,[],count_num_el(S2),[]) of
	{[],_,_S3} -> %% not matched optional element
	    check_choice(Ch,Els,Occ,Env,S2,Checked);
	{error,_Reason} -> %% This may happen but not for the
	    %% last alternative element unless the
	    %% entire choice is optional. So, just
	    %% continue.
	    case [X||X=#xmlElement{}<-Checked] of
		[] ->
		    check_choice(Ch,Els,Occ,Env,S2,Checked);
		_ ->
		    {Checked,Ch,set_num_el(S,0)}
	    end;
	{Result,UnValRest,S3} -> %% in this case only more elements of
                                 %% El may be allowed
	    check_choice(UnValRest,[El],Occ,Env,
			 count_num_el(set_num_el(S3,S)),Result++Checked)
    end;
check_choice([],_,_,_,S,Checked) ->
    {Checked,[],set_num_el(S,0)};
check_choice(XML,[],{0,_},_,S,Checked) ->
    %% Choice is optional
    {Checked,XML,set_num_el(S,0)};
check_choice(XML,[],_,_,S,Checked) ->
    %% Choice has already matched something, the rest is for something
    %% else to match.
    case S#xsd_state.num_el > 0 of
	true ->
	    {Checked,XML,set_num_el(S,0)};
	_ ->
	    {error,{error_path(XML,undefined),?MODULE,
		    {no_element_matching_choice,XML}}}
    end.

check_all([T=#xmlText{}|RestXML],CM,Occ,Env,S,Checked,XML) ->
    case is_whitespace(T) of
	true ->
	    check_all(RestXML,CM,Occ,Env,S,[T|Checked],XML);
	_ ->
	    {error,{error_path(T,undefined),?MODULE,{all_missmatch,T,CM}}}
    end;
check_all(XML=[E=#xmlElement{name=Name}|RestXML],CM,Occ,Env,S,
	  Checked,PrevXML) ->
    ElName = mk_EII_QName(Name,E,S),
    case search_delete_all_el(ElName,CM,S) of
	{CMEl={element,_},RestCM} ->
	    {ResolvedT,S2} = resolve(CMEl,S),
	    case check_element_type(XML,ResolvedT,Env,[],S2,[]) of
		{[],_,_S3} ->
		    Err = {error_path(E,Name),?MODULE,
			   {validation_error_all,ElName,CM}},
		    check_all(RestXML,CM,Occ,Env,acc_errs(S,Err),
			      Checked,PrevXML);
		{error,_} when element(1,Occ)==0 ->
		    {[],PrevXML,S};
		{error,Reason} ->
		    check_all(RestXML,RestCM,Occ,Env,
			      acc_errs(S,Reason),[E|Checked],PrevXML);
		{Result,UnValRest,S3} ->
		    check_all(UnValRest,RestCM,Occ,Env,
			      S3#xsd_state{scope=S#xsd_state.scope},
			      Result++Checked,PrevXML)
	    end;
	_  when element(1,Occ) == 0 ->
	    {[],PrevXML,S};
	_ ->
	    Err = {error_path(E,Name),?MODULE,
		   {element_not_in_all,ElName,E,CM}},
	    check_all(RestXML,CM,Occ,Env,acc_errs(S,Err),[E|Checked],PrevXML)
    end;
check_all([C=#xmlComment{} |RestXML], CM, Occ, Env, S, Checked, XML) ->
    check_all(RestXML, CM, Occ, Env, S, [C |Checked], XML);
check_all(XML,[],_,_,S,Checked,_) ->
    {Checked,XML,S};
check_all([],CM,_Occ,_,S,Checked,_PrevXML) ->
    case [X||X={_,Y={_,_}} <- CM,optional(Y)==false] of
	[] ->
	    {Checked,[],set_num_el(S,0)};
	MandatoryEls ->
	    {error,{error_path(Checked,undefined),?MODULE,
		    {missing_mandatory_elements_in_all,MandatoryEls}}}
    end.

check_any(E,Any,_Env,S) ->
    try validate_xml(E,S#xsd_state{scope=[]}) of
	{[Result],[],S2} ->
	    {Result,S2#xsd_state{scope=S#xsd_state.scope}};
	{Result,[],S2} ->
	    {Result,S2#xsd_state{scope=S#xsd_state.scope}};
	{_,_Unvalidated,S2} ->
	    Err = {error_path(E,undefined),?MODULE,{failed_validating,E,Any}},
	    {E,acc_errs(S2#xsd_state{scope=S#xsd_state.scope},Err)};
	{error,Reason} ->
	    {E,acc_errs(S,Reason)}
    catch
	error:Reason:StackTrace ->
            %% {E,acc_errs(S,format_error({internal_error,Reason},E,Any,Env))}
	    Err = {error_path(E,undefined),?MODULE,{internal_error,{Reason, StackTrace}}},
	    {E,acc_errs(S,Err)};
        exit:Reason ->
            %% {E,acc_errs(S,format_error({internal_error,Reason},E,Any,Env))}
	    Err = {error_path(E,undefined),?MODULE,{internal_error,Reason}},
	    {E,acc_errs(S,Err)}
    end.

check_target_namespace(XMLEl,S) ->
    case {S#xsd_state.targetNamespace,XMLEl#xmlElement.nsinfo} of
	{undefined,[]} ->
	    ok;
	{URI,{Prefix,_}} ->
	    NS = XMLEl#xmlElement.namespace,
	    case namespace(Prefix,NS,NS#xmlNamespace.default) of
		URI ->
		    ok;
		_ ->
		    failed
	    end;
	{URI,_} ->
	    case (XMLEl#xmlElement.namespace)#xmlNamespace.default of
		URI ->
		    ok;
		_ ->
		    failed
	    end
    end.

schemaLocations(El=#xmlElement{attributes=Atts},S) ->
    Pred = fun(#xmlAttribute{name=schemaLocation}) -> false;
	      (#xmlAttribute{nsinfo={_,"schemaLocation"}}) -> false;
	      (_) -> true
	   end,
    case lists:dropwhile(Pred,Atts) of
	[] ->
	    S;
	[#xmlAttribute{value=Paths}|_] ->
	    case string:tokens(Paths," \n\t\r") of
		L when length(L) > 0 ->
		    case length(L) rem 2 of
			0 ->
			    PairList =
				fun([],_Fun) ->
					[];
				   ([SLNS,SLLoc|Rest],Fun) ->
					[{SLNS,SLLoc}|Fun(Rest,Fun)]
				end,
			    S#xsd_state{schemaLocations=PairList(L,PairList)};
			_ ->
			    Err = {error_path(El,El#xmlElement.name),?MODULE,
				   {schemaLocation_list_failure,Paths}},
			    acc_errs(S,Err)
		    end;
		_ ->
		    S
	    end;
	_ ->
	    S
    end.

blocking([],BlockDefault) ->
    BlockDefault;
blocking(Block,_) ->
    Block.

allow_empty_content([]) ->
    true;
allow_empty_content([{restriction,{_BT,_CM=[]}}]) ->
    true;
allow_empty_content([{extension,{_BT,_CM=[]}}]) ->
    true;
allow_empty_content([{_,{_,{0,_}}}|Rest]) ->
    allow_empty_content(Rest);
allow_empty_content([{_,{Content,_}}|Rest]) ->
     case allow_empty_content(Content) of
	 true ->
	     allow_empty_content(Rest);
	 _ -> false
     end;
allow_empty_content(_) ->
    false.

empty_xml_content([]) ->
    true;
empty_xml_content([H|T]) ->
    case is_whitespace(H) of
	true ->
	    empty_xml_content(T);
	_ ->
	    false
    end;
empty_xml_content(_) ->
    false.

xsi_factors(#schema_element{nillable=N}) ->
    [{nillable,N}].
check_xsi_factors({nil,_,?XSD_INSTANCE_NAMESPACE},
		  #xmlAttribute{value="true"},XsiFactors,XMLEl,S) ->
    case key1search(nillable,XsiFactors,false) of
	{_,true} ->
	    case empty_xml_content(XMLEl#xmlElement.content) of
		true ->
		    S;
		_ ->
		    Err = {error_path(XMLEl,XMLEl#xmlElement.name),?MODULE,
			   {element_content_not_nil,XMLEl}},
		    acc_errs(S,Err)
	    end;
	_ ->
	    S
    end;
check_xsi_factors(_,_,_,_,S) ->
    S.

check_attributes(XMLEl=#xmlElement{attributes=Atts},
		 #schema_complex_type{name=Name,attributes=SchemaAtts},
		 XsiFactors,S) ->
    %% For each att in Atts check that it is allowed, and has right type.
    %% For each att in CT that is required check that it exists. Apply
    %% none present atts that have default values.
    OldScope = S#xsd_state.scope,
    SchemaAtts2 = resolve_attributeGroups(SchemaAtts,XMLEl,S),
    {XMLEl2,S2}=check_attributes(Atts,SchemaAtts2,XMLEl,XsiFactors,
				 name_scope(Name,S),[]),
    {XMLEl2,S2#xsd_state{scope=OldScope}};
check_attributes(XMLEl=#xmlElement{attributes=[]},_,_,S) ->
    {XMLEl,S};
check_attributes(XMLEl=#xmlElement{name=N,attributes=Atts},_,XsiFactors,S) ->
    Fun =
	fun(AttX,S_in) ->
		case reserved_attribute(AttX,XMLEl#xmlElement.namespace) of
		    true ->
			AttQName =
			    mk_EII_QName(AttX#xmlAttribute.name,XMLEl,S_in),
			check_xsi_factors(AttQName,AttX,XsiFactors,XMLEl,S_in);
		    _ ->
			Err = {error_path(XMLEl,N),?MODULE,
			       {attribute_in_simpleType,XMLEl,AttX}},
			acc_errs(S_in,Err)
		end
	end,
    {XMLEl,foldl(Fun,S,Atts)}.

check_attributes([],[SA|SchemaAtts],XMLEl,XsiFactors,S,CheckedAtts) ->
    case resolve(SA,S) of
	{#schema_attribute{name=Name,use=Use,default=Def,fixed=Fix},S2} ->
	    case {Use,Def,Fix} of
		{required,_,_} ->
		    Err = {error_path(XMLEl,XMLEl#xmlElement.name),?MODULE,
			   {required_attribute_missed,XMLEl,Name}},
		    check_attributes([],SchemaAtts,XMLEl,XsiFactors,
				     acc_errs(S2,Err),CheckedAtts);
		{optional,undefined,undefined} ->
		    check_attributes([],SchemaAtts,XMLEl,XsiFactors,
				     S2,CheckedAtts);
		{optional,Default,undefined} ->
		    NewAtt = create_attribute(Name,Default),
		    check_attributes([],SchemaAtts,XMLEl,XsiFactors,S2,
				     [NewAtt|CheckedAtts]);
		{optional,undefined,Fix} ->
		    NewAtt = create_attribute(Name,Def),
		    check_attributes([],SchemaAtts,XMLEl,XsiFactors,S2,
				     [NewAtt|CheckedAtts]);
		{optional,Default,Fix} ->
		    Err = {error_path(XMLEl,XMLEl#xmlElement.name),?MODULE,
			   {default_and_fixed_attributes_mutual_exclusive,
			    Name,Default,Fix}},
		    check_attributes([],SchemaAtts,XMLEl,XsiFactors,
				     acc_errs(S2,Err),CheckedAtts);
		_ ->
		    check_attributes([],SchemaAtts,XMLEl,XsiFactors,
				     S2,CheckedAtts)
	    end;
	{{anyAttribute,{_Namespaces,_PC}},S2} ->
	    check_attributes([],SchemaAtts,XMLEl,XsiFactors,
			     S2,CheckedAtts);
	Err ->
	    ErrMsg={error_path(XMLEl,XMLEl#xmlElement.name),?MODULE,
		    {schema_error,unexpected_object,SA,Err}},
	    check_attributes([],SchemaAtts,XMLEl,XsiFactors,
			     acc_errs(S,ErrMsg),CheckedAtts)
    end;
check_attributes([],[],XMLEl,_XsiFactors,S,CheckedAtts) ->
    {XMLEl#xmlElement{attributes=reverse(CheckedAtts)},S};
check_attributes([Att|Atts],SchemaAtts,XMLEl,XsiFactors,
		 S,CheckedAtts) ->
%%    AttQName = mk_EII_QName(Att#xmlAttribute.name,XMLEl,S),
    {IsQ,AttQName} = mk_EII_Att_QName(Att#xmlAttribute.name,XMLEl,S),
    case search_attribute(IsQ,AttQName,SchemaAtts) of
	{AttObj={attribute,_},SchemaAtts2} ->
	    {SA,S2} = load_object(AttObj,S),
	    #schema_attribute{type=[AttType]} = SA,
	    {Val,S4} = check_type(AttType,
				  Att#xmlAttribute.value, unapplied,S2),
	    check_attributes(Atts,SchemaAtts2,XMLEl,XsiFactors,S4,
			     [Att#xmlAttribute{value=Val}|CheckedAtts]);
	{undefined,SchemaAtts2} ->
	    %% check for reserved attributes or anyAttribute
	    case reserved_attribute(Att,XMLEl#xmlElement.namespace) of
		true ->
		    S2 = check_xsi_factors(AttQName,Att,XsiFactors,XMLEl,S),
		    check_attributes(Atts,SchemaAtts2,XMLEl,XsiFactors,
				     S2,[Att|CheckedAtts]);
		_ ->
		    case check_anyAttribute(Att,SchemaAtts2,XMLEl,S) of
			{error,Reason} ->
			    check_attributes(Atts,SchemaAtts2,XMLEl,XsiFactors,
					     acc_errs(S,Reason),CheckedAtts);
			{Att2,S2} ->
			    check_attributes(Atts,SchemaAtts2,XMLEl,XsiFactors,
					     S2,[Att2|CheckedAtts])
		    end
	    end;
	Other ->
	    Err = {[],?MODULE,{internal_error,Other}},
	    check_attributes(Atts,SchemaAtts,XMLEl,XsiFactors,
			     acc_errs(S,Err),CheckedAtts)
    end.

check_anyAttribute(Att,SchemaAtts,El=#xmlElement{name=Name,namespace=NS},S) ->
    case [Any||Any={anyAttribute,_}<-SchemaAtts] of
	[] ->
	    {error,{error_path(El,Name),?MODULE,
		    {attribute_not_defined_in_schema,
		     Att#xmlAttribute.name}}};
	[{_,{Namespace,PC}}|_] ->
	    case check_anyAttribute_namespace(Namespace,NS) of
		ok ->
		    check_anyAttribute2(Namespace,PC,Att,NS,S);
		_ ->
		    {error,{error_path(El,Name),?MODULE,
			    {disallowed_namespace,Namespace,
			     NS,Att#xmlAttribute.name}}}
	    end
    end.
check_anyAttribute2(_,PC,Att,_,S) when PC==skip;PC==lax ->
    {Att,S};
check_anyAttribute2(_Namespace,_,Att,_NS,S) ->
    %% PC == strict
    {Att,S}.

check_anyAttribute_namespace(['##any'|_],_NS) ->
    ok;
check_anyAttribute_namespace([absent],_NS) ->
    ok;
check_anyAttribute_namespace([NS|_],NS) ->
    ok;
check_anyAttribute_namespace([{'not',NS}|_],NS) ->
    false;
check_anyAttribute_namespace([_H|T],NS) ->
    check_anyAttribute_namespace2(T,NS).
check_anyAttribute_namespace2([NS|_],NS) ->
    ok;
check_anyAttribute_namespace2([_H|T],NS) ->
    check_anyAttribute_namespace2(T,NS);
check_anyAttribute_namespace2([],_NS) ->
    false.

resolve_attributeGroups(SchemaAtts,El,S) ->
    resolve_attributeGroups(SchemaAtts,El,S,[],[]).
resolve_attributeGroups([AG={attributeGroup,_}|SchemaAtts],El,S,Parents,Acc) ->
    case resolve(AG,S) of
	{#schema_attribute_group{name=Name,content=AGC},_S2} ->
	    case {member(Name,Parents),S#xsd_state.redefine} of
		{true,false} ->
		    Err = {error_path(El,El#xmlElement.name),?MODULE,
			   {cirkular_attributeGroup_reference,Name}},
		    resolve_attributeGroups(SchemaAtts,El,acc_errs(S,Err),
					    Parents,Acc);
		{true,_} ->
		    resolve_attributeGroups(SchemaAtts,El,S,Parents,Acc);
		_  ->
		    resolve_attributeGroups(AGC++[marker|SchemaAtts],
					    El,S,[Name|Parents],Acc)
	    end;
	Err ->
	    ErrMsg={error_path(El,El#xmlElement.name),?MODULE,
		    {schema_error,unexpected_object,AG,Err}},
	    resolve_attributeGroups(SchemaAtts,El,acc_errs(S,ErrMsg),
				    Parents,Acc)
    end;
resolve_attributeGroups([marker|T],El,S,[_P|Ps],Acc) ->
    resolve_attributeGroups(T,El,S,Ps,Acc);
resolve_attributeGroups([H|T],El,S,Parents,Acc) ->
    resolve_attributeGroups(T,El,S,Parents,[H|Acc]);
resolve_attributeGroups([],_,_,_,Acc) ->
    Acc.

check_type(Type=#schema_simple_type{},Value,FacetS,S) ->
    check_simpleType(Type,Value,FacetS,S);
check_type({simpleType,{anySimpleType,_}},Value, _FacetS,S) ->
    {Value,S};
check_type({union,Types},Value,_FacetS,S) ->
    check_union_types(Types,Value,S);
check_type(ST={simpleType,QName={Name,_Scope,_NS}},Value, FacetS,S) ->
    case is_builtin_simple_type(QName) of
	true ->
	    {ConstrainedValue,S2} =
		constrained(QName,default_facets(FacetS,Name),Value,S),
	    case xmerl_xsd_type:check_simpleType(Name,ConstrainedValue,S2) of
		{ok,_} when Name=='IDREF';Name=='IDREFS' ->
		    %% do something more
		    {ConstrainedValue,S2};
		{ok,_} ->
		    {ConstrainedValue,S2};
		{error,Reason} ->
		    ?debug("Error validating type: ~p~nwith value: ~p~n",[Name,Value]),
		    {Value,acc_errs(S2,Reason)}
	    end;
	_ ->
	    case resolve(ST,S) of
		{[],S2} ->
		    Err = {[],?MODULE,{could_not_resolve_type,ST}},
		    {Value,acc_errs(S2,Err)};
		{RefedST,S2} ->
		    check_type(RefedST,Value, unapplied,S2)
	    end
    end;
check_type(Type,Value, _FacetS,S) ->
    Err = {[],?MODULE,{could_not_check_value_for_type,Type}},
    ?debug("ERROR: not implemented: ~p~nfor value: ~p~n",[Type,Value]),
    {Value,acc_errs(S,Err)}.

check_simpleType(#schema_simple_type{base_type=BT,final=_Final,
				     facets=Facets,content=Type},
		 Value,FacetS,S) ->
    case {BT,Type} of
	{{_ST,_,_},_} ->
	    case is_builtin_simple_type(BT) of
		true ->
		    {ConstrainedValue,S2} =
			constrained(BT,merge_facets(default_facets(FacetS,BT),Facets),Value,S),
		    {_,_S3} = check_type({simpleType,BT},ConstrainedValue,applied,S2);
		_ ->
		    case resolve({simpleType,BT},S) of
			{BaseST=#schema_simple_type{facets=Facets2},_} ->
			    check_simpleType(BaseST#schema_simple_type{facets=Facets++Facets2},Value,unapplied,S);
			_ ->
			    Err = {[],?MODULE,{unknown_simpleType,BT}},
			    {Value,acc_errs(S,Err)}
		    end
	    end;
	{_,[CT]} ->
	    {_,_S2} = check_type(CT,Value,unapplied,S)
    end.

check_union_types(Types,Value,S) ->
    check_union_types(Types,Types,Value,S).
check_union_types([],UT,Value,S) ->
    acc_errs(S,{[],?MODULE,{value_not_valid,Value,UT}});
check_union_types([T|Ts],UT,Value,S = #xsd_state{errors=Errs}) ->
    case check_type(T,Value,unapplied,S) of
	{Val,S2=#xsd_state{errors=Errs}} ->
	    {Val,S2};
	{_,_} ->
	    check_union_types(Ts,UT,Value,S)
    end.

reserved_attribute({RA,_,?XSD_INSTANCE_NAMESPACE},_)
  when RA==type;RA==nil;RA==schemaLocation;RA==noNamespaceSchemaLocation ->
    true;
reserved_attribute(#xmlAttribute{name=Name},#xmlNamespace{nodes=NSNodes}) ->
    NameStr = if
		  is_atom(Name) -> atom_to_list(Name);
		  true -> Name
	      end,
    case string:tokens(NameStr,":") of
	["xmlns"|_] ->
	    true;
	[Prefix,InstAtt] when InstAtt=="type";
			      InstAtt=="nil";
			      InstAtt=="schemaLocation";
			      InstAtt=="noNamespaceSchemaLocation" ->
	    case keyNsearch(?XSD_INSTANCE_NAMESPACE,2,NSNodes,[]) of
		{Prefix,_} ->
		    true;
		_ ->
		    false
	    end;
	_ ->
	    false
    end;
reserved_attribute(_,_) ->
    false.


default_facets(applied,_) ->
    [];
default_facets(_,Type) ->
    default_facets(Type).
default_facets({Name,_,_}) when is_list(Name) ->
    %% Type already proven to be a built in simple type
    default_facets(list_to_atom(Name));
default_facets({Name,_,_}) ->
    default_facets(Name);
default_facets(TypeName) ->
    case is_xsd_string(TypeName) of
	false ->
	    [{whiteSpace,"collapse"}];
	_ ->
	    []
    end.

merge_facets([],DefinedF) ->
    DefinedF;
merge_facets([F={Name,_}|Rest],DefinedF) ->
    %% At this moment only F has the allowed value
    merge_facets(Rest,keyreplace(Name,1,DefinedF,F)).

constrained({T,_,_},Facets,Value,S) ->
    FacetFuns = [facet_fun(T,F)||F<-Facets],
    constrained2(FacetFuns,Value,S).
constrained2([],Value,S) ->
    {Value,S};
constrained2([Facet|RestFacets],Value,S) ->
    case Facet(Value) of
	{error,Reason} ->
	    constrained2(RestFacets,Value,acc_errs(S,Reason));
	{ok,NewValue} ->
	    constrained2(RestFacets,NewValue,S)
    end.

id_constraints(CMEl,XMLEl,S) ->
    S1 = check_uniqueness(CMEl#schema_element.uniqueness,
			XMLEl,S),
    S2 = check_keys([X||{key,X}<-CMEl#schema_element.key],XMLEl,S1),
    prepare_keyrefs([X||{keyref,X}<-CMEl#schema_element.key],XMLEl,S2).

check_abstract(ElName,El,#schema_element{name=ElName,abstract=true},S) ->
    acc_errs(S,{error_path(El,El#xmlElement.name),?MODULE,
		{abstract_element_instance,ElName}});
check_abstract(ElName,_El,#schema_element{name=ElName},S) ->
    S;
check_abstract(ElName,El,#schema_element{},S) ->
    {XMLEl,_S2} = load_object({element,ElName},S),
    check_abstract(ElName,El,XMLEl,S).

%% Check of form compliance.
%% Globally declared elements may be qualified even though
%% elementformdefault = "unqualified".
%% If ActualFormValue = "qualified" locally defined names must be
%% explicitly or implicitly qualified.
%% check_form({LocalName,Scope,Namespace},LocalName,
%% InstanceNamespace,ActualFormDefault,S) -> NewS
check_form({LocalName,_,Namespace},LocalName,
	   El=#xmlElement{name=Name,namespace=NS},qualified,S) ->
    case NS#xmlNamespace.default of
	Namespace ->
	    S;
	_ ->
	    acc_errs(S,{error_path(El,Name),?MODULE,
			{qualified_name_required,LocalName}})
    end;
check_form({LocalName,_,_},LocalName,_El,_ActualFormDefault,S) ->
    S;
check_form({_LocalName,[],_},_QualifiedName,_El,_ActualFormDefault,S) ->
    S;
check_form({_LocalName,_,_},QualifiedName,El,unqualified,S) ->
    acc_errs(S,{error_path(El,El#xmlElement.name),?MODULE,
		{unqualified_name_required,QualifiedName}});
check_form({_LocalName,_,_},_QualifiedName,_El,_ActualFormDefault,S) ->
    S.

actual_form_value(undefined,GlobalForm) ->
    GlobalForm;
actual_form_value(LocalForm,_) ->
    LocalForm.


check_uniqueness(undefined,_,S) ->
    S;
check_uniqueness(Unique,XMLEl,S) ->
    case Unique of
	[{unique,#id_constraint{selector={selector,SelectorPath},
				fields=Fields}}] ->
	    TargetNodeSet = target_node_set(SelectorPath,XMLEl,S),
	    case qualified_node_set(Fields,TargetNodeSet,XMLEl,S) of
		{[],S1} -> S1;
		{[_E],S1} -> S1;
		{L,S1} when is_list(L) ->
		    key_sequence_uniqueness(L,XMLEl,S1)
	    end;
	_ -> S
    end.

target_node_set(SelectorPath,XMLEl,S) ->
    xmerl_xpath:string(SelectorPath,XMLEl,
		       [{namespace,S#xsd_state.namespace_nodes}]).

qualified_node_set(Fields,Set,El,S) ->
    qualified_node_set([X||{field,X} <- Fields],Set,El,S,[]).

qualified_node_set([],_Set,_El,S,Acc) ->
    {Acc,S};
qualified_node_set(_,[],_El,S,Acc) ->
    {Acc,S};
qualified_node_set(Paths,[QN|QNs],El,S,Acc) ->
    Fun = fun(P,Sx) ->
		  case apply_field(P,QN,Sx) of
		      L when length(L) =< 1 -> % Part1:3.11.4.3
			  {L,Sx};
		      Err ->
			  RetErr =
			      {error_path(El,El#xmlElement.name),?MODULE,
			       {illegal_key_sequence_value,Err}},
			  {[],acc_errs(Sx,RetErr)}
		  end
	  end,
    {KeySequence,S2} = mapfoldl(Fun,S,Paths),
    case flatten(KeySequence) of
	[] ->
	    qualified_node_set(Paths,QNs,El,S2,Acc);
	KS ->
	    qualified_node_set(Paths,QNs,El,S2,[KS|Acc])
    end.

apply_field(F,El,S) ->
    %% xmerl_xpath:string returns a list
    xmerl_xpath:string(F,El,[{namespace,S#xsd_state.namespace_nodes}]).

check_keys([],_XMLEl,S) ->
    S;
check_keys([Key=#id_constraint{selector={selector,SelectorPath},
			       fields=Fields}|Keys],XMLEl,S) ->
    TargetNodeSet = target_node_set(SelectorPath,XMLEl,S),
    S3=
	case qualified_node_set(Fields,TargetNodeSet,XMLEl,S) of
	    {L,S1} when length(L)==length(TargetNodeSet) ->
		%% Part1: 3.11.4.4.2.1
		S2 = key_sequence_uniqueness(L,XMLEl,S1),
		_ = save_key(Key#id_constraint{key_sequence=L},S2),
		S2;
	    {Err,S1} ->
		acc_errs(S1,{error_path(XMLEl,XMLEl#xmlElement.name),?MODULE,
			     {qualified_node_set_not_correct_for_key,Err}})
	end,
    check_keys(Keys,XMLEl,S3).

%% A reference to a key may occur in another environment than the key
%% was defined. Thus the key must be referenced after the whole
%% document has been processed. At this moment save the info about the
%% keyref and compare it with the key later.
prepare_keyrefs([],_XMLEl,S) ->
    S;
prepare_keyrefs([KeyRef=#id_constraint{selector={selector,SelectorPath},
				      fields=Fields}|Rest],XMLEl,S) ->
    TargetNodeSet = target_node_set(SelectorPath,XMLEl,S),
    {L,S1} = qualified_node_set(Fields,TargetNodeSet,XMLEl,S),
    save_keyref(KeyRef#id_constraint{key_sequence=L},S1),
    prepare_keyrefs(Rest,XMLEl,S1).



%% key_sequence_uniqueness(KeySequence,XMLElement,State)
%% Each element in KeySequence has same length and is a list of one or
%% more elements. key_sequence_uniqueness/2 checks that no two
%% elements has equal values. If it detects two (or more) elements
%% that have equal first subelements it must continue comparing the
%% other subelements of those elements. It returns the state with all
%% detected errors saved.
key_sequence_uniqueness([],_,S) ->
    S;
key_sequence_uniqueness([_H],_,S) ->
    S;
key_sequence_uniqueness([KS=[F1|FRest]|KSs],El,S) ->
    case is_key_sequence_equal(F1,KSs) of
	{true,TailOfEquals} ->
	    S1 =
		case k_s_u(FRest,TailOfEquals,S) of
		    true ->
			acc_errs(S,{error_path(El,El#xmlElement.name),?MODULE,
				    {key_value_not_unique,KS}});
		    _ ->
			S
		end,
	    key_sequence_uniqueness(KSs,El,S1);
	false ->
	    key_sequence_uniqueness(KSs,El,S)
    end.

k_s_u([],_,_) ->
    true;
k_s_u([F|Fs],KSs,S) ->
    case is_key_sequence_equal(F,KSs) of
	{true,TailOfEquals} ->
	    k_s_u(Fs,TailOfEquals,S);
	_ ->
	    false
    end.

is_key_sequence_equal(F,KSs) ->
    is_key_sequence_equal(F,KSs,[]).
is_key_sequence_equal(_F,[],[]) ->
    false;
is_key_sequence_equal(_F,[],Acc) ->
    {true,reverse(Acc)};
is_key_sequence_equal(F,[[F1|TlF1]|Rest],Acc) ->
    case is_key_el_equal(F,F1) of
	true ->
	    is_key_sequence_equal(F,Rest,[TlF1|Acc]);
	false ->
	    is_key_sequence_equal(F,Rest,Acc)
    end.

%% This test must be more elaborated considering the equal facet
is_key_el_equal(#xmlElement{content=C1},#xmlElement{content=C2}) ->
    %% content must be empty or text since elements must be of
    %% simpleType
    is_equal_content(C1,C2);
is_key_el_equal(#xmlAttribute{value=V1},#xmlAttribute{value=V1}) ->
    true;
is_key_el_equal(_,_) ->
    false.

is_equal_content([T1|Rest1],[T2|Rest2])
  when is_record(T1,xmlText),is_record(T2,xmlText) ->
    case is_whitespace(T1) of
	true ->
	    case is_whitespace(T2) of
		true ->
		    is_equal_content(Rest1,Rest2);
		_ ->
		    is_equal_content(Rest1,[T2|Rest2])
	    end;
	_ ->
	    case T1#xmlText.value==T2#xmlText.value of
		true ->
		    is_equal_content(Rest1,Rest2);
		_ ->
		    false
	    end
    end;
is_equal_content([],[]) ->
    true;
is_equal_content(_,_) ->
    false.

schema_concistence_checks(S) ->
    S2 = check_keyrefs(S),
    S3 = check_references(S2),
    S4 = check_substitutionGroups(S3#xsd_state.substitutionGroups,S3),
    S5 = check_cyclic_defs(S4),
    reset_state(S5).

reset_state(S) ->
    S#xsd_state{keyrefs=[],
		'IDs'=[],
		unchecked_references=[],
		substitutionGroups=[],
		derived_types=[],
		circularity_stack=[],
		circularity_disallowed=[]}.

check_keyrefs(S) ->
    KeyRefs = S#xsd_state.keyrefs,
    %% check that a key exists with same name as each keyref
    KeyExist =
	fun({keyref,Name,Refer},S_in) ->
		case load_key(Refer,S_in) of
		    Key=#id_constraint{} ->
			check_keyref_cardinality(Name,
						 load_keyref(Name,S_in),
						 Key,S_in);
%			S_in;
		    _ ->
			acc_errs(S_in,{[],?MODULE,
				       {keyref_missed_matching_key,Refer}})
		end;
	   (Other,S_in) ->
		acc_errs(S_in,{[],?MODULE,
			       {keyref_unexpected_object,Other}})
	end,
    foldl(KeyExist, S, KeyRefs).
check_keyref_cardinality(_,KR=#id_constraint{category=keyref,fields=KeyRefFs},
			 K=#id_constraint{fields=KeyFs},S) ->
    case length(KeyRefFs) == length(KeyFs) of
	true ->
	    S;
	_ ->
	    acc_errs(S,{[],?MODULE,
			{cardinality_of_fields_not_equal,KR,K}})
    end;
check_keyref_cardinality(Name,_,_,S) ->
    acc_errs(S,{[],?MODULE,{could_not_load_keyref,Name}}).

check_references(S) when is_record(S,xsd_state) ->
    check_references(S#xsd_state.unchecked_references,S).
check_references([],S) ->
    S;
check_references([H|T],S) ->
    check_references(T,check_reference(H,S)).
check_reference(Ref={attribute,_},S) ->
    case load_object(Ref,S) of
	{#schema_attribute{},S2} ->
	    S2;
	_ ->
	    acc_errs(S,{[],?MODULE,{reference_undeclared,attribute,Ref}})
    end;
check_reference(Ref={element,_},S) ->
    case load_object(Ref,S) of
	{#schema_element{},S2} ->
	    S2;
	_ ->
	    acc_errs(S,{[],?MODULE,{reference_undeclared,element,Ref}})
    end;
check_reference(Ref={attributeGroup,_},S) ->
    case load_object(Ref,S) of
	{#schema_attribute_group{},S2} ->
	    S2;
	_ ->
	    acc_errs(S,{[],?MODULE,{reference_undeclared,attributeGroup,Ref}})
    end;
check_reference(Ref={group,_},S) ->
    case load_object(Ref,S) of
	{#schema_group{},S2} -> S2;
	_ -> acc_errs(S,{[],?MODULE,{reference_undeclared,group,Ref}})
    end;
check_reference(Ref={simpleType,_},S) ->
    case load_object(Ref,S) of
	{#schema_simple_type{},S2} -> S2;
	_ -> acc_errs(S,{[],?MODULE,{reference_undeclared,simpleType,Ref}})
    end;
check_reference(Ref={complexType,_},S) ->
    case load_object(Ref,S) of
	{#schema_complex_type{},S2} -> S2;
	_ -> acc_errs(S,{[],?MODULE,{reference_undeclared,complexType,Ref}})
    end;
check_reference({simple_or_complex_Type,Ref},S=#xsd_state{errors=Errs}) ->
    %% complex or simple type
    case check_reference({complexType,Ref},S) of
	S2=#xsd_state{errors=Errs} -> S2;
	_ -> check_reference({simpleType,Ref},S)
    end;
check_reference(Ref,S) ->
    acc_errs(S,{[],?MODULE,{internal_error,unknown_reference,Ref}}).

%% Substitution groups should be checked for cirkular references
%% (invalid), that reference structure and type structure are
%% concistent.
check_substitutionGroups([],S) ->
    S;
check_substitutionGroups(SGs,S) ->
    S2  = check_substGr_acyclic(SGs,S),
    S3 = check_substGr_type_structure(SGs,S2),
    save_substitutionGroup(SGs,S3).
check_substGr_acyclic(SGs,S) ->
    Set = sofs:family(SGs),
    try sofs:family_to_digraph(Set, [acyclic]) of
	DG ->
	    digraph:delete(DG),
	    S
    catch
        error:cyclic ->
            acc_errs(S,{[],?MODULE,{cyclic_substitutionGroup,SGs}})
    end.
check_substGr_type_structure([SG|SGs],S) ->
    check_substGr_type_structure(SGs,check_substGr_type_structure2(SG,S));
check_substGr_type_structure([],S) ->
    S.
check_substGr_type_structure2({Head,SGMembers},S) ->
    TypeCheck =
	fun(SG,S_in) ->
                try
                    cmp_substGr_types(Head,SG,S_in)
                catch
                    error:_ ->
                        acc_errs(S_in,{[],?MODULE,
				       {substitutionGroup_error,Head,SG}});
                    exit:_ ->
                        acc_errs(S_in,{[],?MODULE,
				       {substitutionGroup_error,Head,SG}})
                end
	end,
    foldl(TypeCheck,S,SGMembers).
cmp_substGr_types(Head,SG,S) ->
    {HeadElement,S2} = load_object({element,Head},S),
    {MemberElement,S3} = load_object({element,SG},S2),
    try
        derived_or_equal(MemberElement#schema_element.type,
                         HeadElement#schema_element.type,
                         [],S3)
    catch
	_:_ ->
	    acc_errs(S3,{[],?MODULE,{internal_error,derived_or_equal,
				     MemberElement#schema_element.type,
				     HeadElement#schema_element.type}})
    end.
check_cyclic_defs(S=#xsd_state{circularity_disallowed=CA}) ->
    Set = sofs:relation_to_family(sofs:relation(CA)),
    try sofs:family_to_digraph(Set, [acyclic]) of
	DG ->
	    digraph:delete(DG),
	    S
    catch
        error:cyclic ->
	    acc_errs(S,{[],?MODULE,{cyclic_definition,CA}})
        end.



derived_or_equal(Type,Type,_Block,S) ->
    S;
derived_or_equal([MemberTypeRef],[HeadTypeRef],Block,S) ->
    %% HeadType has to be a
    {HeadType,_} = resolve(HeadTypeRef,S),
    {MemberType,_} = resolve(MemberTypeRef,S),
    derived_or_equal_types(MemberType,HeadType,schema,Block,S).
derived_or_equal_types(MemT,{anyType,_},Env,Block,S) ->
    case MemT of
	#schema_simple_type{content=Cntnt} ->
	    is_derivation_blocked(Env,Block,Cntnt,S);
	#schema_complex_type{content=Cntnt} ->
	    is_derivation_blocked(Env,Block,Cntnt,S);
	_ -> S
    end;
derived_or_equal_types(MemT=#schema_simple_type{name=Mem,base_type=MemBase},
		       #schema_simple_type{name=Head},Env,Block,S)
  when Mem==Head;MemBase==Head ->
    is_derivation_blocked(Env,Block,MemT#schema_simple_type.content,S);
derived_or_equal_types({simpleType,Name},
		       {simpleType,Name},_Env,_Block,S) ->
    S;
derived_or_equal_types(#schema_simple_type{base_type=Name,content=Content},
		       {simpleType,Name},Env,Block,S) ->
    is_derivation_blocked(Env,Block,Content,S);
derived_or_equal_types(#schema_simple_type{content=[{LoU,[Content]}]},
		       SimpleType,Env,Block,S) when LoU==list;LoU==union ->
    {NewMemType,S2}=resolve(Content,S),
    derived_or_equal_types(NewMemType,SimpleType,Env,Block,S2);
derived_or_equal_types(MemT=#schema_complex_type{name=Mem,base_type=MemBase},
		       #schema_complex_type{name=Head},Env,Block,S)
  when Mem==Head;MemBase==Head ->
    is_derivation_blocked(Env,Block,MemT#schema_complex_type.content,S);
derived_or_equal_types(MemT,HeadT,_Env,_Block,S) ->
    acc_errs(S,{[],?MODULE,{type_of_element_not_derived,MemT,HeadT}}).

is_derivation_blocked(schema,_,_,S) ->
    S;
is_derivation_blocked(instance,['#all'],Derivation,S) ->
    acc_errs(S,{derivation_blocked,'#all',Derivation});
is_derivation_blocked(instance,[],_,S) ->
    S;
is_derivation_blocked(instance,Block,C=[{Derivation,_}],S) ->
    case member(Derivation,Block) of
	true ->
	    acc_errs(S,{[],?MODULE,{derivation_blocked,Derivation,C}});
	_ ->
	    S
    end;
is_derivation_blocked(instance,_Block,_,S) ->
    S.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

create_attribute(QName,Value) ->
    {Name,_Scope,NSName} = QName,
    #xmlAttribute{name=Name,namespace={Name,NSName},value=Value}.

%% mk_name(L), L must be a list in reversed order
mk_name(L) ->
    mk_name(L,[]).
mk_name([],_Acc) ->
    [];
mk_name([H],[]) ->
    H;
mk_name([H],Acc) ->
    list_to_atom(lists:concat([H,'_'|Acc]));
mk_name([H|T],[]) ->
    mk_name(T,[H]);
mk_name([H1|T],Acc) ->
    mk_name(T,[H1,'_'|Acc]).

cmp_name({LName,Scope,NS},{LName,Scope,NS},_S) ->
    true;
%% substitutionGroup allows different names
cmp_name(XMLName={_,Scope,NS},CMName={_,Scope,NS},S) ->
    {El,_S2} = load_object({element,XMLName},S),
    cmp_SG_name(El,CMName,S);
cmp_name(_,_,_) ->
    false.

cmp_SG_name(#schema_element{substitutionGroup=Name},Name,_S) ->
    true;
cmp_SG_name(#schema_element{substitutionGroup=SGName},CMName,S) ->
    cmp_name(SGName,CMName,S);
cmp_SG_name(_,_,_) ->
    false.

%% Namespace: [{not,NS} | NS]
%%
cmp_any_namespace({_,_,EIINS},Namespace,_S) ->
    case member(EIINS,Namespace) of
	true ->
	    true;
	_ ->
	    case keysearch(EIINS,2,Namespace) of
		{value,{'not',EIINS}} ->
		    false;
		_ ->
		    true
	    end
    end.

at_least_one({_Min,Max}) when Max > 0 ->
    true;
at_least_one(_) ->
    false.

is_optional({element,{_,{0,_}}},_S) ->
    true;
is_optional({any,{_,{0,_},_}},_S) ->
    true;
is_optional({MG,{_CM,{0,_}}},_S)
  when MG =:= all; MG =:= sequence; MG =:= choice  ->
    true;
is_optional({MG,{CM,_Occ}},S)
  when MG =:= all; MG =:= sequence; MG =:= choice  ->
    case member(false,[is_optional(Y,S)||Y<-CM]) of
	true ->
	    false;
	_ -> true
    end;
is_optional({group,{_,{0,_}}},_S) ->
    true;
is_optional(G={group,_},S) ->
    case resolve(G,S) of
	{#schema_group{content=[]},_} ->
	    true;
	{#schema_group{content=[CM]},_} ->
	    is_optional(CM,S)
    end;
is_optional(_,_) ->
    false.



acc_errs(S=#xsd_state{errors=Errs},ErrMsg) ->
    S#xsd_state{errors=[ErrMsg|Errs]}.

%% invoked with an element/XML-node and a name of the
error_path([H|_T],Top) when H==#xmlElement{};H==#xmlText{} ->
    error_path(H,Top);
error_path([_H|T],Top) ->
    error_path(T,Top);
error_path(#xmlElement{parents=Ps,pos=Pos},Top) ->
    error_path(Ps,Pos,Top);
error_path(#xmlAttribute{parents=Ps,pos=Pos},Top) ->
    error_path(Ps,Pos,Top);
error_path(#xmlText{parents=Ps,pos=Pos},Top) ->
    error_path(Ps,Pos,Top);
error_path(_,_) ->
    [].
error_path([],Pos,Top) when is_integer(Pos) ->
    mk_xpath_path([{Top,Pos}]);
error_path([],_,Top) ->
    Top;
error_path(Nodes,_,_) ->
    mk_xpath_path(Nodes).

mk_xpath_path(Nodes) ->
    Slash =
	fun([H1,H2|T],Fun,Acc) -> Fun([H2|T],Fun,["/",H1|Acc]);
	   ([H1],_,Acc) -> [H1|Acc];
	   ([],_,Acc) -> Acc
	end,
    flatten(Slash([lists:concat([A,"[",B,"]"])||{A,B}<-Nodes],Slash,[])).

resolve(XSDType,InstanceEl,S) ->
    explicit_type(XSDType,InstanceEl,S).

resolve([H],S) ->
    resolve(H,S);
resolve(Any={any,_},S) ->
    {Any,S};
resolve(Any={anyAttribute,_},S) ->
    {Any,S};
resolve(Any={anyType,_},S) ->
    {Any,S};
resolve(Seq={sequence,_},S) ->
    {Seq,S};
resolve(Choice={choice,_},S) ->
    {Choice,S};
resolve({simple_or_complex_Type,QN},S) ->
%%    case load_object({simpleType,QN},S) of
    case resolve({simpleType,QN},S) of
	Res={#schema_simple_type{},_S1} ->
	    Res;
	{[],_S} ->
	    case load_object({complexType,QN},S) of
		{[],_} ->
		    ?debug("could not load object ~p~n",
			   [{simple_or_complex_Type,QN}]),
		    {[],S};
		T ->
		    T
	    end;
	T ->
	    T
    end;
resolve({complexType,{anyType,_,_}},S) ->
    {{anyType,[]},S};
resolve({simpleType,{anyType,_,_}},S) ->
    {{anyType,[]},S};
resolve(ST={simpleType,NameNS={_,_,_}},S) ->
    case load_object(ST,S) of
	{[],_S} -> case is_builtin_simple_type(NameNS) of
		  true ->
		      {ST,S};
		  _ ->
		      {[],S}
	      end;
	Obj ->
	    %resolve(Obj,S)
	    Obj
    end;
resolve({substitutionGroup,QName},S) ->
    %% This shall resolve to the type of the element QName
    case load_object({element,QName},S) of
	Ret = {[],_S} -> Ret;
	{#schema_element{type=[Type]},S2} ->
	    case Type of
		{simple_or_complex_Type,_} ->
		    resolve(Type,S2);
		_ ->
		    {Type,S2}
	    end;
	{#schema_element{type=Type},S2} ->
	    {Type,S2}
    end;
resolve({extension,{BaseType,CM}},S) ->
    case is_builtin_simple_type(BaseType) of
	true ->
	    {{simpleType,BaseType},S};
	_ ->
	    case resolve({simple_or_complex_Type,BaseType},S) of
		{ST = #schema_simple_type{},_} ->
		    {ST,S}; %% any attributes in CM are already
                            %% propagated to the outer complex type.
		{CT = #schema_complex_type{content=C},_} ->
		    {NewC,S2} = extend_type(C,CM,S),
		    {CT#schema_complex_type{content=NewC},S2};
		T -> T
	    end
    end;
resolve({restriction,{BaseType,CM}},S) ->
    case is_builtin_simple_type(BaseType) of
	true ->
	    {{simpleType,BaseType},S};
	_ ->
	    case resolve({simple_or_complex_Type,BaseType},S) of
		{ST = #schema_simple_type{content=C},_} ->
		    {NewContent,S2} = restrict_simple_type(C,CM,BaseType,S),
		    {ST#schema_simple_type{content=NewContent},S2};
		%% the outer complex type.
		{CT = #schema_complex_type{content=C},_} ->
		    {NewContent,S2} = restrict_type(C,CM,BaseType,S),
		    {CT#schema_complex_type{content=NewContent},S2};
		T -> T
	    end
    end;
resolve(optional_text,S) ->
    {optional_text,S};
resolve(E,S) ->
    ?debug("resolve(~p, S)~n",[E]),
    load_object(E,S).

%% explicit_type checks whether the instance element is of an explicit
%% type pointed out by xsi:type. A type referenced by xsi:type must be
%% the same as, or derived from the instance element's type. Concluded
%% from 3.4.6 section "Schema Component Constraint: Type Derivation OK
%% (Complex)".
explicit_type(XSDType,InstanceEl=#xmlElement{namespace=NS,attributes=Atts},S) ->
    case get_instance_type(NS,Atts) of
	false ->
	    resolve(XSDType,S);
	{ok,Name} ->
	    %% Create a {name,scope,namespace}, what is scope?
	    %% assume scope always is at top for the referenced type.
	    QName = mk_EII_QName(Name,InstanceEl,S#xsd_state{scope=[]}),
	    %% The type referenced by "xsi:type" attribute must be a
	    %% legal substitution for InstanceEl: "xsi:type" is the
	    %% same as or a derivation from InstanceEl's type.

	    {XsiType,S2} = resolve({simple_or_complex_Type,QName},S),
	    {_Blocks,S3} = legal_substitution(InstanceEl,XsiType,S2),
%% 	    {ResXSDType,S4} = resolve(XSDType,S3),
	    {XsiType,S3}
%% 	    merge_derived_types(ResXSDType,XsiType,Blocks,xsitype,S4)
    end.

get_instance_type(#xmlNamespace{nodes=Nodes},Atts) ->
    case keyNsearch(?XSD_INSTANCE_NAMESPACE,2,Nodes,[]) of
	{Prefix,_} ->
	    TypeAtt = list_to_atom(Prefix++":type"),
	    case keyNsearch(TypeAtt,#xmlAttribute.name,Atts,[]) of
		#xmlAttribute{value=Value} ->
		    {ok,Value};
		_ -> false
	    end;
	_ ->
	    false
    end.

merge_derived_types(Type1,Type2,Mode,S) ->
    merge_derived_types(Type1,Type2,[],Mode,S).
merge_derived_types(Type,Type,_Blocks,_Mode,S) ->
    {Type,S};
merge_derived_types(XSDType,InstType,Blocks,Mode,S) ->
    try merge_derived_types2(XSDType,InstType,Blocks,Mode,S) of
	{error,S2} ->
	    {InstType,S2};
	{MergedType,S2} ->
	    _ = save_merged_type(MergedType,S2),
	    {MergedType,S2}
    catch
	error:Reason:StackTrace ->
	    {InstType,acc_errs(S,{[],?MODULE,{internal_error,merge_derived_types,{Reason, StackTrace}}})};
	exit:Reason ->
	    {InstType,acc_errs(S,{[],?MODULE,{internal_error,merge_derived_types,Reason}})}
    end.

merge_derived_types2(XSDType=#schema_complex_type{},
		    InstType=#schema_complex_type{},Blocks,Mode,S) ->
    %% InstType is the type of the instance element that may reference
    %% a type that is an extension/restriction of the XSDType.
    %% Alternatively XSDType is the base type and InstType the derived
    %% type or XSDType is the original type that is redefined into
    %% InstType.
    %%
    %% complexType can turn into:
    %%        simpleContent | complexContent
    %% simpleContent -> restriction
    %% complexContent -> restriction | extension
    %% of course also one of:
    %% ((group | all | choice | sequence)?,
    %%	((attribute | attributeGroup)*,anyAttribute?))))
    %% but then it shouldn't be any difference between XSDType
    %% and InstType
   case InstType#schema_complex_type.content of
       [{extension,{BaseTypeName,CM}}] ->
	   {ExtendedAtts,S2} =
	       extend_attributes(XSDType#schema_complex_type.attributes,
				 InstType#schema_complex_type.attributes,
				 BaseTypeName,CM,Mode,
				 allowed_derivation(extension,Blocks,S)),
	   case compare_base_types(BaseTypeName,XSDType,S2) of
	       ok ->
		   {NewContent,S3} =
		       extend_type(XSDType#schema_complex_type.content,CM,S2),
		   {InstType#schema_complex_type{attributes=ExtendedAtts,
						 content=NewContent},S3};
	       Err ->
		   {error,acc_errs(S2,Err)}
	   end;
       [{restriction,{BaseTypeName,CM}}] ->
	   {RestrictedAtts,S2} =
	       restrict_attributes(XSDType#schema_complex_type.attributes,
				   InstType#schema_complex_type.attributes,
				   allowed_derivation(restriction,Blocks,S)),
	   case compare_base_types(BaseTypeName,XSDType,S2) of
	       ok ->
		   {NewContent,S3}=
		       case InstType#schema_complex_type.complexity of
			   simple ->
			       restrict_simple_type(XSDType#schema_complex_type.content,CM,BaseTypeName,S2);
			   _ ->
			       restrict_type(XSDType#schema_complex_type.content,CM,BaseTypeName,S2)
		       end,
		   {InstType#schema_complex_type{attributes=RestrictedAtts,
						 content=NewContent},S3};
	       Err ->
		   {error,acc_errs(S,Err)}
	   end;
       Other ->
	   {error,acc_errs(S,{[],?MODULE,{unexpected_type,Other}})}
   end;
merge_derived_types2(XSDType=#schema_simple_type{},
		    InstType=#schema_simple_type{},Blocks,_Mode,S) ->
    case InstType#schema_simple_type.content of
       [{restriction,{BaseTypeName,CM}}] ->
	    case compare_base_types(BaseTypeName,XSDType,S) of
		ok ->

		    {NewContent,S2}=
			restrict_simple_type(XSDType#schema_simple_type.content,CM,
				      BaseTypeName,S),
		    {InstType#schema_simple_type{content=NewContent},
		     allowed_derivation(restriction,Blocks,S2)};
		Err ->
		    {error,allowed_derivation(restriction,Blocks,
					      acc_errs(S,Err))}
	    end;
	Other ->
	    {error,acc_errs(S,{unexpected_type,Other})}
    end;
merge_derived_types2(XSDType=#schema_simple_type{content=XSDContent},
		     InstType=#schema_complex_type{},Blocks,_Mode,S) ->
    %% This is the way to add attributes to a simpleType
    case InstType#schema_complex_type.content of
	[{extension,{BaseTypeName,CM}}] ->
	    case compare_base_types(BaseTypeName,XSDType,S) of
		ok ->
		    {NewContent,S2} =
			if CM==[] -> {XSDContent,S};
			   true -> extend_type(XSDContent,CM,S)
			end,
		    {InstType#schema_complex_type{content=NewContent},
		     allowed_derivation(extension,Blocks,S2)};
		Err ->
		    {error,allowed_derivation(extension,Blocks,
					      acc_errs(S,Err))}
	    end;
	[{restriction,{BaseTypeName,_CM}}]
	when InstType#schema_complex_type.complexity == simple ->
	    case compare_base_types(BaseTypeName,XSDType,S) of
		ok ->
		    {InstType,
		     allowed_derivation(restriction,Blocks,S)};
		Err ->
		    {error,allowed_derivation(extension,Blocks,
					      acc_errs(S,Err))}
	    end;
	Other ->
	    {error,acc_errs(S,{[],?MODULE,{unexpected_type,Other}})}
    end;
merge_derived_types2(_XSDType={simpleType,BuiltInType},
		     InstType=#schema_complex_type{content=Content},
		     Blocks,_Mode,S) ->
    case Content of
	[{extension,{BuiltInType,CM}}] ->
	    {NewContent,S2} = extend_type([],CM,S),
	    {InstType#schema_complex_type{base_type=BuiltInType,
					  content=NewContent},
	     allowed_derivation(extension,Blocks,S2)};
	[{restriction,{BuiltInType,CM}}] ->
	    {NewContent,S2} = restrict_simple_type([],CM,BuiltInType,S),
	    {InstType#schema_complex_type{base_type=BuiltInType,
					  content=NewContent},
	     allowed_derivation(restriction,Blocks,S2)};
	Other ->
	    {error,acc_errs(S,{[],?MODULE,{unexpected_content,Other,InstType}})}
    end;
merge_derived_types2(_XSDType={anyType,_},InstType,Blocks,_Mode,S) ->
    case type_content(InstType) of
	[{restriction,{_BaseTypeName,CM}}] ->
	    {set_type_content(InstType,CM),
	     allowed_derivation(restriction,Blocks,S)};
	Other ->
	    {error,acc_errs(S,{[],?MODULE,{unexpected_content,Other,InstType}})}
    end;
merge_derived_types2({simpleType,BuiltInType},
		     InstType=#schema_simple_type{content=Content},
		     Blocks,_Mode,S) ->
    case Content of
	[{restriction,{BuiltInType,CM}}] ->
	    {InstType#schema_simple_type{base_type=BuiltInType,
					 content=CM},
	     allowed_derivation(restriction,Blocks,S)};
	Other ->
	    {error,acc_errs(S,{[],?MODULE,{unexpected_content,Other,InstType}})}
    end;
merge_derived_types2(XSDType,InstType,Blocks,Mode,S) ->
    case {variety_type(XSDType,S),variety_type(InstType,S)} of
	{XSDType,InstType} ->
	    {error,acc_errs(S,{[],?MODULE,{unexpected_type,XSDType,InstType}})};
	{_XSDType2,InstType2} ->
	    case allowed_derivation(substitution,Blocks,S) of
		S ->
		    merge_derived_types2(XSDType,InstType2,Blocks,Mode,S);
		S2 ->
		    {error,S2}
	    end
    end.

variety_type(#schema_simple_type{variety=list,content=[{list,[Type]}]},S) ->
    {VarietyType,_}=resolve(Type,S),
    VarietyType;
variety_type(#schema_simple_type{variety=union,content=[{union,Types}]},S) ->
    [T||{T,_}<-[resolve(VarietyType,S)||VarietyType<-Types]];
variety_type(Type,_S) ->
    Type.

allowed_derivation(_Derivation,_Blocks,S) ->
%%     case {member(Derivation,Blocks),member('#all',Blocks)} of
%% 	{true,_} ->
%% 	    acc_errs(S,{[],?MODULE,{derivation_blocked,Blocks,Derivation}});
%% 	{_,true} ->
%% 	    acc_errs(S,{[],?MODULE,{derivation_blocked,'#all',Derivation}});
%% 	_ ->
%% 	    S
%%     end.
    S.

%% El is the instance element that has the xsi:type attribute with
%% XsiType.
legal_substitution(El=#xmlElement{name=ElName},XsiType,S) ->
    %% See 3.3.6, Substitution Group OK (Transitive)
    %% For ok one of following: 1) same type in El as XsiType, 2)
    %% XsiType is a restriction/extension where El's type is the
    %% base, 3) XsiType is a member in the substitutionGroup of
    %% ElName.
    QName = mk_EII_QName(ElName,El,S),
    {HeadElement,_} = load_object({element,QName},S),

    legal_substitution2(HeadElement,XsiType,S).
legal_substitution2(#schema_element{type=Type,block=Bl},XsiType,S) ->
    {HeadType,_}=resolve(Type,S),
    Block = blocking(Bl,S#xsd_state.blockDefault),
    S2 = derived_or_equal_types(XsiType,HeadType,instance,Block,S),
    {Block,S2}.

compare_base_types(QName,#schema_complex_type{name=QName},_S) ->
    ok;
compare_base_types(QName1,#schema_complex_type{name=QName2},_S) ->
    {[],?MODULE,{names_not_equal,QName1,QName2}};
compare_base_types(QName,#schema_simple_type{name=QName},_S) ->
    ok;
compare_base_types(QName1,#schema_simple_type{name=QName2},_S) ->
    {[],?MODULE,{names_not_equal,QName1,QName2}}.
%%compare_base_types(QName1,Other,_S) ->
%%    {[],?MODULE,{miss_match_base_types,QName1,Other}}.

extend_type(Base,Extension,S) ->
    extend_type(Base,Extension,[],S).
%% Content may be (attribute | attributeGroup)*, anyAttribute? if
%% it is of simpleContent or:
%% (group | all | choice | sequence)?,((attribute | attributeGroup)*,
%%		anyAttribute?) if it is of complexContent
extend_type([],[],Acc,S) ->
    {reverse(Acc),S};
extend_type([BaseCM|BaseRest],Ext=[{SeqCho,{Extension,Occ}}|ExtRest],Acc,S)
  when SeqCho == sequence; SeqCho == choice ->
    case BaseCM of
	{SeqCho,{BC,_Occ}} ->
	    extend_type(BaseRest,ExtRest,[{SeqCho,{BC++Extension,Occ}}|Acc],S);
	G = {group,{_Ref,_Occ}} ->
	    {ResG,S2} = resolve(G,S),
	    case ResG of
	       #schema_group{content=GC} ->
		    case keysearch(SeqCho,1,GC) of
			{value,SCC} ->
			    extend_type([SCC|BaseRest],Ext,Acc,S);
			_ ->
			    S3 = acc_errs(S2,{[],?MODULE,{illegal_content_in_extension,Ext}}),
			    {reverse(Acc),S3}
		    end;
		_ ->
		    S3 = acc_errs(S2,{[],?MODULE,{illegal_content_in_extension,ResG}}),
		    {reverse(Acc),S3}
	    end;
	 _ ->
	    %% BaseCM may be a group that has a sequence
	    extend_type([BaseCM|BaseRest],ExtRest,[{SeqCho,{Extension,Occ}}|Acc],S)
    end;
extend_type(BaseCM,ExtCM,Acc,S) when is_list(BaseCM),is_list(ExtCM) ->
    extend_type([],[],reverse(ExtCM)++reverse(BaseCM)++Acc,S).

restrict_type(Content,CM,BaseTypeName,S)  ->
    restrict_type(Content,CM,BaseTypeName,[],S).
%% Restriction may appear within a 1) simpleType, 2) simpleContent or
%% 3) complexContent construct.
%% The possible content of restriction in different contexts are:
%% 1) (simpleType?, (Any facet)*)
%% 2) (simpleType?, (Any facet)*),((attribute | attributeGroup)*, anyAttribute?)
%% 3) (group | all | choice | sequence)?,
%%	   ((attribute | attributeGroup)*, anyAttribute?)
%% A restriction of a simpleType narrows the possible values of the
%% base type by applying facets.
%% A restriction of a complexType (simpleContent / complexContent) must
%% enumerate all elements, including the preserved ones of the base type.
%% Attributes don't have to be enumerated.
restrict_type([],[],_TypeName,Acc,S) ->
    {reverse(Acc),S};
restrict_type([{restriction,{_Type,CM1}}],[],_TypeName,Acc,S) ->
    {CM1++reverse(Acc),S};
restrict_type([{extension,{_Type,CM1}}],[],_TypeName,Acc,S) ->
    {CM1++reverse(Acc),S};
restrict_type(BaseRest,[ST={simpleType,_Name}|RestrRest],TypeName,Acc,S) ->
    %% context 1 or 2
    restrict_type(BaseRest,RestrRest,TypeName,[ST|Acc],S);
restrict_type([BaseCM|BaseRest],[{SeqCho,{CM,Occ}}|RestrRest],TypeName,Acc,S)
  when SeqCho == sequence; SeqCho == choice ->
    %% context 3
    case BaseCM of
	{SeqCho,{BCM,_}} ->
	    case check_element_presence(CM,BCM) of
		{error,Reason} ->
		    {reverse(Acc),acc_errs(S,Reason)};
		ok ->
		    restrict_type(BaseRest,RestrRest,TypeName,
				  [{SeqCho,{CM,Occ}}|Acc],S)
	    end;
	Other ->
	    {reverse(Acc),acc_errs(S,{[],?MODULE,{SeqCho,expected,Other,found}})}
    end;
restrict_type(BaseRest,[Facet={F,_Val}|RestrRest],TypeName,Acc,S) ->
    case is_facet(F) of
	true ->
	    restrict_type(BaseRest,RestrRest,TypeName,[Facet|Acc],S);
	_ ->
	    {reverse(Acc),acc_errs(S,{[],?MODULE,{does_not_support,Facet,in_restriction}})}
    end.

restrict_simple_type([{restriction,{_Type,BaseCM}}],RestrCM,_TypeName,S) ->
    restrict_simple_type(BaseCM,RestrCM,_TypeName,S);
restrict_simple_type(CM=[{extension,{_Type,_BaseCM}}],_RestrCM,TypeName,S) ->
    {[],acc_errs(S,{[],?MODULE,{illegal_content_simple_type,CM,TypeName}})};
restrict_simple_type(BaseCM,RestrCM,TypeName,S) ->
    %% all restrictions in base comes first, then check that no one of
    %% the facets in the restriction attempts to redefine a fixed
    %% facet in the base. Add the facets of the restriction.
    {Acc,S2} =
	case BaseCM of
	    [] -> {[],S};
	    _ ->
		restrict_simple_type([],BaseCM,TypeName,S)
	end,
    %% Acc = reverse(BaseCM),
    Fun = fun(X={simpleType,_},{Acc_in,S_in})->
  		  {[X|Acc_in],S_in};
	     (X={LU,_},{Acc_in,S_in}) when LU==list;LU==union ->
		  {[X|Acc_in],S_in};
 	     (X={F,_},{Acc_in,S_in})->
%%    Fun = fun(X={F,_},{Acc_in,S_in})->
		  case is_facet(F) of
		      true ->
			  {[X|Acc_in],S_in};
		      _ ->
			  {Acc_in,acc_errs(S_in,{[],?MODULE,{illegal_in_restriction_of_simpleType,X}})}
		  end;
	     (X,{Acc_in,S_in}) ->
		  {Acc_in,acc_errs(S_in,{[],?MODULE,{illegal_in_restriction_of_simpleType,X}})}
	  end,
    foldl(Fun,{Acc,S2},RestrCM).

check_element_presence([],_BCM) ->
    ok;
check_element_presence([{element,{Name,_}}|CM],BCM) ->
    case check_element_presence2(Name,BCM) of
	{ok,BCM2} ->
	    check_element_presence(CM,BCM2);
	_ ->
	    {error,{[],?MODULE,{element,Name,not_present_in_restriction}}}
    end;
check_element_presence([_C|CM],BCM) ->
    check_element_presence(CM,BCM).

check_element_presence2(Name,BCM) ->
    check_element_presence2(Name,BCM,[]).
check_element_presence2({LocalName,_,NS},[{element,{{LocalName,_,NS},_}}|BCM],Acc) ->
    {ok,reverse(Acc)++BCM};
check_element_presence2(Name,[E|BCM],Acc) ->
    check_element_presence2(Name,BCM,[E|Acc]);
check_element_presence2(_Name,[],_Acc) ->
    error.

%% A check of the extended attribute should take place here.
%%
extend_attributes(BaseAtts,[EA={attribute,Name}|ExtAtts],
		  BaseTypeName,CM,Mode,S) ->
    NewAtts=key_replace_or_insert(Name,2,BaseAtts,EA),
    extend_attributes(NewAtts,ExtAtts,BaseTypeName,CM,Mode,S);
%% Extension of wildcards should be handled as described in chapter
%% 3.4.2 and subsection "Complex Type Definition with simple content
%% Schema Component".
extend_attributes(BaseAtts,[LocalWC={anyAttribute,_NS_PC}|ExtAtts],
		  BaseTypeName,CM,deduce,S) ->
    {CompleteWC,S2} = complete_wildcard(LocalWC,CM,S),
    BaseWC = base_wildcard(BaseAtts),
    {NewWC,S4} =
    case BaseWC of
	[] -> {CompleteWC,S2};
	_ ->
	    if CompleteWC==LocalWC -> {BaseWC,S2};
	       true ->
		    {NS,S3} = attribute_wildcard_union(wc_ns(CompleteWC),
						       wc_ns(BaseWC),S2),
		    PC = wc_pc(CompleteWC),
		    {[{anyAttribute,{NS,PC}}],S3}
	    end
    end,
    NewBaseAtts = keyreplace(anyAttribute,1,BaseAtts,NewWC),
    extend_attributes(NewBaseAtts,ExtAtts,BaseTypeName,CM,deduce,S4);
extend_attributes(Atts,[],_,_,_Mode,S) ->
    {reverse(Atts),S}.
%% A check of the restricted attribute should take place here.
restrict_attributes(BaseAtts,[RA|RAtts],S) ->
%% NewAtts = keyreplace(Name,2,BaseAtts,EA),
    {NewAtts,S2} = restrict_attribute_replace(BaseAtts,RA,S),
    restrict_attributes(NewAtts,RAtts,S2);
restrict_attributes(Atts,[],S) ->
    {reverse(Atts),S}.
restrict_attribute_replace(BaseAtts,EA={attribute,Name},S) ->
    {keyreplace(Name,2,BaseAtts,EA),S};
restrict_attribute_replace(BaseAtts,EA={anyAttribute,{NS,_}},S) ->
    case key1search(anyAttribute,BaseAtts,false) of
	false ->
	    {BaseAtts,acc_errs(S,{invalid_derivation,EA,BaseAtts})};
	{_,{BaseNS,_}} ->
	    S2 = wildcard_subset(BaseNS,NS,S),
	    {keyreplace(anyAttribute,1,BaseAtts,EA),S2}
    end.
%% 3.10.6 Constraints on Wildcard Schema Components
%% Schema Component Constraint: Wildcard Subset
%% bullet 1:
wildcard_subset(['##any'],_NS,S) ->
    S;
%% bullet 2:
wildcard_subset([{'not',NS}],[{'not',NS}],S) ->
    S;
%% bullet 3:
%% if NS has a number of namespaces all of them must be in BaseNS,
%% if BaseNS has {not,Namespaces} neither of Namespaces must be in NS
wildcard_subset(_,[],S) ->
    S;
wildcard_subset(BaseNS,NS,S) when is_list(BaseNS),is_list(NS) ->
    case [X||X<-NS,member(X,BaseNS)] of
	NS ->
	    S;
	_ ->
	    acc_errs(S,{[],?MODULE,{wildcard_namespace,NS,
			not_subset_of_base_namespace,BaseNS}})
    end;
wildcard_subset(BaseNS=[{'not',BNS}],NS,S) when is_list(NS) ->
    case [X||X<-BNS,member(X,NS)] of
	[] ->
	    S;
	_ ->
	    acc_errs(S,{[],?MODULE,{wildcard_namespace,NS,
			not_subset_of_base_namespace,BaseNS}})
    end;
wildcard_subset(BaseNS,NS,S) ->
    acc_errs(S,{[],?MODULE,{wildcard_namespace,NS,
		not_subset_of_base_namespace,BaseNS}}).

base_wildcard(BaseAtts) ->
    key1search(anyAttribute,BaseAtts,[]).

complete_wildcard(LocalWC,CM,S) ->
    case keysearch(attributeGroup,1,CM) of
	{value,AttG={_,_Name}} ->
	    case resolve(AttG,S) of
		{#schema_attribute_group{content=Atts},_S} ->
		    case keysearch(anyAttribute,1,Atts) of
			{value,AA} ->
			    {PC,S2} =
				attribute_wildcard_intersection(wc_ns(LocalWC),
								wc_ns(AA),S),
			    {{anyAttribute,{wc_pc(LocalWC),PC}},S2};
			_ -> {LocalWC,S}
		    end;
		_ -> {LocalWC,S}
	    end;
	_ -> {LocalWC,S}
    end.

wc_ns({anyAttribute,{NS,_}})->
    NS;
wc_ns(_) ->
    [].
wc_pc({anyAttribute,{_,PC}})->
    PC;
wc_pc(_) ->
    strict.

%% Union of wildcard namespace:
%% 3.10.6 Constraints on Wildcard Schema Components
%% Schema Component Constraint: Attribute Wildcard Union
%% bullet 1
attribute_wildcard_union(NS,NS,S) ->
    {NS,S};
%% bullet 2
attribute_wildcard_union(NS1,NS2,S) when NS1==['##any'];NS2==['##any'] ->
    {['##any'],S};
attribute_wildcard_union(NS1,NS2,S) ->
    case {keysearch('not',1,NS1),keysearch('not',1,NS2)} of
	{false,false} -> %% bullet 3
	    {NS1 ++ [X||X<-NS2,member(X,NS1)==false],S};
	{{value,{_,Set1}},{value,{_,Set2}}} -> %% bullet 4 or 1
	    case {lists:sort(Set1),lists:sort(Set2)} of
		{L,L} ->    {[{'not',L}],S};
		_ ->	    {[{'not',[absent]}],S}
	    end;
	_ -> %% either is a {not,NS}
	    case toggle_ns(NS1,NS2) of
		{_O1=[absent],NS3} -> %% bullet 6
		    case member(absent,NS3)of
			true -> {['##any'],S};
			_ ->    {[{'not',[absent]}],S}
		    end;
		{O1=[O1Name],NS4} -> %% bullet 5
		    case member(O1Name,NS4) of
			true ->
			    case member(absent,NS4) of
				true -> {['##any'],S}; %% 5.1
			        _ ->    {[{'not',[absent]}],S} %% 5.2
			    end;
			_ ->
			    case member(absent,NS4) of
				true ->
				    %% not expressible 5.3
				    Err = {[],?MODULE,{wildcard_namespace_union_not_expressible,NS1,NS2}},
				    {[],acc_errs(S,Err)};
				_ -> {[{'not',O1}],S} %% 5.4
			    end
		    end
	    end
    end.

%% Schema Component Constraint: Attribute Wildcard Intersection
%% bullet 1
attribute_wildcard_intersection(O1,O1,S) -> {O1,S};
%% bullet 2
attribute_wildcard_intersection(['##any'],O2,S) -> {O2,S};
attribute_wildcard_intersection(O1,['##any'],S) -> {O1,S};
%% bullet 6
attribute_wildcard_intersection([{'not',[absent]}],O2=[{'not',_}],S) -> {O2,S};
attribute_wildcard_intersection(O1=[{'not',_}],[{'not',[absent]}],S) -> {O1,S};
%% bullet 5
attribute_wildcard_intersection([{'not',NS1}],[{'not',NS2}],S) ->
    case [X||X<-NS1,member(X,NS2)] of
	[] -> {[],acc_errs(S,{[],?MODULE,{wildcard_namespace_intersection_not_expressible,NS1,NS2}})};
	NS3 -> {[{'not',NS3}],S}
    end;
%% bullet 3
attribute_wildcard_intersection([{'not',NS}],O2,S) ->
    {lists:delete(absent,[X||X<-O2,member(X,NS)==false]),S};
attribute_wildcard_intersection(O1,[{'not',NS}],S) ->
    {lists:delete(absent,[X||X<-O1,member(X,NS)==false]),S};
%% bullet 4
attribute_wildcard_intersection(O1,O2,S) ->
    case [X||X<-O1,member(X,O2)] of
	[] ->
	    {[absent],S};
	L ->{L,S}
    end.

toggle_ns(NS1,NS2=[{'not',_}]) ->
    {NS2,NS1};
toggle_ns(NS1,NS2) ->
    {NS1,NS2}.


deduce_derived_types([DT|DTs],S) ->
    deduce_derived_types(DTs,deduce_derived_type(DT,S,[]));
deduce_derived_types([],S) ->
    S.

%% deduce_derived_type
deduce_derived_type(DT={_Kind,TName},S,RefChain) ->
    %% check circular references
    case keymember(TName,2,RefChain) of
	true ->
	    acc_errs(S,{[],?MODULE,{circular_reference_of_type,TName}});
	_ ->
	    deduce_derived_type2(DT,S,[DT|RefChain])
    end.
deduce_derived_type2(DT,S,RefChain) ->
    {DerivedType,_} = resolve(DT,S),
    case is_unmerged_type(DerivedType) of
	true ->
	    BaseTypeRef = get_base_type(DerivedType),
	    {BaseType,_} = resolve({simple_or_complex_Type,BaseTypeRef},S),
	    BaseTypeKind =
		fun(#schema_complex_type{}) -> complexType;
		   (_) -> simpleType
		end (BaseType),
	    case is_unmerged_type(BaseType) of
		true ->
		    %% both derived and not deduced
		    S2 = deduce_derived_type({BaseTypeKind,BaseTypeRef},S,RefChain),
		    case S2#xsd_state.errors==S#xsd_state.errors of
			true -> deduce_derived_type2(DT,S2,RefChain);
			_ -> S2
		    end;
		_ ->
		    {_,S2} = merge_derived_types(BaseType,DerivedType,deduce,S),
		    S2
	    end;
	_ ->
	    S
    end.
is_unmerged_type(Type) ->
    case type_content(Type) of
	[{restriction,_}] -> true;
	[{extension,_}] -> true;
	_ -> false
    end.
type_content(#schema_simple_type{content=C}) ->
    C;
type_content(#schema_complex_type{content=C}) ->
    C;
type_content(_) ->
    [].

set_type_content(Type=#schema_simple_type{},CM) ->
    Type#schema_simple_type{content=CM};
set_type_content(Type=#schema_complex_type{},CM) ->
    Type#schema_complex_type{content=CM}.

get_base_type(#schema_simple_type{base_type=BT}) ->
    BT;
get_base_type(#schema_complex_type{base_type=BT}) ->
    BT.

in_scope({Local,_Scope,_NS},S) ->
    in_scope(Local,S);
in_scope(Name,S=#xsd_state{scope=Scope}) when is_atom(Name) ->
    S#xsd_state{scope=[Name|Scope]};
in_scope(Name,S=#xsd_state{scope=Scope})  when is_list(Name) ->
    S#xsd_state{scope=[atom_if_shortasciilist(Name)|Scope]}.

out_scope({Local,_,_},S) ->
    out_scope(atom_if_shortasciilist(Local),S);
out_scope(Name,S=#xsd_state{scope=[Name|Rest]}) ->
    S#xsd_state{scope=Rest};
out_scope(_Name,S) ->
    S.

name_scope({'_xmerl_no_name_',Scope,_NS},S) ->
    S#xsd_state{scope=Scope};
name_scope({Name,Scope,_NS},S) ->
    S#xsd_state{scope=[Name|Scope]}.

reset_scope(S) ->
    S#xsd_state{scope=[]}.

set_scope(Scope,S) when is_list(Scope) ->
     S#xsd_state{scope=Scope};
set_scope(_,S) ->
    S.

is_global_env([_Env]) ->
    true;
is_global_env(_) ->
    false.

kind(#xmlElement{name=Name},S) ->
    LocalName=local_name(Name),
    is_a(LocalName,S).

kind(#xmlElement{name=Name}) ->
    LocalName=local_name(Name),
    element(1,is_a(LocalName,dummy)).

is_a(element,S) -> {element,S};
is_a(annotation,S) -> {annotation,S};
is_a(simpleType,S) -> {simpleType,S};
is_a(complexType,S) -> {complexType,S};
is_a(simpleContent,S) -> {simpleContent,S};
is_a(complexContent,S) -> {complexContent,S};
is_a(include,S) -> {include,S};
is_a(import,S) -> {import,S};
is_a(redefine,S) -> {redefine,S};
is_a(unique,S) -> {unique,S};
is_a(key,S) -> {key,S};
is_a(keyref,S) -> {keyref,S};
is_a(attribute,S) -> {attribute,S};
is_a(attributeGroup,S) -> {attributeGroup,S};
is_a(group,S) -> {group,S};
is_a(all,S) -> {all,S};
is_a(sequence,S) -> {sequence,S};
is_a(choice,S) -> {choice,S};
is_a(any,S) -> {any,S};
is_a(anyAttribute,S) -> {anyAttribute,S};
is_a(selector,S) -> {selector,S};
is_a(field,S) -> {field,S};
is_a(notation,S) -> {notation,S};
is_a(appinfo,S) -> {appinfo,S};
is_a(documentation,S) -> {documentation,S};
is_a(restriction,S) -> {restriction,S};
is_a(extension,S) -> {extension,S};
is_a(list,S) -> {list,S};
is_a(union,S) -> {union,S};
is_a(schema,S) -> {schema,S};
is_a(minExclusive,S) -> {minExclusive,S};
is_a(minInclusive,S) -> {minInclusive,S};
is_a(maxExclusive,S) -> {maxExclusive,S};
is_a(maxInclusive,S) -> {maxInclusive,S};
is_a(totalDigits,S) -> {totalDigits,S};
is_a(fractionDigits,S) -> {fractionDigits,S};
is_a(length,S) -> {length,S};
is_a(minLength,S) -> {minLength,S};
is_a(maxLength,S) -> {maxLength,S};
is_a(enumeration,S) -> {enumeration,S};
is_a(whiteSpace,S) -> {whiteSpace,S};
is_a(pattern,S) -> {pattern,S};
is_a(Name,S) when is_record(S,xsd_state) ->
    {Name,acc_errs(S,{[],?MODULE,{unknown_content,Name}})};
is_a(Name,_) ->
    exit({error,{internal_error,not_implemented,Name}}).




%% namespace/2 -> [token()]
%% token() -> {not,namespace_name()} | namespace_name()
%% ((##any | ##other) | List of (anyURI | (##targetNamespace | ##local)) )  : ##any
%% The result will be:
%% NSList ::= ['##any'] | [{'not',[TNS]}] | NSURIs
%% TNS    ::= URI | absent
%% NSURIs ::= (URI | absent) +
%% URI    ::= atomified URI-string
wildcard_namespace(E,S) ->
    AttVal = get_attribute_value(namespace,E,"##any"),
    ListOfVals = namestring2namelist(AttVal),
    Pred = fun('##other') ->
		   case S#xsd_state.targetNamespace of
		       undefined -> {'not',[absent]};
		       TN -> {'not',TN}
		   end;
	      ('##targetNamespace') ->
		   case S#xsd_state.targetNamespace of
		       undefined -> absent;
		       TN -> TN
		   end;
	      ('##local') -> absent;%%'##local'; %% any well-formed xml that
                                          %% is not qualified.
	      (X) -> X
	   end,
     [X||X <- map(Pred,ListOfVals),X=/=[]].

processor_contents(Any) ->
    case get_attribute_value(processContents,Any,strict) of
	V when is_list(V) -> list_to_atom(V);
	A -> A
    end.

base_type(E) ->
    get_attribute_value(base,E,[]).
base_type_type(Env) ->
    case member(simpleType,Env) of
	true -> simpleType;
	_ -> simple_or_complex_Type
    end.

attribute_ref(A) ->
    get_attribute_value(ref,A,[]).

particle_ref(El) ->
    get_attribute_value(ref,El,[]).

attributeGroup_ref(El) ->
    get_attribute_value(ref,El,[]).

get_value(El) ->
    get_attribute_value(value,El,undefined).

get_attribute_value(Key,#xmlElement{attributes=Atts},Default) ->
    case keyNsearch(Key,#xmlAttribute.name,Atts,Default) of
	#xmlAttribute{value=V} ->
	    V;
	_ -> Default
    end.

%% qualify_NCName/2 returns a qualified name, QName, that has
%% information of the name attribute and namespace of the XSD object.
%% The object E has a name attribute with a NCName. The Namespace
%% part of the QName is from the targetNamespace attribute of the
%% schema or the empty list.
qualify_NCName(E=#xmlElement{},S) ->
    case get_local_name(E) of
	[] -> no_name;
	LocalName ->
	    Namespace =
		case S#xsd_state.targetNamespace of
		    undefined ->
			[]; %%?XSD_NAMESPACE;
		    TNS ->
			TNS
		end,
	    {atom_if_shortasciilist(LocalName),S#xsd_state.scope,Namespace}
    end.


get_local_name(#xmlElement{attributes=Atts}) ->
    case keyNsearch(name,#xmlAttribute.name,Atts,[]) of
	#xmlAttribute{value=V} ->
	    V;
	Default -> Default
    end.

local_name(Name) when is_atom(Name) ->
    local_name(atom_to_list(Name));
local_name(Name) when is_list(Name) ->
    case splitwith(fun($:) -> false;(_)->true end,Name) of
	{_,":"++LocalName} -> list_to_atom(LocalName);
	_ ->
	    list_to_atom(Name)
    end.

%% transforms "a B c" to [a,'B',c]
namestring2namelist(Str) ->
    split_by_whitespace(Str,[]).
split_by_whitespace(Str,Acc) when is_list(Str),length(Str) > 0 ->
    F = fun($ ) ->
		false;
	   (_) ->
		true
	end,
    {Str1,Rest} = splitwith(F,Str),
    split_by_whitespace(string:strip(Rest),[list_to_atom(Str1)|Acc]);
split_by_whitespace(_,Acc) ->
    reverse(Acc).

%% get_QName(Name,S) where Name is a QName in string format, or where
%% a QName is expected according to schema specification. If the name
%% is unqualified it is qualified with the targetNamespace of the schema
%% or with the empty list.
get_QName(Name,NS,S) when is_atom(Name) ->
    get_QName(atom_to_list(Name),NS,S);
get_QName(Name,NS,#xsd_state{scope=Scope}) ->
    qualified_name(Name,NS,NS#xmlNamespace.default,Scope).

qualified_name(Name,NS,Default,Scope) ->
    case splitwith(fun($:) -> false;(_)->true end,Name) of
	{GlobalName,":"++LocalName} -> {atom_if_shortasciilist(LocalName),Scope,
					namespace(GlobalName,NS,Default)};
	_ ->
	    {atom_if_shortasciilist(Name),Scope,Default}
    end.

atom_if_shortasciilist(N) when is_list(N) ->
    try
        list_to_atom(N)
    catch
	error:_ ->
	    %% Reason may be system_limit if N is very long, it may be
	    %% badarg ifN is a list of UTF characters.
	    N
    end;
atom_if_shortasciilist(N) ->
    N.

namespace("xml",_,_) -> 'http://www.w3.org/XML/1998/namespace';
namespace(Prefix,NS,Default) ->
    case key1search(Prefix,NS#xmlNamespace.nodes,Default) of
	{Prefix,Namespace} ->
	    Namespace;
	Namespace -> Namespace
    end.


%% mk_EII_QName/2
%% makes a name with qualified info out of an Element Information Item
%% A) If name is qualified get namespace matching prefix.
%% B) If not qualified search parents for a namespace:
%% 1) use default namespace if defined, else.
%% 2) if a parent is qualified use that namespace or
%% 3) no namespace is applied
mk_EII_QName(Name,#xmlElement{name=Me,namespace=NS,parents=P},S)
  when is_list(Name) ->
    mk_EII_QName(list_to_atom(Name),
		 #xmlElement{name=Me,namespace=NS,parents=P},S);
mk_EII_QName(Name,#xmlElement{name=Me,namespace=NS,parents=P},S) ->
    Scope = S#xsd_state.scope,
    NameStr = atom_to_list(Name),
    case string:tokens(NameStr,":") of
	["xmlns",PrefixDef] -> %% special case
	    {'xmlns',Scope,namespace(PrefixDef,NS,[])};
	[Prefix,LocalName] -> %% A
	    {list_to_atom(LocalName),Scope,namespace(Prefix,NS,[])};
	[_LocalName] -> %% B
	    {Name,Scope,mk_EII_namespace([{Me,0}|P],NS,S)}
    end.
mk_EII_namespace([],#xmlNamespace{default=DefaultNS},_S) ->
    DefaultNS;
%%mk_EII_namespace([{PName,_}|GrandPs],NS=#xmlNamespace{default=[]},S) ->
mk_EII_namespace([{PName,_}|GrandPs],NS,S) ->
    NameStr = atom_to_list(PName),
    case string:tokens(NameStr,":") of
	[Prefix,_LocalName] ->
	    namespace(Prefix,NS,[]);
	[_LocalName] ->
	    mk_EII_namespace(GrandPs,NS,S)
    end;
mk_EII_namespace(_,NS,_S) ->
    NS#xmlNamespace.default.

mk_EII_Att_QName(AttName,XMLEl,S) when is_list(AttName) ->
    mk_EII_Att_QName(list_to_atom(AttName),XMLEl,S);
mk_EII_Att_QName(AttName,XMLEl,S) ->
    NameStr = atom_to_list(AttName),
    {member($:,NameStr),mk_EII_QName(AttName,XMLEl,S)}.



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% table access functions
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
create_tables(S=#xsd_state{table=undefined}) ->
    Tid=ets:new(xmerl_schema_tab,[]),
    S#xsd_state{table=Tid};
create_tables(S) ->
    S.

delete_table(#xsd_state{table=Tab}) ->
    try
        ets:delete(Tab)
    catch
        error:Reason:StackTrace -> {'EXIT', {Reason, StackTrace}};
        exit:Reason -> {'EXIT', Reason}
    end.

-doc hidden.
print_table(#xsd_state{table=Tab}) ->
    try
        ets:tab2list(Tab)
    catch
	error:Reason:StackTrace ->
	    {error,{?MODULE,[],{Reason, StackTrace}}}
    end;
print_table(_) ->
    ok.

%save_object({name,_},S) ->
%    %% already saved.
%    S;
%% only simpleType asn complexType are temporary saved with
%% three-tuple key. They are loaded and merged in redefine/2.
save_object({Kind,Obj},S=#xsd_state{redefine=true})
  when  Kind == simpleType; Kind == complexType ->
    save_in_table({Kind,redefine,object_name(Obj)},Obj,S);
save_object({Kind,Obj},S=#xsd_state{redefine=true})
  when Kind == group; Kind == attributeGroup ->
    save_in_table({Kind,object_name(Obj)},Obj,S);
save_object({Kind,Obj},S) when Kind == simpleType; Kind == complexType ->
    save_unique_type({Kind,object_name(Obj)},Obj,S);
save_object({Kind,Obj},S)
  when Kind == attributeGroup; Kind == group ->
    save_uniquely({Kind,object_name(Obj)},Obj,S);
save_object({Kind,Obj},S) ->
    save_in_table({Kind,object_name(Obj)},Obj,S).

save_unique_type(Key={_,Name},Obj,S) ->
    case resolve({simple_or_complex_Type,Name},S) of
	{#schema_simple_type{},_} ->
	    acc_errs(S,{[],?MODULE,{type_not_uniquely_defined_in_schema,Name}});
	{#schema_complex_type{},_} ->
	    acc_errs(S,{[],?MODULE,{type_not_uniquely_defined_in_schema,Name}});
	_ ->
	    save_in_table(Key,Obj,S)
    end.

save_uniquely(Key,Obj,S) ->
    case load_object(Key,S) of
	{[],_} ->
	    save_in_table(Key,Obj,S);
	_ ->
	    acc_errs(S,{[],?MODULE,{not_uniquely_defined_in_schema,Key}})
    end.



save_schema_element(CM,S=#xsd_state{elementFormDefault = EFD,
				    attributeFormDefault = AFD,
				    targetNamespace = TN,
				    finalDefault = FD,
				    blockDefault = BD}) ->
    ElementList = [X||X = {element,_} <- CM],
%%    OtherGlobalEls = other_global_elements(S,ElementList),
    Schema = get_schema_cm(S#xsd_state.table,TN),
    Schema2 =
    case Schema == #schema{} of
	true ->
	    Schema#schema{elementFormDefault = EFD,
			  attributeFormDefault = AFD,
			  targetNamespace = TN,
			  blockDefault = BD,
			  finalDefault = FD,
			  content = ElementList};
	_ ->
	    Content = Schema#schema.content,
	    Schema#schema{content=[X||X<-Content,member(X,ElementList)==false]++ElementList}
    end,
    TN2 = case TN of
	      undefined -> [];
	      _ -> TN
	  end,
    _ = save_in_table({schema,TN2},Schema2,S),
    save_to_file(S).

%% other_global_elements(S,ElementList) ->
%%     Schema = get_schema_cm(S#xsd_state.table,S#xsd_state.targetNamespace),
%%     [X||X<-Schema#schema.content,
%% 	member(X,ElementList) == false].

%% other_global_elements(#xsd_state{schema_name=SchemaName,
%% 				 table = Tab,
%% 				 global_element_source=GES},ElementList) ->
%%     case [X||{Y,X}<-GES,Y==SchemaName] of
%% 	[] ->
%% 	    [];
%% 	L -> %% All other schemas included in redefine
%% 	    NameList = [X||{element,{X,_}}<-ElementList],
%% 	    Contents =
%% 		flatten([X||#schema{content=X}<-[get_schema_cm(Tab,Y)||Y<-L]]),
%% 	    SortFun =
%% 		fun({_,{A,_}},{_,{B,_}}) when A =< B ->
%% 			true;
%% 		   (_,_) -> false end,
%% 	    [X||X={element,{Y,_}}<-lists:sort(SortFun,Contents),member(Y,NameList)==false]
%%     end.

save_to_file(S=#xsd_state{tab2file=true},FileName) ->
    save_to_file(S#xsd_state{tab2file=FileName});
save_to_file(_,_) ->
    ok.

save_to_file(S=#xsd_state{tab2file=TF}) ->
    case TF of
	true ->
	    {ok,IO}=file:open(filename:rootname(S#xsd_state.schema_name)++".tab",
			      [write]),
            try
                List = ets:tab2list(S#xsd_state.table),
                io:format(IO,"~p~n",[List])
            catch
                E:Reason:Stacktrace ->
                    logger:info("~p:save_to_file: ~p\n~p\n~p\n\n", [?MODULE, E, Reason, Stacktrace]),
                    ok
            end,
	    ok = file:close(IO);
	false ->
	    ok;
	IOFile ->
	    {ok,IO}=file:open(IOFile,[write]),
            try
                List = ets:tab2list(S#xsd_state.table),
                io:format(IO,"~p~n",[List])
            catch
                E:Reason:Stacktrace ->
                    logger:info("~p:save_to_file: ~p\n~p\n~p\n\n", [?MODULE, E, Reason, Stacktrace]),
                    ok
            end,
	    ok = file:close(IO)
    end.

save_merged_type(Type=#schema_simple_type{},S) ->
    resave_object({simpleType,Type},S);
save_merged_type(Type=#schema_complex_type{},S) ->
    resave_object({complexType,Type},S).
resave_object({Kind,Obj},S) ->
    save_in_table({Kind,object_name(Obj)},Obj,S).

save_in_table(Name,ElDef,S=#xsd_state{table=Tab}) ->
    try
        ets:insert(Tab,{Name,ElDef}),
        S
    catch
        _:_ -> S
    end.

save_idc(key,IDConstr,S) ->
    save_key(IDConstr,S);
save_idc(keyref,IDConstr,S) ->
    save_keyref(IDConstr,S);
save_idc(unique,IDConstr,S) ->
    save_unique(IDConstr,S).

save_key(Key,S) ->
    _ = save_object({key,Key},S),
    S.

save_keyref(KeyRef=#id_constraint{category=keyref},S) ->
    S1 = add_keyref(KeyRef,S),
    _ = save_object({keyref,KeyRef},S1),
    S1;
save_keyref(_,S) ->
    S.

save_unique(Unique,S) ->
    _ = save_object({unique,Unique},S),
    S.

save_substitutionGroup([],S) ->
    S;
save_substitutionGroup([{Head,Members}|SGs],S) ->
    %% save {head,[members]}
    _ = save_in_table({substitutionGroup,Head},Members,S),
    %% save {member,head}, an element can only be a member in one
    %% substitutionGroup
    lists:foreach(fun(X)->save_in_table({substitutionGroup_member,X},Head,S) end,Members),
    save_substitutionGroup(SGs,S).
substitutionGroup_member(ElName,S) ->
    case load_object({substitutionGroup_member,ElName},S) of
	{[],_} ->
	    false;
	{Res,_} ->
	    Res
    end.
%% substitutionGroup_head(Head,S) ->
%%     case load_object({substitutionGroup,Head},S) of
%% 	{[],_} ->
%% 	    false;
%% 	{Res,_} ->
%% 	    Res
%%     end.

add_keyref(#id_constraint{name=Name,refer=Refer},
	   S=#xsd_state{keyrefs=KeyRefs}) ->
    S#xsd_state{keyrefs=add_once({keyref,Name,Refer},KeyRefs)}.


load_redefine_object({Kind,Name},S) ->
    load_object({Kind,redefine,Name},S).

load_object({element,{QN,Occ={Min,_}}},S) when is_integer(Min) ->
    case load_object({element,QN},S) of
	{SE=#schema_element{},S1} -> {SE#schema_element{occurrence=Occ},S1};
	Other -> Other
    end;
load_object({group,{QN,_Occ={Min,_}}},S) when is_integer(Min) ->
    load_object({group,QN},S);
load_object(Key,S=#xsd_state{table=Tab}) ->
    case ets:lookup(Tab,Key) of
	[{Key,Value}] ->
	    {Value,S};
	[] ->
	    case ets:lookup(Tab,global_def(Key)) of
		[{_,Value}] -> {Value,global_scope(S)};
		Other -> {Other,S}
	    end;
	Other ->
	    {Other,S}
    end.


load_keyref(Name,S) ->
    case load_object({keyref,Name},S) of
	{KeyRef=#id_constraint{},_} -> KeyRef;
	_ ->
	    []
    end.
load_key(Name,S) ->
    case load_object({key,Name},S) of
	{Key=#id_constraint{},_} -> Key;
	_ ->
	    case load_object({unique,Name},S) of
		{Key=#id_constraint{},_} -> Key;
		_  ->
		    []
	    end
    end.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% END table access functions
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

save_ID(ID,S) ->
    case member(ID,S#xsd_state.'IDs') of
	true ->
	    acc_errs(S,{'ID_name_not_unique',ID});
	_ ->
	    S#xsd_state{'IDs'=[ID|S#xsd_state.'IDs']}
    end.
check_and_save_ID(ID,S) ->
    case xmerl_xsd_type:check_simpleType('ID',ID,S) of
	{ok,ID} ->
	    save_ID(ID,S);
	_ ->
	    acc_errs(S,{illegal_ID_value,ID})
    end.

insert_substitutionGroup(#schema_element{substitutionGroup=undefined},S) ->
    S;
insert_substitutionGroup(#schema_element{name=Name,
					 substitutionGroup=SG},
			 S=#xsd_state{substitutionGroups=SGregister}) ->
    case key1search(SG,SGregister,[]) of
	{_,SGList} ->
	    S#xsd_state{substitutionGroups=
			keyreplace(SG,1,SGregister,{SG,[Name|SGList]})};
	_ ->
	    S#xsd_state{substitutionGroups=[{SG,[Name]}|SGregister]}
    end.


global_scope(S=#xsd_state{}) ->
    S#xsd_state{scope=[]}.

global_def({Kind,{Local,_,NS}})
  when Kind==simpleType; Kind==complexType; Kind==group;
       Kind==attributeGroup; Kind==element; Kind==attribute;
       Kind==substitutionGroup;Kind==substitutionGroup_member->
    {Kind,{Local,[],NS}};
global_def(D) -> D.


get_schema_cm(Tab,undefined) ->
    get_schema_cm(Tab,[]);
get_schema_cm(Tab,[]) ->
    get_schema_cm1(Tab,[]);
get_schema_cm(Tab,Namespace) ->
    NoNamespaceC=get_no_namespace_content(Tab),
    Schema = get_schema_cm1(Tab,Namespace),
    NSC = Schema#schema.content,
    Schema#schema{content=NSC++[X||X<-NoNamespaceC,member(X,NSC)==false]}.
get_schema_cm1(Tab,Namespace) ->
    try ets:lookup(Tab,{schema,Namespace}) of
	[{_,H}] ->
	    H;
	_ ->
	    #schema{}
    catch
        _:_ ->  #schema{}
    end.
get_no_namespace_content(Tab) ->
    case get_schema_cm1(Tab,[]) of
	#schema{content=C} ->
	    C;
	_ -> []
    end.


%% is_simple_type(Type,S) when is_atom(Type) ->
%%     is_simple_type(atom_to_list(Type),S);
is_simple_type({LName,Scope,NS},S) when is_atom(LName) ->
    is_simple_type({atom_to_list(LName),Scope,NS},S);
is_simple_type(QName={_,_,_},S) ->
    case is_builtin_simple_type(QName) of
	true ->
	    true;
	_ ->
	    is_derived_simple_type(QName,S)
    end.


is_derived_simple_type(QName,S) ->
%%    case resolve({simple_or_complex_Type,QName},S) of
    case resolve({simpleType,QName},S) of
	{#schema_simple_type{},_} -> true;
	_ -> false
    end.



object_name(#schema_element{name=N}) ->
    N;
object_name(#schema_simple_type{name=N}) ->
    N;
object_name(#schema_complex_type{name=N}) ->
    N;
object_name(#schema_attribute{name=N}) ->
    N;
object_name(#schema_attribute_group{name=N}) ->
    N;
object_name(#schema_group{name=N}) ->
    N;
object_name(#id_constraint{name=N}) ->
    N.


is_whitespace(#xmlText{value=V}) ->
    case [X|| X <- V, whitespace(X) == false] of
	[] ->
	    true;
	_ -> false
    end;
is_whitespace(_) ->
    false.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% fetch
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
fetch(URI,S) ->
    Split = filename:split(URI),
    Filename = fun([])->[];(X)->lists:last(X) end (Split),
    Fullname =
	case Split of %% how about Windows systems?
	    ["file:"|Name]-> %% absolute path, see RFC2396 sect 3
		%% file:/dtd_name
		filename:join(["/"|Name]);
	    ["/"|Rest] when Rest /= [] ->
		%% absolute path name
		URI;
	    ["http:"|_Rest] ->
		{http,URI};
	    [] -> %% empty systemliteral
		[];
	    _ ->
		case S#xsd_state.external_xsd_base of
		    true ->
			filename:join(S#xsd_state.xsd_base, URI);
		    false ->
			filename:join(S#xsd_state.xsd_base, filename:basename(URI))
		end
	end,
    Path = path_locate(S#xsd_state.fetch_path, Filename, Fullname),
    ?dbg("fetch(~p) -> {file, ~p}.~n", [URI, Path]),
    {ok, Path, S}.

path_locate(_, _, {http,_}=URI) ->
    URI;
path_locate(_, _, []) ->
    [];
path_locate([Dir|Dirs], FN, FullName) ->
    F = filename:join(Dir, FN),
    case file:read_file_info(F) of
	{ok, #file_info{type = regular}} ->
	    {file,F};
	_ ->
	    path_locate(Dirs, FN, FullName)
    end;
path_locate([], _FN, FullName) ->
    {file,FullName}.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% return
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

return_error(Errs) ->
    {error,reverse(Errs)}.

return_schema_error(Errs) ->
    {error,{schema_failure,reverse(Errs)}}.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% general helper functions
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

if_atom_to_list(A) when is_atom(A) ->
    atom_to_list(A);
if_atom_to_list(L) ->
    L.
if_list_to_atom(L) when is_list(L) ->
    list_to_atom(L);
if_list_to_atom(A) ->
    A.

list_members(Members,CompleteList) ->
    case [X||X<-Members,member(X,CompleteList)==false] of
	[] ->
	    true;
	L ->
	    {error,L}
    end.

whitespace(X) when ?whitespace(X) ->
    true;
whitespace(_) ->
    false.

key1search(Key,List,Default) ->
    case keysearch(Key,1,List) of
	{value,V} -> V;
	_ -> Default
    end.

keyNsearch(Key,N,L,Default) ->
    case keysearch(Key,N,L) of
	{value,V} -> V;
	_ -> Default
    end.

key_replace_or_insert(Key,N,List,Tuple) ->
    case keyreplace(Key,N,List,Tuple) of
	List ->
	    [Tuple|List];
	NewList ->
	    NewList
    end.

keysearch_delete(Key,N,List,Default) ->
    case keysearch(Key,N,List) of
	{value,Res} ->
	    {Res,keydelete(Key,N,List)};
	_ ->
	    {Default,List}
    end.

search_delete_all_el(ElName,ElList,S) ->
    case search_delete_all_el2(ElName,ElList,[]) of
	false ->
	    case substitutionGroup_member(ElName,S) of
		false ->
		    false;
		Head  ->
		    case search_delete_all_el(Head,ElList,S) of
			{_,Rest} ->
			    {Name,_,NS} = ElName,
			    {{element,{Name,[],NS}},Rest};
			_ ->
			    false
		    end
	    end;
	Res ->
	    Res
    end.
search_delete_all_el2(_ElName,[],_NoMatch) ->
    false;
%% name must match defined (local scope) and referenced (global scope)
%% elements.
search_delete_all_el2({Name,Scope,NS},
		     [El={element,{{Name,ScopeCM,NS},_}}|Rest],
		     NoMatch)
  when Scope == ScopeCM; ScopeCM == [] ->
    {El,reverse(NoMatch)++Rest};
search_delete_all_el2(ElName,[H|T],NoMatch) ->
    search_delete_all_el2(ElName,T,[H|NoMatch]).

%% Search attribute should not consider the scope. All attributes
%% allowed in this scope are in SchemaAttList.
search_attribute(true,{Name,_,Namespace},SchemaAtts) ->
    case [A||A={_,{N,_,NS}}<-SchemaAtts,N==Name,NS==Namespace] of
	[] ->
	    {undefined,SchemaAtts};
	[Attr] ->
	    {Attr,lists:delete(Attr,SchemaAtts)}
    end;
search_attribute(_,{Name,_,_},SchemaAtts) ->
    case [A||A={_,{N,_,_}}<-SchemaAtts,N==Name] of
	[] ->
	    {undefined,SchemaAtts};
	[Attr] ->
	    {Attr,lists:delete(Attr,SchemaAtts)}
    end.

error_msg(Format,Args) ->
    error_logger:error_msg(Format,Args).


add_once(El,L) ->
    case member(El,L) of
	true ->
	    L;
	_ ->
	    [El|L]
    end.

add_key_once(Key,N,El,L) ->
    case keymember(Key,N,L) of
	true ->
	    L;
	_ ->
	    [El|L]
    end.

%% shema_el_pathname({Type,_},Env) ->
%%     mk_path(reverse([Type|Env])).
%% xml_el_pathname(#xmlElement{name=Name,parents=Parents,pos=Pos}) ->
%%     {element,mk_xml_path(Parents,Name,Pos)};
%% xml_el_pathname(#xmlAttribute{name=Name,parents=Parents,pos=Pos}) ->
%%     {attribute,mk_xml_path(Parents,Name,Pos)};
%% xml_el_pathname(#xmlText{parents=Parents,pos=Pos}) ->
%%     {text,mk_xml_path(Parents,text,Pos)}.

%% mk_path([]) ->
%%     [];
%% mk_path(L) when is_list(L) ->
%%     "/"++filename:join(L).

%% mk_xml_path(Parents,Type,Pos) ->
%% %%    ?dbg("mk_xml_path: Parents = ~p~n",[Parents]),
%%     {filename:join([[io_lib:format("/~w(~w)",[X,Y])||{X,Y}<-Parents],Type]),Pos}.

-doc "Format error descriptions to human readable strings.".
-spec format_error(Reasons) -> io_lib:chars() when
      Reasons :: [Reason :: term()] | Reason :: term().
format_error(L) when is_list(L) ->
    [format_error(X)||X<-L];
format_error({unexpected_rest,UR}) ->
    io_lib:format("XML: The following content of an element didn't validate by the provided schema, ~n~p.",[UR]);
format_error({unvalidated_rest,UR}) ->
    io_lib:format("XML: The following content of an element didn't validate by the provided schema, ~n~p.",[UR]);
format_error({no_schemas_provided}) ->
    "Schema: Validator found no schema. A schema must be provided for validation.";
format_error({internal_error,Reason}) ->
    io_lib:format("An error occurred that was unforeseen, due to ~p.",[Reason]);
format_error({internal_error,Reason,Info}) ->
    io_lib:format("An error occurred that was unforeseen, due to ~p: ~p.",[Reason,Info]);
format_error({internal_error,Function,Info1,Info2}) ->
    io_lib:format("An internal error occurred in function ~p with args: ~p,~p.",[Function,Info1,Info2]);
format_error({illegal_content,Reason,Kind}) ->
    io_lib:format("Schema: The schema violates the content model allowed for schemas.~nReason: ~p,~nkind of schema element: ~p.",[Reason,Kind]);
format_error({no_match,Kind}) ->
    io_lib:format("Schema: The schema violates the content model allowed for schemas.~nKind of schema element: ~p.",[Kind]);
format_error({bad_match,S4SC,CM}) ->
    io_lib:format("Schema: The schema missed mandatory elements ~p in ~p.",[S4SC,CM]);
format_error({unmatched_mandatory_object,SequenceEl1,SequenceEl2}) ->
    io_lib:format("Schema: The schema should have had an ~p object after the ~p, but it was missing.",[SequenceEl2,SequenceEl1]);
format_error({parsing_external_schema_failed,File,Reason}) ->
    io_lib:format("Schema: Parsing the referenced external schema ~p, failed due to ~p.",[File,Reason]);
format_error({fetch_fun_failed,Other}) ->
    io_lib:format("Schema: Fetching this kind of external schema is not supported ~p.",
		  [Other]);
format_error({element_not_in_schema,[EIIName,_ElQName,_CM]}) ->
    io_lib:format("XML: The XML element ~p are not present in the schema.",
		  [EIIName]);
format_error({missing_mandatory_element,CMEl}) ->
    io_lib:format("XML: The XML file missed mandatory element(s) ~p defined in schema.",[CMEl]);
format_error({empty_content_not_allowed,C}) ->
    io_lib:format("XML: The XML file missed mandatory element(s): ~p defined in schema.",[C]);
format_error({element_not_suitable_with_schema,ElName,_S}) ->
    io_lib:format("XML: The XML element: ~p violates the schema, probably to many of same element.",[ElName]);
format_error({element_not_suitable_with_schema,ElName,CMName,_CMEl,_S}) ->
    io_lib:format("XML: The XML element: ~p violates the schema. Schema expected element ~p.",[ElName,CMName]);
format_error({no_element_expected_in_group,XML}) ->
    io_lib:format("XML: The XML element(s) ~p violates the schema. No element was expected.",[XML]);
format_error({element_bad_match,E,Any,_Env}) ->
    io_lib:format("XML: XML element ~p didn't match into the namespace of schema type any ~p.",[E,Any]);
format_error({match_failure,_XML,_CM,_S}) ->
    "XML: A combination of XML element(s) and schema definitions that is not known has occurred. The implementation doesn't support this structure.";
format_error({cannot_contain_text,_XMLTxt,CMEl}) ->
    io_lib:format("XML: The schema structure: ~p doesn't allow text",[CMEl]);
format_error({missing_mandatory_elements,MandatoryEls}) ->
    io_lib:format("XML: A schema sequence has mandatory elements ~p, that were unmatched.",[MandatoryEls]);
format_error({choice_missmatch,T,Els}) ->
    io_lib:format("XML: A schema choice structure with the alternatives: ~p doesn't allow the text: ~p.",[Els,T]);
format_error({no_element_matching_choice,XML}) ->
    io_lib:format("XML: The choice at location: ~p had no alternative that matched the XML structure(s): ~p.",[error_path(XML,undefined),XML]);
format_error({all_missmatch,T,CM}) ->
    io_lib:format("XML: The schema expected one of: ~p, but the XML content was text: ~p at the location: ~p.",[CM,T,error_path(T,undefined)]);
format_error({element_not_in_all,ElName,E,_CM}) ->
    io_lib:format("XML: The element ~p at location ~p in the XML file was not allowed according to the schema.",[ElName,error_path(E,undefined)]);
format_error({missing_mandatory_elements_in_all,MandatoryEls}) ->
    io_lib:format("XML: The schema elements ~p were missed in the XML file.",[MandatoryEls]);
format_error({failed_validating,E,Any}) ->
    io_lib:format("XML: The element ~p at location ~p failed validation. It should have been matched by an any schema element ~p",[E#xmlElement.name,error_path(E,undefined),Any]);
format_error({schemaLocation_list_failure,Paths}) ->
    io_lib:format("XML: schemaLocation values consists of one or more pairs of URI references, separated by white space. The first is a namespace name the second a reference to a schema: ~p.",[Paths]);
format_error({element_content_not_nil,XMLEl}) ->
    io_lib:format("XML: The element ~p at position ~p has content of text/elements despite the nillable attribute was true.",[XMLEl#xmlElement.name,error_path(XMLEl,undefined)]);
format_error({attribute_in_simpleType,El,Att}) ->
    io_lib:format("XML: The element ~p at location ~p must not have attributes like: ~p since it according to the schema has simpleType type.",[El#xmlElement.name,error_path(El,undefined),Att]);
format_error({required_attribute_missed,El,Name}) ->
    io_lib:format("XML: The schema required an attribute ~p in element at location ~p that was missing.",[Name,error_path(El,undefined)]);
format_error({default_and_fixed_attributes_mutual_exclusive,
	      Name,Default,Fix}) ->
    io_lib:format("Schema: It is an error in the schema to assign values for both default and fix for an attribute. Attribute: ~p, default: ~p, fix: ~p.",[Name,Default,Fix]);
format_error({schema_error,unexpected_object,_SA,_Err}) ->
    "Schema: An unforeseen error case occurred, maybe due to an unimplemented feature.";
format_error({attribute_not_defined_in_schema,Name}) ->
    io_lib:format("XML: The attribute ~p is not defined in the provided schema.",[Name]);
format_error({disallowed_namespace,Namespace,NS,Name}) ->
    io_lib:format("XML: The attribute ~p is not valid because the namespace ~p is forbidden by ~p",[Name,NS,Namespace]);
format_error({cirkular_attributeGroup_reference,Name}) ->
    io_lib:format("Schema: Cirkular references to attribute groups are forbidden. One was detected including ~p.",[Name]);
format_error({could_not_resolve_type,ST}) ->
    io_lib:format("Schema: The simpleType ~p could not be found among the types defined by the provided schema.",[ST]);
format_error({could_not_check_value_for_type,Type}) ->
    io_lib:format("XML: Checking value for type ~p is not implemented.",[Type]);
format_error({unknown_simpleType,BT}) ->
    io_lib:format("Schema: The simpleType ~p could not be found among the types defined by the provided schema",[BT]);
format_error({abstract_element_instance,ElName}) ->
    io_lib:format("XML: Elements defined as abstract in the schema must not be instantiated in XML: ~p.",[ElName]);
format_error({qualified_name_required,LocalName}) ->
    io_lib:format("XML: Element name ~p in XML instance is not qualified, though the schema requires that.",[LocalName]);
format_error({unqualified_name_required,QualifiedName}) ->
    io_lib:format("XML: Element name ~p in XML instance must be unqualified, according to schema.",[QualifiedName]);
format_error({illegal_key_sequence_value,Err}) ->
    io_lib:format("XML: The 'key-sequence', (se XML-spec 3.11.4), must be a node with at most one member: ~p",[Err]);
format_error({qualified_node_set_not_correct_for_key,_Err}) ->
    "Schema: The 'target node set' and 'qualified node set' (se XML-spec 3.11.4.2.1) must be equal.";
format_error({key_value_not_unique,KS}) ->
    io_lib:format("Schema: Key values must be unique within the schema. This is not ~p,",[KS]);
format_error({keyref_missed_matching_key,Refer}) ->
    io_lib:format("Schema: This keyref had no matching key ~p.",[Refer]);
format_error({keyref_unexpected_object,_Other}) ->
    "Schema: An unforeseen error case occurred, unknown failure cause.";
format_error({cardinality_of_fields_not_equal,KR,K}) ->
    io_lib:format("Schema: keyref and the corresponding key must have same cardinality of their fields. Mismatch in this case keyref: ~p, key: ~p.",[KR,K]);
format_error({could_not_load_keyref,Name}) ->
    io_lib:format("Schema: The schema didn't define a keyref with the name ~p.",[Name]);
format_error({reference_undeclared,Kind,Ref}) ->
    io_lib:format("Schema: The schema didn't define an ~p with the name ~p.",[Kind,Ref]);
format_error({cyclic_substitutionGroup,SGs}) ->
    io_lib:format("Schema: cyclic substitutionGroup was detected, substitutionGroup structure is ~p.",[SGs]);
format_error({substitutionGroup_error,Head,SG}) ->
    io_lib:format("Schema: Either of substitutionGroup members ~p or ~p is not defined in the provided schema.",[Head,SG]);
format_error({cyclic_definition,CA}) ->
    io_lib:format("Schema: A forbidden circular definition was detected ~p.",[CA]);
format_error({type_of_element_not_derived,MemT,HeadT}) ->
    io_lib:format("Schema: Type in substitutionGroup members should be simpleType or complexType. In this case ~p and ~p were found.",[MemT, HeadT]);
format_error({derivation_blocked,BlockTag,Derivation}) ->
    io_lib:format("Derivation by ~p is blocked by the blocking tag ~p.",[Derivation,BlockTag]);
format_error({names_not_equal,QName1,QName2}) ->
    io_lib:format("The type ~p seems to be derived from another type than the base type ~p",[QName2,QName1]);
%% format_error({miss_match_base_types,QName1,QName2}) ->
%%     io_lib:format("Types and/or names of base type ~p and derived type ~p doesn't fit.",[QName1,QName2]);
format_error({illegal_content_in_extension,Ext}) ->
    io_lib:format("The extension content ~p didn't match the content model of the provided schema.",[Ext]);
format_error({SeqCho,expected,Other,found})
  when SeqCho == sequence;SeqCho == choice ->
    io_lib:format("Schema: The restriction content ~p didn't match the content model of the provided schema, ~p was expected.",[SeqCho,Other]);
format_error({does_not_support,F,in_restriction}) ->
    io_lib:format("Schema: The structure ~p is not supported in the implementation.",[F]);
format_error({illegal_content_simple_type,CM,TypeName}) ->
    io_lib:format("Schema: ~p content is not allowed in a simpleType, as in ~p.",[CM,TypeName]);
format_error({illegal_in_restriction_of_simpleType,X}) ->
    io_lib:format("Schema: The ~p content is illegal in a simpleType.",[X]);
format_error({element,Name,not_present_in_restriction}) ->
    io_lib:format("Schema: In a restriction all element names of the restriction must be one of the elements of the base type. ~p is not.",[Name]);
format_error({invalid_derivation,EA,BaseAtts}) ->
    io_lib:format("Schema: An anyAttribute ~p in a restricted derived type must be present among the base type attributes ~p.",[EA,BaseAtts]);
format_error({wildcard_namespace,NS,not_subset_of_base_namespace,BaseNS}) ->
    io_lib:format("Schema: See XML spec. section 3.10.6. This wildcard namespace ~p is not allowed by the base namespace restrictions ~p.",[NS,BaseNS]);
format_error({wildcard_namespace_union_not_expressible,NS1,NS2}) ->
    io_lib:format("Schema: See XML spec. section 3.10.6. The union of namespaces ~p and ~p is not expressible.",[NS1,NS2]);
format_error({wildcard_namespace_intersection_not_expressible,NS1,NS2}) ->
    io_lib:format("Schema: See XML spec. section 3.10.6. The intersection of namespaces ~p and ~p is not expressible.",[NS1,NS2]);
format_error({circular_reference_of_type,TName}) ->
    io_lib:format("Schema: An illicit circular reference involving simple/complex type ~p has been detected.",[TName]);
format_error({type_not_uniquely_defined_in_schema,Name}) ->
    io_lib:format("Schema: See XML spec. section 3.4.1. Type names whether simple or complex must be unique within the schema. ~p is not.",[Name]);
format_error({not_uniquely_defined_in_schema,Key}) ->
    io_lib:format("Schema: All schema objects of the same kind identified by name must be unique within the schema. ~p is not.",[Key]);
format_error({illegal_ID_value,ID}) ->
    io_lib:format("The ID value ~p is not allowed as an ID value.",[ID]);
format_error({incomplete_file,_FileName,_Other}) ->
    "Schema: The file containing a schema state must be produced by xmerl_xsd:state2file/[1,2].";
format_error({unexpected_content_in_any,A}) ->
    io_lib:format("Schema: The any type is considered to have no content besides annotation. ~p was found.",[A]);
format_error({erroneous_content_in_identity_constraint,IDC,Err}) ->
    io_lib:format("Schema: An ~p identity constraint must have one selector and one or more field in content. This case ~p",[IDC,Err]);
format_error({missing_xpath_attribute,IDCContent}) ->
    io_lib:format("Schema: A ~p in a identity constraint must have a xpath attribute.",[IDCContent]);
format_error({content_in_anyAttribute,Err}) ->
    io_lib:format("Schema: ~p is not allowed in anyAttribute. Content cannot be anything else than annotation.",[Err]);
format_error({content_in_simpleContent,Err}) ->
    io_lib:format("Schema: Content of simpleContent can only be an optional annotation and one of restriction or extension. In this case ~p.",[Err]);
format_error({complexContent_content_failure,Err}) ->
    io_lib:format("Schema: Besides an optional annotation complexContent should have one of restriction or extension. In this case ~p.",[Err]);
format_error({union_member_type_not_simpleType,IllegalType}) ->
    io_lib:format("Schema: ~p is not allowed in a union. Content must be any nymber of simpleType.",[IllegalType]);
format_error({missing_base_type,restriction,_Other}) ->
    "Schema: A restriction must have a base type, either assigned by the 'base' attribute or as a simpleType defined in content.";
format_error({content_failure_expected_restriction_or_extension,Kind,_}) ->
    io_lib:format("Schema: A ~p had no restriction or extension in content.",[Kind]);
format_error({content_failure_only_one_restriction_or_extension_allowed,Kind,_}) ->
    io_lib:format("Schema: A ~p can only have one of restriction or extension in content.",[Kind]);
format_error({mandatory_component_missing,S4SCMRest,Kind}) ->
    io_lib:format("Schema: After matching a ~p the schema should have had content ~p.",[Kind,S4SCMRest]);
format_error(Err) ->
    io_lib:format("~p~n",[Err]).

%% format_error(ErrMsg,E,SchemaE,Env) ->
%%     ?debug("format_error: ~p~n",[ErrMsg]),
%%     {ErrMsg,format_error2(E,SchemaE,Env)}.
%% format_error2(E,SchemaE,Env) ->
%%     {shema_el_pathname(SchemaE,Env),
%%      xml_el_pathname(E)}.

default_namespace_by_convention() ->
    [{xml,'http://www.w3.org/XML/1998/namespace'}].
