Skip to content
Permalink
Branch: master
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
162 lines (121 sloc) 7.5 KB
// Copyright (c) Cetin Sert 2012
// License: Simplified BSD.
#if INTERACTIVE
#else
module XParsec
#endif
#if INTERACTIVE
#r "System.Xml.Linq.dll"
#endif
open System
let inline Δ<'a> = Unchecked.defaultof<'a>
[<Struct>]
type Source<'s,'a> =
val State : 's
val Current : 'a
new (s : 's, c : 'a) = { State = s; Current = c }
override s.ToString () = String.Format("Source({0},{1})", s.State, s.Current)
type 'a Reply = S of 'a | F | Q with
member inline r.Value = match r with S x -> x | Q | F -> raise <| new InvalidOperationException()
member inline r.IsMatch = match r with Q | F -> false | S _ -> true
static member inline fromBool b = if b then S () else F
static member inline negate r = match r with Q -> Q | F -> S () | S _ -> F
static member inline put x r = match r with Q -> Q | F -> F | S _ -> S x
static member inline map f r = match r with Q -> Q | F -> F | S x -> S <| f x
static member inline choose f r = match r with Q -> Q | F -> F | S x -> match f x with Some v -> S v | None -> F
static member inline toOption r = match r with Q | F -> None | S x -> Some x
type Parser<'s,'a,'b> = Source<'s,'a> -> Reply<'b> * Source<'s,'a>
let inline reply (r,_) = r
let inline source (_,s) = s
module Combinators =
let inline (?->) b x = if b then Some x else None
let inline current (s : Source<_,_>) = S <| s.Current,s
let inline future () = let r = ref Δ in (fun s-> !r s), r : Parser<_,_,_> * Parser<_,_,_> ref
let inline (!!) (p : Parser<_,_,_>) s = let r,_ = p s in r,s
let inline (~-) (p : Parser<_,_,_>) s = let r,s = p s in Reply<_>.negate r,s
let inline (=>) (p : Parser<_,_,_>) f s = let r,s = p s in Reply<_>.map f r,s
let inline (?>) (p : Parser<_,_,_>) f s = let r,s = p s in Reply<_>.choose f r,s
let inline (.> ) (p : Parser<_,_,_>) (q : Parser<_,_,_>) s = let r,s = p s in match r with Q -> Q,s | F -> F,s | S p -> let r,s = q s in Reply<_>.put p r,s
let inline ( >.) (p : Parser<_,_,_>) (q : Parser<_,_,_>) s = let r,s = p s in match r with Q -> Q,s | F -> F,s | S _ -> q s
let inline (.>.) (p : Parser<_,_,_>) (q : Parser<_,_,_>) s = let r,s = p s in match r with Q -> Q,s | F -> F,s | S p -> let r,s = q s in Reply<_>.map (fun q -> (p,q)) r,s
let inline (</>) (p : Parser<_,_,_>) (q : Parser<_,_,_>) s = let r,sp = p s in match r with Q | F -> q s | p -> p,sp
let inline manyMax n (p : Parser<_,_,_>) s =
let b = ref Δ
let l = ref (Δ,s)
let c = ref 0
let q = Seq.toList <| seq { while (b := source !l; l := p !b; !c < n && (reply !l).IsMatch) do c := !c + 1; yield (reply !l).Value }
S q,!b
let inline many (p : Parser<_,_,_>) s = manyMax Int32.MaxValue p s
let inline many1 (p : Parser<_,_,_>) s = let r,s = many p s in Reply<_>.choose (function _::_ as l -> Some l | _ -> None) r,s
let inline array n (p : Parser<_,_,_>) s = let r,s = manyMax n p s in Reply<_>.choose (function l -> let a = List.toArray l in (a.Length = n) ?-> a) r,s
let inline skipManyMax n (p : Parser<_,_,_>) s =
let mutable b = Δ
let mutable l = (Δ,s)
let mutable c = 0
while (b <- source l; l <- p b; c < n && (reply l).IsMatch) do c <- c + 1
S c,b
let inline skipMany (p : Parser<_,_,_>) s = skipManyMax Int32.MaxValue p s
let inline skipMany1 (p : Parser<_,_,_>) s = let r,s = s |> skipMany p in Reply<_>.choose (fun n -> if n > 0 then Some n else None) r,s
let inline skipN x (p : Parser<_,_,_>) s = let r,s = s |> skipMany p in Reply<_>.choose (fun n -> if n = x then Some () else None) r,s
let inline (!*.) p s = many p s
let inline (!+.) p s = many1 p s
let inline (!*) p s = skipMany p s
let inline (!+) p s = skipMany1 p s
let inline (>>=) (p : Parser<'s,'a,'b>) f s = let r,s = p s in match r with Q -> Q,s | F -> F,s | S b -> f b s
module Array =
type Position = Int32
type 'a Stream = Source<'a [], Position>
let pre = Position.MinValue
let post = Position.MaxValue
let inline clamp l u n = l |> max <| n |> min <| u
let inline (|?|) a i = i > - 1 && i < (a:_[]).Length
module Array =
let inline source i (s : _ seq) = let a = Seq.toArray s in let i = clamp -1 a.Length i in Source(Source(a, i), if a |?| i then a.[i] else Δ)
module Navigation =
type Σ<'s,'a> = Source<'s,'a>
let inline σ (s : Source< _, _>) = s.State
let inline χ (s : Source< _, _>) = s.Current
let inline next s = let a : _ [] = σ (σ s) in let c = χ (σ s) + 1 in if c < a.Length then S a.[c],Σ(Σ(a,c),a.[c]) else Q,s
let inline prev s = let a : _ [] = σ (σ s) in let c = χ (σ s) - 1 in if c > -1 then S a.[c],Σ(Σ(a,c),a.[c]) else Q,s
module Xml =
open System.Xml.Linq
type E = XElement
type A = XAttribute
type N = string
type V = string
module Operators =
let inline (!>) x = ( ^a : (static member op_Implicit : ^b -> ^a) x )
let inline (~~) a = a |> String.IsNullOrWhiteSpace
let inline (-?-) a b = match (a : string) with null -> false | _ -> a.Contains b
let inline (-!-) a b = match (a : string) with null -> true | _ -> a.Contains b |> not
let inline (@@) (e:E) n = e.Attribute(!> n)
let inline (@ ) (e:E) n = match e.Attribute(!> n) with null -> Δ | a -> a.Value
let inline (@-) e n = ~~(e @ n)
let inline (@+) e n = ~~(e @ n) |> not
let inline (@?) e n v = (e @ n) -?- v
let inline (@!) e n v = (e @ n) -!- v
let inline name x = ( ^a : (member Name : XName ) x ).LocalName
let inline value x = ( ^a : (member Value : string) x )
open Operators
module Parsers =
let inline ( !<> ) n (s : Source<_,E>) = (match s.Current.Name.LocalName = n with false -> F | _ -> S s.Current),s
let inline ( !@@ ) n (s : Source<_,E>) = (match s.Current.Attribute (!> n) with null -> F | a -> S a ),s
let inline ( !@ ) n (s : Source<_,E>) = (match s.Current.Attribute (!> n) with null -> F | a -> S a.Value ),s
let inline ( !@- ) n (s : Source<_,E>) = ( s.Current @- n |> Reply<_>.fromBool),s
let inline ( !@+ ) n (s : Source<_,E>) = ( s.Current @+ n |> Reply<_>.fromBool),s
let inline ( @~? ) n v (s : Source<_,E>) = ((s.Current @? n <| v) |> Reply<_>.fromBool),s
let inline ( @~! ) n v (s : Source<_,E>) = ((s.Current @! n <| v) |> Reply<_>.fromBool),s
module Navigation =
type N = XNode
type XElement with
member e.NextElement = let n = e :> N in let mutable c = n in (while (c <- c.NextNode; match c with :? E | null -> false | _ -> true) do ()); match c with :? E as e -> e | _ -> Δ
member e.PreviousElement = let n = e :> N in let mutable c = n in (while (c <- c.PreviousNode; match c with :? E | null -> false | _ -> true) do ()); match c with :? E as e -> e | _ -> Δ
member inline e.Child = if e.HasElements then e.Elements() |> Seq.head else Δ
static member inline source e = Source((e:E),e)
let next (s : Source<_,E>) = match s.Current.NextElement with null -> Q,s | x -> S x,E.source x
let prev (s : Source<_,E>) = match s.Current.PreviousElement with null -> Q,s | x -> S x,E.source x
let parent (s : Source<_,E>) = match s.Current.Parent with null -> Q,s | x -> S x,E.source x
let child (s : Source<_,E>) = match s.Current.Child with null -> Q,s | x -> S x,E.source x
module Parsers =
open Combinators
let inline children p = !!(child>.p .>. !*.(next>.p)) => function c,cs -> c::cs
You can’t perform that action at this time.