376 lines
17 KiB
Forth
376 lines
17 KiB
Forth
namespace AstAccess
|
||
|
||
open System.Xml
|
||
open System.Linq
|
||
|
||
module AstImport =
|
||
/// 带有地址的对象
|
||
type AstObject() =
|
||
class
|
||
member this.address() = string(this.GetHashCode ())
|
||
|
||
abstract member members:unit -> AstObject list
|
||
default this.members(): AstObject list = []
|
||
end
|
||
|
||
/// 父子节点map转换
|
||
let rec branch_map_conv (pnode: AstObject, childs: AstObject list) =
|
||
match childs with
|
||
| [] -> []
|
||
| _ ->
|
||
let head = childs.Head
|
||
(head.address(), (head, pnode))::branch_map_conv(pnode, childs.Tail)@branch_map_conv(head, head.members())
|
||
|
||
/// 节点深度计算
|
||
let rec depth_seek(branchs: (string*(AstObject*AstObject))list, node: AstObject): int =
|
||
let prev_nodes = branchs |> List.filter(fun (key, _) -> key.Equals(node.address()))
|
||
match prev_nodes.Length with
|
||
| 0 -> 0
|
||
| _ ->
|
||
let (_, (_, parent_node)) = prev_nodes.Head
|
||
depth_seek(branchs, parent_node) + 1
|
||
|
||
/// TextWord
|
||
type TextItem(bind: XmlElement) =
|
||
class
|
||
inherit AstObject()
|
||
member this.content():string =
|
||
bind.GetAttribute "text"
|
||
|
||
member this.row():int =
|
||
let tokens_node = bind.ChildNodes.Cast<XmlNode>().Where(
|
||
fun node -> node.Name.Equals "tokens").ElementAt(0)
|
||
let token_bind = tokens_node.ChildNodes.Cast<XmlElement>().ElementAt(0)
|
||
int(token_bind.GetAttribute "row")
|
||
|
||
static member GenerateText(text_opt: XmlNode): Option<TextItem> =
|
||
match text_opt with
|
||
| :? XmlElement as obj_t when obj_t.Name.Equals "text-section" ->
|
||
Some(TextItem(obj_t))
|
||
| _ -> None
|
||
end
|
||
|
||
/// 引用节点
|
||
type PointRef(bind: XmlElement, texts: TextItem list) =
|
||
class
|
||
inherit AstObject()
|
||
new(bind: XmlElement) = PointRef(bind, [])
|
||
|
||
member this.pointRef() =
|
||
bind.GetAttribute "point"
|
||
member this.sliceRef() =
|
||
bind.GetAttribute "slice"
|
||
member this.storyRef() =
|
||
bind.GetAttribute "story"
|
||
member this.appendChild(objs: TextItem list) =
|
||
PointRef(bind, texts@objs)
|
||
member this.children() =
|
||
texts
|
||
|
||
override this.members(): AstObject list =
|
||
texts |> List.map (fun it->it :> AstObject)
|
||
|
||
static member GenerateFromChildSibling(child: XmlNode): TextItem list =
|
||
match child with
|
||
| null -> []
|
||
| _ ->
|
||
match TextItem.GenerateText(child) with
|
||
| Some text -> text::PointRef.GenerateFromChildSibling(child.NextSibling)
|
||
| None -> PointRef.GenerateFromChildSibling(child.NextSibling)
|
||
|
||
static member GeneratePointRef(ref_opt: XmlNode): Option<PointRef> =
|
||
match ref_opt with
|
||
| :? XmlElement as refo when refo.Name.Equals "refer" ->
|
||
let text_objects = PointRef.GenerateFromChildSibling(refo.FirstChild)
|
||
Some(PointRef(refo, text_objects))
|
||
| _ -> None
|
||
end
|
||
|
||
/// 定义节点
|
||
type PointChildType = |Text of TextItem |Refer of PointRef
|
||
type PointDef(bind: XmlElement, objs: AstObject list) =
|
||
class
|
||
inherit AstObject()
|
||
new(bind: XmlElement) = PointDef(bind, [])
|
||
|
||
member this.name() = bind.GetAttribute "name"
|
||
|
||
member this.appendChild(o: PointChildType) =
|
||
match o with
|
||
|Text t -> PointDef(bind, objs@[t])
|
||
|Refer r -> PointDef(bind, objs@[r])
|
||
|
||
member this.children() = objs
|
||
|
||
override this.members(): AstObject list = objs
|
||
|
||
static member GenerateFromChildSibling(child: XmlNode): PointChildType list =
|
||
match child with
|
||
| null -> []
|
||
| _ ->
|
||
let h = match child.Name with
|
||
| "text-section" -> Some(Text(TextItem.GenerateText(child).Value))
|
||
| "refer" -> Some(Refer(PointRef.GeneratePointRef(child).Value))
|
||
| _ -> None
|
||
match h with
|
||
| Some childx -> childx::PointDef.GenerateFromChildSibling(child.NextSibling)
|
||
| None -> PointDef.GenerateFromChildSibling(child.NextSibling)
|
||
|
||
static member GeneratePointDef(def_opt: XmlNode) : Option<PointDef> =
|
||
match def_opt with
|
||
| :? XmlElement as defo when defo.Name.Equals "point" ->
|
||
let child_objs = PointDef.GenerateFromChildSibling(defo.FirstChild)
|
||
let objs = child_objs |> List.map (
|
||
fun o-> match o with
|
||
|Refer refs -> refs :> AstObject
|
||
|Text text -> text :> AstObject
|
||
)
|
||
Some(PointDef(defo, objs))
|
||
| _ -> None
|
||
|
||
end
|
||
|
||
type SliceChildType = |Text of TextItem |Define of PointDef
|
||
/// 情节节点
|
||
type SliceDef(bind: XmlElement, objs: AstObject list) =
|
||
class
|
||
inherit AstObject()
|
||
new(bind: XmlElement) = SliceDef(bind, [])
|
||
|
||
member this.name() =
|
||
bind.GetAttribute "name"
|
||
member this.appendChild(o: SliceChildType) =
|
||
match o with
|
||
| Text t -> SliceDef(bind, objs@[t])
|
||
| Define d -> SliceDef(bind, objs@[d])
|
||
member this.children() = objs
|
||
|
||
override this.members(): AstObject list = objs
|
||
|
||
static member GenerateFromChildSibling(child: XmlNode): SliceChildType list =
|
||
match child with
|
||
| null -> []
|
||
| _ ->
|
||
let h = match child.Name with
|
||
| "text-section" -> Some(Text(TextItem.GenerateText(child).Value))
|
||
| "point" -> Some(Define(PointDef.GeneratePointDef(child).Value))
|
||
| _ -> None
|
||
|
||
match h with
|
||
| Some value -> value::SliceDef.GenerateFromChildSibling(child.NextSibling)
|
||
| _ -> SliceDef.GenerateFromChildSibling(child.NextSibling)
|
||
|
||
static member GenerateSliceDef(slice_opt: XmlNode): Option<SliceDef> =
|
||
match slice_opt with
|
||
| :? XmlElement as slice when slice.Name.Equals "slice" ->
|
||
let mbrs = SliceDef.GenerateFromChildSibling(slice.FirstChild)
|
||
let objs = mbrs |> List.map (
|
||
fun o-> match o with
|
||
|Define defs -> defs :> AstObject
|
||
|Text text -> text :> AstObject
|
||
)
|
||
Some(SliceDef(slice, objs))
|
||
| _ -> None
|
||
end
|
||
|
||
type StoryChildType = |Text of TextItem |Slice of SliceDef
|
||
/// 故事节点
|
||
type StoryDef(bind: XmlElement, objs: AstObject list) =
|
||
class
|
||
inherit AstObject()
|
||
new(bind: XmlElement) = StoryDef(bind, [])
|
||
|
||
member this.name() =
|
||
bind.GetAttribute "name"
|
||
member this.sort() =
|
||
int(bind.GetAttribute "sort")
|
||
member this.appendChild(o: StoryChildType) =
|
||
match o with
|
||
|Text t -> StoryDef(bind, objs@[t])
|
||
|Slice s -> StoryDef(bind, objs@[s])
|
||
member this.children() = objs
|
||
|
||
override this.members(): AstObject list = objs
|
||
|
||
static member GenerateFromChildSibling(child: XmlNode): StoryChildType list =
|
||
match child with
|
||
| null -> []
|
||
| _ ->
|
||
let h = match child.Name with
|
||
| "text-section" -> Some(Text(TextItem.GenerateText(child).Value))
|
||
| "slice" -> Some(Slice(SliceDef.GenerateSliceDef(child).Value))
|
||
| _->None
|
||
match h with
|
||
| Some value -> value::StoryDef.GenerateFromChildSibling(child.NextSibling)
|
||
| _ -> StoryDef.GenerateFromChildSibling(child.NextSibling)
|
||
|
||
static member GenerateStoryDef(story_opt: XmlNode): Option<StoryDef> =
|
||
match story_opt with
|
||
| :? XmlElement as story when story.Name.Equals "story" ->
|
||
let children = StoryDef.GenerateFromChildSibling(story.FirstChild)
|
||
let objs = children |> List.map (
|
||
fun x ->
|
||
match x with
|
||
|Text valx -> valx :> AstObject
|
||
|Slice valx -> valx :> AstObject
|
||
)
|
||
Some(StoryDef(story, objs))
|
||
| _ -> None
|
||
end
|
||
|
||
type ArticleChildType = |Text of TextItem |Refer of PointRef
|
||
/// 章节节点
|
||
type ArticleDef(bind: XmlElement, objs: AstObject list) =
|
||
class
|
||
inherit AstObject()
|
||
new(bind: XmlElement) = ArticleDef(bind, [])
|
||
|
||
member this.name() =
|
||
bind.GetAttribute "name"
|
||
member this.children() = objs
|
||
member this.appendChild(o: ArticleChildType list) =
|
||
let conv item = match item with
|
||
|Text t -> t :> AstObject
|
||
|Refer r -> r :> AstObject
|
||
|
||
let items = o |> List.map conv
|
||
ArticleDef(bind, objs@items)
|
||
|
||
override this.members(): AstObject list = objs
|
||
|
||
static member GenerateFromChildSibling(child: XmlNode): ArticleChildType list =
|
||
match child with
|
||
| null -> []
|
||
| _ ->
|
||
let data = match child.Name with
|
||
| "text-section" -> Some(Text(TextItem.GenerateText(child).Value))
|
||
| "refer" -> Some(Refer(PointRef.GeneratePointRef(child).Value))
|
||
| _ -> None
|
||
match data with
|
||
| Some value -> value::ArticleDef.GenerateFromChildSibling(child.NextSibling)
|
||
| None -> ArticleDef.GenerateFromChildSibling(child.NextSibling)
|
||
|
||
static member GenerateArticleDef(article_opt: XmlNode): Option<ArticleDef> =
|
||
match article_opt with
|
||
| :? XmlElement as article when article.Name.Equals "article" ->
|
||
let mbrs = ArticleDef.GenerateFromChildSibling(article.FirstChild)
|
||
let conv it = match it with
|
||
|Text v -> v :> AstObject
|
||
|Refer v -> v:> AstObject
|
||
Some(ArticleDef(article, mbrs |> List.map conv))
|
||
| _ -> None
|
||
end
|
||
|
||
type VolumeChildType = |Text of TextItem |Article of ArticleDef
|
||
/// 卷宗节点
|
||
type VolumeDef(bind: XmlElement, objs: AstObject list) =
|
||
class
|
||
inherit AstObject()
|
||
new(bind: XmlElement) = VolumeDef(bind, [])
|
||
|
||
member this.name() =
|
||
bind.GetAttribute "name"
|
||
member this.children() = objs
|
||
member this.appendChild(o: VolumeChildType list) =
|
||
let items = o |> List.map (
|
||
fun it->
|
||
match it with
|
||
|Text t -> t :> AstObject
|
||
|Article a -> a :> AstObject
|
||
)
|
||
VolumeDef(bind, objs@items)
|
||
|
||
override this.members(): AstObject list = objs
|
||
|
||
static member GenerateFromChildSibling(child: XmlNode): VolumeChildType list =
|
||
match child with
|
||
| null -> []
|
||
| _ ->
|
||
let data = match child.Name with
|
||
| "text-section" -> Some(Text(TextItem.GenerateText(child).Value))
|
||
| "article" -> Some(Article(ArticleDef.GenerateArticleDef(child).Value))
|
||
| _ -> None
|
||
match data with
|
||
| Some value -> value::VolumeDef.GenerateFromChildSibling(child.NextSibling)
|
||
| None -> VolumeDef.GenerateFromChildSibling(child.NextSibling)
|
||
|
||
static member GenerateVolumeDef(vol_opt: XmlNode): Option<VolumeDef> =
|
||
match vol_opt with
|
||
| :? XmlElement as volume when volume.Name.Equals "volume" ->
|
||
let mbrs = VolumeDef.GenerateFromChildSibling(volume.FirstChild)
|
||
let conv data = match data with
|
||
|Text d -> d :> AstObject
|
||
|Article d -> d:> AstObject
|
||
Some(VolumeDef(volume, mbrs |> List.map conv))
|
||
| _ -> None
|
||
|
||
|
||
end
|
||
|
||
type ProgramChildType = |Volume of VolumeDef |Story of StoryDef
|
||
/// 程序节点
|
||
type Program(bind: XmlElement, objs: AstObject list) =
|
||
class
|
||
inherit AstObject()
|
||
new(bind: XmlElement) = Program(bind, [])
|
||
|
||
member this.time() =
|
||
bind.GetAttribute "time"
|
||
member this.children() = objs
|
||
member this.appendChild(o: ProgramChildType list) =
|
||
let items = o |> List.map (fun it->
|
||
match it with
|
||
|Story s -> s :> AstObject
|
||
|Volume v -> v :> AstObject
|
||
)
|
||
Program(bind, objs @items)
|
||
|
||
override this.members(): AstObject list = objs
|
||
|
||
static member GenerateFromChildSibling(child: XmlNode): ProgramChildType list =
|
||
match child with
|
||
| null -> []
|
||
| _ ->
|
||
let d = match child.Name with
|
||
| "volume" -> Some(Volume(VolumeDef.GenerateVolumeDef(child).Value))
|
||
| "story" -> Some(Story(StoryDef.GenerateStoryDef(child).Value))
|
||
| _ -> None
|
||
match d with
|
||
|Some value -> value::Program.GenerateFromChildSibling(child.NextSibling)
|
||
|None -> Program.GenerateFromChildSibling(child.NextSibling)
|
||
|
||
static member GenerateFrom(doc: XmlDocument) =
|
||
let ast = doc.DocumentElement
|
||
|
||
let mbrs = Program.GenerateFromChildSibling(ast.FirstChild)
|
||
let conv data = match data with
|
||
|Volume d -> d:>AstObject
|
||
|Story d -> d :> AstObject
|
||
Program(ast, mbrs |> List.map conv)
|
||
end
|
||
|
||
|
||
type AstVisitor =
|
||
interface
|
||
abstract member visit:AstObject -> bool
|
||
end
|
||
|
||
type AstVisitEntry(root: AstObject) =
|
||
class
|
||
/// 1：node
|
||
/// 2: node
|
||
/// 2: node
|
||
/// 3: node
|
||
/// 4: node
|
||
/// ......
|
||
member private this.visit_internal(nodes: AstObject list, visitor: AstVisitor): bool =
|
||
match nodes.Length with
|
||
| 0 -> true
|
||
| _ ->
|
||
this.visit_internal(nodes.Head.members(), visitor) && visitor.visit(nodes.Head) && this.visit_internal(nodes.Tail, visitor)
|
||
|
||
|
||
member this.visitWith(visitor: AstVisitor): bool =
|
||
this.visit_internal([root], visitor)
|
||
|
||
end |