integrated last patches from Jürgen
git-svn-id: https://projects.brucker.ch/su4sml/svn/infsec-import/trunk/src/su4sml@2944 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
parent
c07c040925
commit
3857c3c1ff
|
|
@ -82,6 +82,7 @@ datatype Classifier =
|
|||
|
||||
val OclAnyC : Classifier
|
||||
|
||||
val normalize : Classifier -> Classifier
|
||||
|
||||
val name_of : Classifier -> ocl_type.Path
|
||||
val package_of : Classifier -> ocl_type.Path
|
||||
|
|
|
|||
|
|
@ -29,14 +29,12 @@ type operation = { name : string,
|
|||
postcondition : (string option * ocl_term.OclTerm) list,
|
||||
arguments : (string * ocl_type.OclType) list,
|
||||
result : ocl_type.OclType,
|
||||
isQuery : bool
|
||||
}
|
||||
isQuery : bool }
|
||||
|
||||
type associationend = {name : string,
|
||||
aend_type: ocl_type.OclType,
|
||||
multiplicity: (int*int) list,
|
||||
ordered: bool
|
||||
}
|
||||
ordered: bool }
|
||||
|
||||
datatype Classifier =
|
||||
Class of
|
||||
|
|
@ -79,14 +77,101 @@ datatype Classifier =
|
|||
thyname : string option
|
||||
}
|
||||
|
||||
(* convert an association end into the corresponding collection type *)
|
||||
fun assoc_to_attr_type {name,aend_type,multiplicity,ordered} =
|
||||
if ordered then ocl_type.Sequence aend_type (* OrderedSet? *)
|
||||
else ocl_type.Set aend_type
|
||||
|
||||
(* convert an association end into an attribute of the *)
|
||||
(* corresponding collection type *)
|
||||
fun assoc_to_attr (assoc:associationend) = (#name assoc,assoc_to_attr_type assoc)
|
||||
|
||||
(* convert a multiplicity range into an invariant of the form *)
|
||||
(* size > lowerBound and size < upperBound ) *)
|
||||
fun range_to_inv cls_name aend (a,b) =
|
||||
let val cls = ocl_type.Classifier cls_name
|
||||
val attr_type = assoc_to_attr_type aend
|
||||
val attr_name = cls_name@[#name aend]
|
||||
val literal_a = ocl_term.Literal (Int.toString a, ocl_type.Integer)
|
||||
val literal_b = ocl_term.Literal (Int.toString b, ocl_type.Integer)
|
||||
val self = ocl_term.Variable ("self",cls)
|
||||
val attribute = ocl_term.AttributeCall (self,cls,attr_name,attr_type)
|
||||
val attribute_size =
|
||||
ocl_term.OperationCall (attribute,attr_type,
|
||||
["oclLib","Collection","size"],[],
|
||||
ocl_type.Integer)
|
||||
val lower_bound =
|
||||
ocl_term.OperationCall (attribute_size,ocl_type.Integer,
|
||||
["oclLib","Real",">="],
|
||||
[(literal_a,ocl_type.Integer)],ocl_type.Boolean)
|
||||
val upper_bound =
|
||||
ocl_term.OperationCall (attribute_size,ocl_type.Integer,
|
||||
["oclLib","Real","<="],
|
||||
[(literal_b,ocl_type.Integer)],ocl_type.Boolean)
|
||||
val equal =
|
||||
ocl_term.OperationCall (attribute_size,ocl_type.Integer,
|
||||
["oclLib","OclAny","="],
|
||||
[(literal_a,ocl_type.Integer)],ocl_type.Boolean)
|
||||
in
|
||||
if a = b then equal
|
||||
else if b = ~1 then lower_bound
|
||||
else ocl_term.OperationCall (lower_bound,ocl_type.Boolean,
|
||||
["oclLib","Boolean","and"],
|
||||
[(upper_bound,ocl_type.Boolean)],
|
||||
ocl_type.Boolean)
|
||||
end
|
||||
|
||||
(* calculate the invariants of an association end: *)
|
||||
(* 1. multiplicity constraints *)
|
||||
(* 2. consistency constraints between opposing association ends *)
|
||||
(* i.e., A.b.a->includes(A) *)
|
||||
(* FIXME: 2. is not implemented yet... *)
|
||||
fun assoc_to_inv cls_name (aend:associationend) =
|
||||
let val inv_name = "multiplicity constraint for association end: "^(#name aend)
|
||||
val range_constraints = map (range_to_inv cls_name aend)
|
||||
(#multiplicity aend)
|
||||
fun ocl_or (x,y) =
|
||||
ocl_term.OperationCall (x,ocl_type.Boolean,
|
||||
["oclLib","Boolean","or"],
|
||||
[(y,ocl_type.Boolean)],ocl_type.Boolean)
|
||||
in if range_constraints = []
|
||||
then (SOME inv_name, ocl_term.Literal ("true",ocl_type.Boolean))
|
||||
else (SOME inv_name, foldr1 ocl_or range_constraints)
|
||||
end
|
||||
|
||||
(* convert association ends into attributes + invariants *)
|
||||
fun normalize (Class {name,parent,attributes,operations,associationends,invariant,
|
||||
stereotypes,interfaces,thyname}) =
|
||||
Class {name = name,
|
||||
parent = parent,
|
||||
attributes = (append (map assoc_to_attr associationends)
|
||||
attributes),
|
||||
operations = operations,
|
||||
associationends = nil,
|
||||
invariant = append (map (assoc_to_inv name) associationends)
|
||||
invariant,
|
||||
stereotypes = stereotypes,
|
||||
interfaces = interfaces,
|
||||
thyname = thyname }
|
||||
| normalize (Primitive p) =
|
||||
(* Primitive's do not have attributes, so we have to convert *)
|
||||
(* them into Classes... *)
|
||||
if (#associationends p) = []
|
||||
then Primitive p
|
||||
else normalize (Class {name = #name p, parent = #parent p, attributes=[],
|
||||
operations = #operations p, invariant = #invariant p,
|
||||
associationends = #associationends p,
|
||||
stereotypes = #stereotypes p,
|
||||
interfaces = #interfaces p,
|
||||
thyname = #thyname p})
|
||||
| normalize c = c
|
||||
|
||||
val OclAnyC = Class{name=["OclAny"],parent=NONE,attributes=[],
|
||||
operations=[], interfaces=[],
|
||||
invariant=[],stereotypes=[], associationends=[],
|
||||
thyname=NONE}
|
||||
|
||||
|
||||
|
||||
fun string_of_path (path:ocl_type.Path) = case path of
|
||||
[] => ""
|
||||
| p => foldr1 (fn (a,b) => a^"."^b) p
|
||||
|
|
|
|||
|
|
@ -453,18 +453,19 @@ fun tree2package tree =
|
|||
let val trees = skipOver "UML:Namespace.ownedElement"
|
||||
((hd o XmlTreeData.getTrees) tree)
|
||||
val atts = XmlTreeData.getAtts tree in
|
||||
XMI_UML.UMLPackage { xmiid = getXmiId atts,
|
||||
name = getName atts,
|
||||
visibility = getVisibility atts,
|
||||
ownedPackages = (map tree2package
|
||||
(filterPackages trees)),
|
||||
ownedClassifiers = (map tree2classifier
|
||||
(filterClassifiers trees)),
|
||||
ownedAssociations = getAssociations trees,
|
||||
ownedGeneralizations = (map tree2generalization
|
||||
(filterByName "UML:Generalization"
|
||||
trees)),
|
||||
ownedConstraints = map tree2constraint (filterConstraints trees) }
|
||||
XMI_UML.UMLPackage { xmiid = getXmiId atts,
|
||||
name = getName atts,
|
||||
visibility = getVisibility atts,
|
||||
packages = (map tree2package
|
||||
(filterPackages trees)),
|
||||
classifiers = (map tree2classifier
|
||||
(filterClassifiers trees)),
|
||||
associations = getAssociations trees,
|
||||
generalizations = (map tree2generalization
|
||||
(filterByName "UML:Generalization"
|
||||
trees)),
|
||||
constraints = map tree2constraint
|
||||
(filterConstraints trees) }
|
||||
end
|
||||
else raise IllFormed "tree2package"
|
||||
|
||||
|
|
|
|||
178
src/xmi2mdr.sml
178
src/xmi2mdr.sml
|
|
@ -27,10 +27,10 @@
|
|||
structure Xmi2Mdr =
|
||||
struct
|
||||
exception IllFormed
|
||||
open ocl_type;
|
||||
|
||||
datatype HashTableEntry = Package of ocl_type.Path
|
||||
| Type of (ocl_type.OclType * (mdr_core.associationend list)) (* maps xmi.idref to OclType and list of association ends *)
|
||||
| Type of (ocl_type.OclType *
|
||||
(XMI_UML.UMLAssociationEnd list))
|
||||
| Generalization of (string * string)
|
||||
| Constraint of XMI_OCL.OCLConstraint
|
||||
| Stereotype of string
|
||||
|
|
@ -59,11 +59,15 @@ fun find_operation t xmiid =
|
|||
of Operation x => x)
|
||||
handle Option => error ("expected Operation "^xmiid^" in table")
|
||||
|
||||
fun find_type t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of Type x => x)
|
||||
handle Option => error ("expected Type "^xmiid^" in table (find_type)")
|
||||
|
||||
fun find_aends t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of (Type (c,xs)) => xs)
|
||||
handle Option => error ("expected Type "^xmiid^" in table (aends)")
|
||||
|
||||
handle Option => error ("expected Type "^xmiid^" in table (find_aends)")
|
||||
|
||||
fun find_variable_dec t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
|
|
@ -119,9 +123,8 @@ fun find_classifier_type t xmiid
|
|||
| ocl_type.Set (ocl_type.Classifier [x]) => ocl_type.Set (find_classifier_type t x)
|
||||
| ocl_type.Bag (ocl_type.Classifier [x]) => ocl_type.Bag (find_classifier_type t x)
|
||||
| ocl_type.OrderedSet (ocl_type.Classifier [x]) => ocl_type.OrderedSet (find_classifier_type t x)
|
||||
(* | ocl_type.Collection (ocl_type.Classifier [x]) => ocl_type.Collection (find_classifier_type t x) *)
|
||||
end
|
||||
handle Option => error ("expected Classifier "^xmiid^" in table")
|
||||
handle Option => error ("expected Classifier "^xmiid^" in table")
|
||||
|
||||
|
||||
fun insert_constraint table (c:XMI_OCL.OCLConstraint) =
|
||||
|
|
@ -165,7 +168,9 @@ fun insert_classifier table package_prefix class =
|
|||
else if String.isPrefix "OrderedSet(" name then ocl_type.OrderedSet (ocl_type.Classifier [XMI_UML.classifier_elementtype_of class])
|
||||
else error ("didn't recognize ocltype "^name)
|
||||
else ocl_type.Classifier path
|
||||
val aends = nil (* aends = find_aends table id*)
|
||||
(* This function is called before the associations are handled, *)
|
||||
(* so we do not have to take care of them now... *)
|
||||
val aends = nil
|
||||
in
|
||||
HashTable.insert table (id,Type (ocltype,aends));
|
||||
case class
|
||||
|
|
@ -182,20 +187,6 @@ fun insert_classifier table package_prefix class =
|
|||
| _ => ()
|
||||
end
|
||||
|
||||
fun insert_package table package_prefix (XMI_UML.UMLPackage{xmiid,name,
|
||||
ownedClassifiers,
|
||||
ownedPackages,
|
||||
ownedGeneralizations,
|
||||
ownedConstraints,...}) =
|
||||
let val id = xmiid
|
||||
val full_name = package_prefix @ [name]
|
||||
in
|
||||
map (insert_generalization table ) ownedGeneralizations;
|
||||
map (insert_constraint table) ownedConstraints;
|
||||
map (insert_classifier table full_name) ownedClassifiers;
|
||||
map (insert_package table full_name) ownedPackages;
|
||||
HashTable.insert table (id,Package full_name)
|
||||
end
|
||||
|
||||
fun transform_expression t (XMI_OCL.LiteralExp {symbol,expression_type}) =
|
||||
ocl_term.Literal (symbol,find_classifier_type t expression_type)
|
||||
|
|
@ -257,6 +248,14 @@ fun transform_operation t {xmiid,name,isQuery,parameter,visibility,
|
|||
fun transform_attribute t ({xmiid,name,type_id,changeability,visibility}) =
|
||||
(name,find_classifier_type t type_id)
|
||||
|
||||
fun transform_aend t ({xmiid,name,ordering,multiplicity,participant_id,
|
||||
isNavigable,aggregation,changeability,visibility})
|
||||
= {name = name,
|
||||
aend_type = find_classifier_type t participant_id,
|
||||
multiplicity = multiplicity,
|
||||
ordered = if ordering = XMI_UML.Ordered then true else false }
|
||||
|
||||
|
||||
|
||||
fun transform_classifier t (XMI_UML.Class {xmiid,name,isActive,visibility,isLeaf,
|
||||
generalizations,attributes,operations,
|
||||
|
|
@ -271,9 +270,10 @@ fun transform_classifier t (XMI_UML.Class {xmiid,name,isActive,visibility,isLeaf
|
|||
| xs => SOME (path_of_classifier (hd xs)),
|
||||
attributes = map (transform_attribute t) attributes,
|
||||
operations = map (transform_operation t) operations,
|
||||
invariant = map ((transform_constraint t) o
|
||||
(find_constraint t)) invariant,
|
||||
associationends = nil, (* FIX *)
|
||||
invariant = map ((transform_constraint t) o
|
||||
(find_constraint t)) invariant,
|
||||
associationends = map (transform_aend t)
|
||||
(find_aends t xmiid),
|
||||
stereotypes = nil, (* FIX *)
|
||||
interfaces = nil, (* FIX *)
|
||||
thyname = NONE}
|
||||
|
|
@ -283,7 +283,8 @@ fun transform_classifier t (XMI_UML.Class {xmiid,name,isActive,visibility,isLeaf
|
|||
mdr_core.Primitive {name = case find_classifier_type t xmiid of ocl_type.Classifier x => x,
|
||||
parent = NONE, (* FIX *)
|
||||
operations = map (transform_operation t) operations,
|
||||
associationends = nil, (* FIX *)
|
||||
associationends = map (transform_aend t)
|
||||
(find_aends t xmiid),
|
||||
invariant = map ((transform_constraint t) o
|
||||
(find_constraint t)) invariant,
|
||||
stereotypes = nil, (*FIX *)
|
||||
|
|
@ -303,71 +304,96 @@ fun transform_classifier t (XMI_UML.Class {xmiid,name,isActive,visibility,isLeaf
|
|||
| transform_classifier t (_) = error "Not supported Classifier type found."
|
||||
|
||||
|
||||
fun transform_package t (XMI_UML.UMLPackage {xmiid,name,ownedPackages,
|
||||
ownedClassifiers,
|
||||
ownedAssociations,
|
||||
ownedGeneralizations,
|
||||
ownedConstraints,visibility}) =
|
||||
append (map (transform_classifier t) ownedClassifiers)
|
||||
(List.concat (map (transform_package t) ownedPackages))
|
||||
|
||||
|
||||
(* splits an association into a list of two (or more) association ends, *)
|
||||
(* together with the xmi.id of the "opposite" class" *)
|
||||
fun split_assoc (assoc:XMI_UML.UMLAssociation) =
|
||||
let val aends = #connection assoc
|
||||
fun attach_opposite ae aends = map (fn (x:XMI_UML.UMLAssociationEnd) => (#participant_id x, ae))
|
||||
(List.filter (fn x => x <> ae) aends)
|
||||
(* recursively transform all classes in the package *)
|
||||
fun transform_package t (XMI_UML.UMLPackage p) =
|
||||
let (* we do not transform the ocl library *)
|
||||
val filteredPackages =
|
||||
filter (fn (XMI_UML.UMLPackage x) =>
|
||||
((#name x <> "oclLib") andalso (#name x <> "UML_OCL")))
|
||||
(#packages p)
|
||||
in
|
||||
List.concat (map (fn x => attach_opposite x aends) aends)
|
||||
(map (transform_classifier t) (#classifiers p))@
|
||||
(List.concat (map (transform_package t) filteredPackages))
|
||||
end
|
||||
|
||||
fun transform_aend t (id, {xmiid,name,ordering,multiplicity,participant_id,
|
||||
isNavigable,aggregation,changeability,visibility})
|
||||
= (id,{name=name,
|
||||
aend_type=ocl_type.OclAny (* FIX *),
|
||||
multiplicity = multiplicity,
|
||||
ordered = if ordering = XMI_UML.Ordered then true else false })
|
||||
|
||||
|
||||
(* recursively collects all associations in the given list of packages *)
|
||||
fun collect_associations xs [] = xs
|
||||
| collect_associations xs
|
||||
((XMI_UML.UMLPackage {ownedPackages,ownedAssociations,...})::ps) =
|
||||
collect_associations (append xs ownedAssociations) (append ownedPackages ps)
|
||||
|
||||
fun transform_toplevel t (XMI_UML.UMLPackage {xmiid,name,ownedPackages,
|
||||
ownedClassifiers,
|
||||
ownedAssociations,
|
||||
ownedGeneralizations,
|
||||
ownedConstraints,visibility}) =
|
||||
let val filteredPackages =
|
||||
filter (fn (XMI_UML.UMLPackage x) => ((#name x <> "oclLib")
|
||||
andalso (#name x <> "UML_OCL")))
|
||||
ownedPackages (* throw away oclLib *)
|
||||
(* val assocs = collect_associations ownedAssociations filteredPackages
|
||||
val aends = List.concat (map split_assoc assocs)
|
||||
val mdr_aends = map (transform_aend t) aends*)
|
||||
val _ = map (insert_package t nil) ownedPackages
|
||||
val _ = map (insert_classifier t nil) ownedClassifiers
|
||||
val cls_in_this_package = map (transform_classifier t)
|
||||
ownedClassifiers
|
||||
val cls_in_contained_packages =
|
||||
List.concat (map (transform_package t) filteredPackages)
|
||||
(* recursively insert mapping of xmi.id's to model elements into Hashtable *)
|
||||
fun insert_package table package_prefix (XMI_UML.UMLPackage p) =
|
||||
let val full_name = package_prefix @ [#name p]
|
||||
in
|
||||
cls_in_this_package@cls_in_contained_packages
|
||||
map (insert_generalization table) (#generalizations p);
|
||||
map (insert_constraint table) (#constraints p);
|
||||
map (insert_classifier table full_name) (#classifiers p);
|
||||
map (insert_package table full_name) (#packages p);
|
||||
HashTable.insert table (#xmiid p,Package full_name)
|
||||
end
|
||||
|
||||
(* We do not want the name of the model to be part of the package hierarchy, *)
|
||||
(* therefore we handle the top-level model seperately *)
|
||||
fun insert_model table (XMI_UML.UMLPackage p) =
|
||||
let val full_name = nil
|
||||
in
|
||||
map (insert_generalization table) (#generalizations p);
|
||||
map (insert_constraint table) (#constraints p);
|
||||
map (insert_classifier table full_name) (#classifiers p);
|
||||
map (insert_package table full_name) (#packages p);
|
||||
HashTable.insert table (#xmiid p,Package full_name)
|
||||
end
|
||||
|
||||
|
||||
(* split an association into association ends, and put the association ends *)
|
||||
(* ends into the xmi.id table under the corresponding (i.e., opposite) *)
|
||||
(* classifier. *)
|
||||
(* 1. split the association into a list of two (or more) association ends *)
|
||||
(* 2. pair each association end with the participant_id's of all other *)
|
||||
(* association ends: when a class is a participant in an association, *)
|
||||
(* this association end is a feature of all _other_ participants in the *)
|
||||
(* association *)
|
||||
(* 3. insert the mapping xmi.id to association end into the hashtable *)
|
||||
fun transform_assocation t (assoc:XMI_UML.UMLAssociation) =
|
||||
let val aends = #connection assoc
|
||||
fun all_others x xs = List.filter (fn y => y <> x) xs
|
||||
fun pair_with ae aes =
|
||||
map (fn (x:XMI_UML.UMLAssociationEnd) => (#participant_id x, ae)) aes
|
||||
val mappings = List.concat (map (fn x => pair_with x (all_others x aends)) aends)
|
||||
fun add_aend_to_type (id,ae) =
|
||||
HashTable.insert t (id,Type (find_classifier_type t id,
|
||||
ae::(find_aends t id)))
|
||||
in
|
||||
List.app add_aend_to_type mappings
|
||||
end
|
||||
|
||||
|
||||
(* recursively transforms all associations in the package p, *)
|
||||
fun transform_associations t (XMI_UML.UMLPackage p) =
|
||||
(map (transform_associations t) (#packages p);
|
||||
List.app (transform_assocation t) (#associations p))
|
||||
|
||||
(* transform a UML model into a list of mdr_core classes *)
|
||||
(* 1. traverse package hierarchy and put xmi.id of all interesting *)
|
||||
(* model elements into the hashtable *)
|
||||
(* 2. traverse again to find all associations, transform them into *)
|
||||
(* association ends and map the correct classes to them *)
|
||||
(* (We have to handle associations seperately because there is *)
|
||||
(* no direct link from classes to their association ends in *)
|
||||
(* the xmi file) *)
|
||||
(* 3. traverse again, transforming all remaining model elements, *)
|
||||
(* i.e., classes with their operations, attributes, *)
|
||||
(* constraints, etc *)
|
||||
fun transformXMI ({classifiers,constraints,packages,
|
||||
stereotypes,variable_declarations}) =
|
||||
let val (xmiid_table: (string,HashTableEntry) HashTable.hash_table) =
|
||||
HashTable.mkTable (HashString.hashString, (op =)) (101, IllFormed)
|
||||
(* for some reasons, there are model elements outside of the top-level *)
|
||||
(* model the xmi-file. So we have to handle them here seperately: *)
|
||||
val _ = map (insert_classifier xmiid_table nil) classifiers
|
||||
val _ = map (insert_constraint xmiid_table) constraints
|
||||
val _ = map (insert_stereotype xmiid_table) stereotypes
|
||||
val _ = map (insert_variable_dec xmiid_table) variable_declarations
|
||||
(* "hd packages" is supposed to be the first model in the xmi-file *)
|
||||
val model = hd packages
|
||||
in
|
||||
transform_toplevel xmiid_table (hd packages)
|
||||
insert_model xmiid_table model; (* fill xmi.id table *)
|
||||
transform_associations xmiid_table model; (* handle associations *)
|
||||
map mdr_core.normalize (transform_package xmiid_table model) (* transform classes *)
|
||||
end
|
||||
end
|
||||
|
||||
|
|
|
|||
|
|
@ -469,13 +469,14 @@ type UMLStereotype = {xmiid: string, name: string}
|
|||
datatype UMLPackage = UMLPackage of { xmiid: string,
|
||||
name: string,
|
||||
visibility: VisibilityKind,
|
||||
ownedPackages: UMLPackage list,
|
||||
ownedClassifiers: UMLClassifier list,
|
||||
ownedAssociations: UMLAssociation list,
|
||||
ownedGeneralizations: UMLGeneralization list,
|
||||
ownedConstraints: OCLConstraint list }
|
||||
packages: UMLPackage list,
|
||||
classifiers: UMLClassifier list,
|
||||
associations: UMLAssociation list,
|
||||
generalizations: UMLGeneralization list,
|
||||
constraints: OCLConstraint list }
|
||||
|
||||
|
||||
(* There may be (are) model elements outside of the UML model *)
|
||||
type XmiContent = {classifiers: UMLClassifier list,
|
||||
constraints: OCLConstraint list,
|
||||
packages: UMLPackage list,
|
||||
|
|
|
|||
|
|
@ -104,7 +104,8 @@ structure Parser = Parse (structure Dtd = Dtd
|
|||
structure Resolve = ResolveNull)
|
||||
|
||||
fun parseXmlTree filename =
|
||||
let val dtd = Dtd.initDtdTables()
|
||||
let val _ = OS.FileSys.fileSize filename (* dummy check to see if the file exists...*)
|
||||
val dtd = Dtd.initDtdTables()
|
||||
(* how to do the following in a clean/portable way? *)
|
||||
val _ = Parser.parseDocument
|
||||
(SOME (Uri.String2Uri ("file:"^(su4sml_home())^"/dummy.xmi")))
|
||||
|
|
@ -115,3 +116,41 @@ fun parseXmlTree filename =
|
|||
end
|
||||
|
||||
end
|
||||
|
||||
|
||||
structure WriteXmlTree =
|
||||
struct
|
||||
open XmlTreeData
|
||||
|
||||
fun writeAttribute stream (name,value) =
|
||||
TextIO.output (stream, " "^name^"=\""^value^"\"")
|
||||
|
||||
fun writeEndTag stream name = TextIO.output (stream,"</"^name^">\n")
|
||||
|
||||
fun writeStartTag stream tree =
|
||||
(TextIO.output (stream,"<"^(getElem tree));
|
||||
map (writeAttribute stream) (getAtts tree);
|
||||
TextIO.output (stream,">\n"))
|
||||
|
||||
fun writeIndent stream 0 = ()
|
||||
| writeIndent stream n = (TextIO.output (stream, " "); writeIndent stream (n-1))
|
||||
|
||||
|
||||
fun writeXmlTree' indent stream tree =
|
||||
let val elemName = getElem tree
|
||||
in
|
||||
writeIndent stream indent;
|
||||
writeStartTag stream tree;
|
||||
map (writeXmlTree' (indent+1) stream) (getTrees tree);
|
||||
writeIndent stream indent;
|
||||
writeEndTag stream elemName
|
||||
end
|
||||
|
||||
fun writeXmlTree filename tree =
|
||||
let val stream = TextIO.openOut filename
|
||||
in
|
||||
writeXmlTree' 0 stream tree;
|
||||
TextIO.closeOut stream
|
||||
end
|
||||
|
||||
end
|
||||
|
|
|
|||
Loading…
Reference in New Issue