(*--------------------------------------------------------------------------*) (* Structure: Dtd *) (* *) (* Exceptions raised by functions in this structure: *) (* AttNot2Index : none *) (* Element2Index : none *) (* GenEnt2Index : none *) (* Id2Index : none *) (* Index2AttNot : NoSuchIndex *) (* Index2Element : NoSuchIndex *) (* Index2GenEnt : NoSuchIndex *) (* Index2Id : NoSuchIndex *) (* Index2ParEnt : NoSuchIndex *) (* ParEnt2Index : none *) (* entitiesWellformed : none *) (* getElement : NoSuchIndex *) (* getGenEnt : NoSuchIndex *) (* getId : NoSuchIndex *) (* getNotation : NoSuchIndex *) (* getParEnt : NoSuchIndex *) (* hasNotation : NoSuchIndex *) (* initDtdTables : none *) (* maxUsedElem : none *) (* maxUsedId : none *) (* printAttNotTable : none *) (* printIdTable : none *) (* printParEntTable : none *) (* printxElementTable : none *) (* printxGenEntTable : none *) (* setElement : NoSuchIndex *) (* setGenEnt : NoSuchIndex *) (* setId : NoSuchIndex *) (* setNotation : NoSuchIndex *) (* setParEnt : NoSuchIndex *) (*--------------------------------------------------------------------------*) signature Dtd = sig type Dtd val hasDtd : Dtd -> bool val hasExternal : Dtd -> bool val standsAlone : Dtd -> bool val setHasDtd : Dtd -> unit val setExternal : Dtd -> unit val setStandAlone : Dtd -> bool -> unit val entitiesWellformed : Dtd -> bool val validPredef : int -> UniChar.Vector val isRedefined : Dtd -> int -> bool val setRedefined : Dtd -> int -> unit val notRedefined : Dtd -> UniChar.Data list val AttNot2Index : Dtd -> UniChar.Data -> int val Element2Index : Dtd -> UniChar.Data -> int val Id2Index : Dtd -> UniChar.Data -> int val GenEnt2Index : Dtd -> UniChar.Data -> int val ParEnt2Index : Dtd -> UniChar.Data -> int val hasAttNot : Dtd -> UniChar.Data -> int option val hasElement : Dtd -> UniChar.Data -> int option val hasId : Dtd -> UniChar.Data -> int option val hasGenEnt : Dtd -> UniChar.Data -> int option val hasParEnt : Dtd -> UniChar.Data -> int option val Index2Element : Dtd -> int -> UniChar.Data val Index2Id : Dtd -> int -> UniChar.Data val Index2GenEnt : Dtd -> int -> UniChar.Data val Index2AttNot : Dtd -> int -> UniChar.Data val Index2ParEnt : Dtd -> int -> UniChar.Data val getId : Dtd -> int -> Base.IdInfo val getElement : Dtd -> int -> Base.ElemInfo val getGenEnt : Dtd -> int -> Base.GenEntInfo val getNotation : Dtd -> int -> Base.NotationInfo val getParEnt : Dtd -> int -> Base.ParEntInfo val hasNotation : Dtd -> int -> bool val setId : Dtd -> int * Base.IdInfo -> unit val setElement : Dtd -> int * Base.ElemInfo -> unit val setGenEnt : Dtd -> int * Base.GenEntInfo -> unit val setNotation : Dtd -> int * Base.ExternalId -> unit val setParEnt : Dtd -> int * Base.ParEntInfo -> unit val maxUsedId : Dtd -> int val maxUsedElem : Dtd -> int val maxUsedGen : Dtd -> int val initDtdTables : unit -> Dtd val printDtdTables : Dtd -> unit val printAttNotTable : Dtd -> unit val printIdTable : Dtd -> unit val printElementTable : Dtd -> unit val printGenEntTable : Dtd -> unit val printParEntTable : Dtd -> unit val defaultIdx : int val preserveIdx : int val xmlLangIdx : int val xmlSpaceIdx : int end structure Dtd : Dtd = struct open UtilInt Base UniChar DataDict DataSymTab val O_TS_ELEM = ref 6 (* Initial size of element table *) val O_TS_GEN_ENT = ref 6 (* Initial size of general entity table *) val O_TS_ID = ref 6 (* Initial size of id attribute table *) val O_TS_ATT_NOT = ref 6 (* Initial size of notation table *) val O_TS_PAR_ENT = ref 6 (* Initial size of parameter entity table *) (*--------------------------------------------------------------------*) (* this is how the predefined entities must be declared. *) (*--------------------------------------------------------------------*) val predefined = Vector.fromList (map (fn (x,y,z) => (String2Data x,String2Vector y,String2Vector z)) [("","",""), ("amp" ,"'&'","&"), ("lt" ,"'<'","<"), ("gt" ,"'>'",">"), ("apos","\"'\"" ,"'" ), ("quot","'\"'" ,"\"" )]) fun validPredef i = #3(Vector.sub(predefined,i)) (*--------------------------------------------------------------------*) (* this type holds all information relevent to the DTD. *) (*--------------------------------------------------------------------*) type Dtd = {hasDtdFlag : bool ref, standAloneFlag : bool ref, externalFlag : bool ref, elDict : ElemInfo DataDict.Dict, genDict : GenEntInfo DataDict.Dict, idDict : IdInfo DataDict.Dict, notDict : NotationInfo DataDict.Dict, parDict : ParEntInfo DataDict.Dict, preRedef : bool array } fun newDtd() = {hasDtdFlag = ref false, standAloneFlag = ref false, externalFlag = ref false, elDict = nullDict ("element",nullElemInfo), idDict = nullDict ("ID name",nullIdInfo), genDict = nullDict ("general entity",(GE_NULL,false)), notDict = nullDict ("attribute and notation",NONE:NotationInfo), parDict = nullDict ("parameter entity",(PE_NULL,false)), preRedef = Array.array(6,false) } : Dtd val default = String2Data "default" val preserve = String2Data "preserve" val xmlLang = String2Data "xml:lang" val xmlSpace = String2Data "xml:space" (*--------------------------------------------------------------------*) (* standalone status, existance of a DTD and of external declarations *) (* externalFlag is true if there is an external subset or a (not nece-*) (* ssarily external) parameter entity reference in the DTD. (cf. 4.1) *) (*--------------------------------------------------------------------*) fun standsAlone (dtd:Dtd) = !(#standAloneFlag dtd) fun hasExternal (dtd:Dtd) = !(#externalFlag dtd) fun hasDtd (dtd:Dtd) = !(#hasDtdFlag dtd) fun setHasDtd (dtd:Dtd) = #hasDtdFlag dtd := true fun setExternal (dtd:Dtd) = #externalFlag dtd := true fun setStandAlone (dtd:Dtd) x = #standAloneFlag dtd := x (*--------------------------------------------------------------------*) (* 4.1: *) (* Well-Formedness Constraint: Entity Declared *) (* In a document without any DTD, a document with only an internal *) (* DTD subset which contains no parameter entity references, or a *) (* document with "standalone='yes'", the Name given in the entity *) (* reference must match that in an entity declaration ... Note that *) (* if entities are declared in the external subset or in external *) (* parameter entities, a non-validating processor is not obligated *) (* to read and process their declarations; for such documents, the *) (* rule that an entity must be declared is a well-formedness *) (* constraint only if standalone='yes'. *) (* *) (* Thus a reference to an undeclared entity is a well-formedness *) (* error if either #hasDtdFlag or #externalFlag is false, or if *) (* #standaloneFlag is true *) (*--------------------------------------------------------------------*) (* bug fixed 080600: changed !hasDtdFlag to not(!hasDtdFlag) *) (*--------------------------------------------------------------------*) fun entitiesWellformed ({hasDtdFlag,standAloneFlag,externalFlag,...}:Dtd) = not (!hasDtdFlag andalso !externalFlag) orelse !standAloneFlag fun initStandalone ({hasDtdFlag,standAloneFlag,externalFlag,...}:Dtd) = (hasDtdFlag := false; standAloneFlag := false; externalFlag := false) (*--------------------------------------------------------------------*) (* this array tells whether the predefined entities (index 1-5) have *) (* been declared in the dtd. *) (*--------------------------------------------------------------------*) fun isRedefined (dtd:Dtd) i = Array.sub(#preRedef dtd,i) fun setRedefined (dtd:Dtd) i = Array.update(#preRedef dtd,i,true) fun notRedefined dtd = List.mapPartial (fn i => if isRedefined dtd i then NONE else SOME(#1(Vector.sub(predefined,i)))) [1,2,3,4,5] fun AttNot2Index (dtd:Dtd) name = getIndex(#notDict dtd,name) fun Element2Index (dtd:Dtd) name = getIndex(#elDict dtd,name) fun GenEnt2Index (dtd:Dtd) name = getIndex(#genDict dtd,name) fun Id2Index (dtd:Dtd) name = getIndex(#idDict dtd,name) fun ParEnt2Index (dtd:Dtd) name = getIndex(#parDict dtd,name) fun hasAttNot (dtd:Dtd) name = hasIndex(#notDict dtd,name) fun hasElement (dtd:Dtd) name = hasIndex(#elDict dtd,name) fun hasId (dtd:Dtd) name = hasIndex(#idDict dtd,name) fun hasGenEnt (dtd:Dtd) name = hasIndex(#genDict dtd,name) fun hasParEnt (dtd:Dtd) name = hasIndex(#parDict dtd,name) fun Index2AttNot (dtd:Dtd) idx = getKey(#notDict dtd,idx) fun Index2Element (dtd:Dtd) idx = getKey(#elDict dtd,idx) fun Index2GenEnt (dtd:Dtd) idx = getKey(#genDict dtd,idx) fun Index2Id (dtd:Dtd) idx = getKey(#idDict dtd,idx) fun Index2ParEnt (dtd:Dtd) idx = getKey(#parDict dtd,idx) fun getElement (dtd:Dtd) idx = getByIndex(#elDict dtd,idx) fun getGenEnt (dtd:Dtd) idx = getByIndex(#genDict dtd,idx) fun getId (dtd:Dtd) idx = getByIndex(#idDict dtd,idx) fun getNotation (dtd:Dtd) idx = getByIndex(#notDict dtd,idx) fun getParEnt (dtd:Dtd) idx = getByIndex(#parDict dtd,idx) fun hasNotation (dtd:Dtd) idx = isSome(getByIndex(#notDict dtd,idx)) fun setElement (dtd:Dtd) (idx,el) = setByIndex(#elDict dtd,idx,el) fun setGenEnt (dtd:Dtd) (idx,ge) = setByIndex(#genDict dtd,idx,ge) fun setId (dtd:Dtd) (idx,a) = setByIndex(#idDict dtd,idx,a) fun setNotation (dtd:Dtd) (idx,nt) = setByIndex(#notDict dtd,idx,SOME nt) fun setParEnt (dtd:Dtd) (idx,pe) = setByIndex(#parDict dtd,idx,pe) fun maxUsedElem (dtd:Dtd) = usedIndices(#elDict dtd)-1 fun maxUsedGen (dtd:Dtd) = usedIndices(#genDict dtd)-1 fun maxUsedId (dtd:Dtd) = usedIndices(#idDict dtd)-1 (*--------------------------------------------------------------------*) (* initialize the attribute tables. Make sure that indices 0...3 are *) (* assigned to "default", "preserve", "xml:lang" and "xml:space". *) (*--------------------------------------------------------------------*) fun initAttNotTable (dtd as {idDict,notDict,...}:Dtd) = let val _ = clearDict(notDict,SOME(!O_TS_ATT_NOT)) val _ = clearDict(idDict,SOME(!O_TS_ID)) val _ = AttNot2Index dtd default val _ = AttNot2Index dtd preserve val _ = AttNot2Index dtd xmlLang val _ = AttNot2Index dtd xmlSpace in () end fun initElementTable (dtd:Dtd) = clearDict(#elDict dtd,SOME(!O_TS_ELEM)) (*--------------------------------------------------------------------*) (* reserve 0 for gen entity -, i.e., the document entity. *) (* reserve 1 for gen entity amp, i.e., "&#38;" *) (* reserve 2 for gen entity lt, i.e., "&#60;" *) (* reserve 3 for gen entity gt, i.e., ">" *) (* reserve 4 for gen entity apos, i.e., "'" *) (* reserve 5 for gen entity quot, i.e., """ *) (* reserve 0 for par entity -, i.e., the external dtd subset. *) (* *) (* Cf. 4.1: *) (* *) (* ... except that well-formed documents need not declare any of *) (* the following entities: amp, lt, gt, apos, quot. *) (* *) (* and 4.6: *) (* *) (* *) (* *) (* *) (* *) (* *) (*--------------------------------------------------------------------*) fun initEntityTables (dtd as {genDict,parDict,preRedef,...}:Dtd) = let val _ = clearDict(genDict,SOME(!O_TS_GEN_ENT)) val _ = clearDict(parDict,SOME(!O_TS_PAR_ENT)) val _ = map (fn i => Array.update(preRedef,i,false)) [1,2,3,4,5] val _ = GenEnt2Index dtd [0wx2D] (* "-" *) val _ = ParEnt2Index dtd [0wx2D] (* "-" *) val _ = VectorSlice.appi (fn (_,(name,lit,cs)) => (setGenEnt dtd (GenEnt2Index dtd name,(GE_INTERN(lit,cs),false)))) (VectorSlice.slice (predefined,1,NONE)) in () end fun initDtdTables() = let val dtd = newDtd() val _ = initAttNotTable dtd val _ = initElementTable dtd val _ = initEntityTables dtd val _ = initStandalone dtd in dtd end local val dtd = initDtdTables() in val defaultIdx = AttNot2Index dtd default val preserveIdx = AttNot2Index dtd preserve val xmlLangIdx = AttNot2Index dtd xmlLang val xmlSpaceIdx = AttNot2Index dtd xmlSpace end fun printAttNotTable (dtd:Dtd) = printDict NotationInfo2String (#notDict dtd) fun printElementTable dtd = printDict (ElemInfo2xString (UniChar.Data2String o (Index2AttNot dtd), UniChar.Data2String o (Index2Element dtd), UniChar.Data2String o (Index2GenEnt dtd), UniChar.Data2String o (Index2Id dtd), UniChar.Data2String o (Index2AttNot dtd))) (#elDict dtd) fun printGenEntTable dtd = printDict (fn (ent,ext) => GenEntity2xString (Data2String o (Index2AttNot dtd)) ent ^(if ext then "[external]" else "")) (#genDict dtd) fun printIdTable (dtd:Dtd) = printDict (IdInfo2String) (#idDict dtd) fun printParEntTable (dtd:Dtd) = printDict (fn (ent,ext) => ParEntity2String ent ^(if ext then "[external]" else "")) (#parDict dtd) fun printDtdTables dtd = (printAttNotTable dtd; printElementTable dtd; printGenEntTable dtd; printIdTable dtd; printParEntTable dtd) end