366 lines
16 KiB
Forth
366 lines
16 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
|
|||
|
|
|
|||
|
|
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 PointDef(bind: XmlElement, texts: TextItem list) =
|
|||
|
|
class
|
|||
|
|
inherit AstObject()
|
|||
|
|
new(bind: XmlElement) = PointDef(bind, [])
|
|||
|
|
|
|||
|
|
member this.name() =
|
|||
|
|
bind.GetAttribute "name"
|
|||
|
|
member this.appendChild(t: TextItem) =
|
|||
|
|
PointDef(bind, texts@[t])
|
|||
|
|
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::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 text_objs = PointDef.GenerateFromChildSibling(defo.FirstChild)
|
|||
|
|
Some(PointDef(defo, text_objs))
|
|||
|
|
| _ -> None
|
|||
|
|
|
|||
|
|
end
|
|||
|
|
|
|||
|
|
type SliceChildType = |Text of TextItem |Define of PointDef |Refer of PointRef
|
|||
|
|
/// 情节节点
|
|||
|
|
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])
|
|||
|
|
| Refer r -> SliceDef(bind, objs@[r])
|
|||
|
|
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))
|
|||
|
|
| "refer" -> Some(Refer(PointRef.GeneratePointRef(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
|
|||
|
|
|Refer refs -> refs :> 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
|