Source

oni / cf / cf_llscan.ml

(*---------------------------------------------------------------------------*
  $Change$
  Copyright (C) 2011, james woodyatt
  All rights reserved.
  
  Redistribution and use in source and binary forms, with or without
  modification, are permitted provided that the following conditions
  are met:
  
    Redistributions of source code must retain the above copyright
    notice, this list of conditions and the following disclaimer.
    
    Redistributions in binary form must reproduce the above copyright
    notice, this list of conditions and the following disclaimer in
    the documentation and/or other materials provided with the
    distribution
  
  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
  INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
  (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
  OF THE POSSIBILITY OF SUCH DAMAGE. 
 *---------------------------------------------------------------------------*)

type ('s, 'r) t = 's Cf_seq.t -> ('r * 's Cf_seq.t) option

let nil _ = None
let ret a s = Some (a, s)

let bind m f s =
    match m s with
    | None -> None
    | Some (r, s) -> f r s

let fin s =
    match Lazy.force s with
    | Cf_seq.Z -> Some ((), s)
    | Cf_seq.P _ -> None

let any s =
    match Lazy.force s with
    | Cf_seq.P (hd, tl) -> Some (hd, tl)
    | Cf_seq.Z -> None

let eq i0 s =
    match Lazy.force s with
    | Cf_seq.P (i, tl) when i = i0 -> Some (i0, tl)
    | _ -> None

let sat f s =
    match Lazy.force s with
    | Cf_seq.P (hd, tl) when f hd -> Some (hd, tl)
    | (Cf_seq.P _ | Cf_seq.Z) -> None

let lit k x =
    let klen = String.length k in
    let rec loop i s =
        if i < klen then
            match Lazy.force s with
            | Cf_seq.P (hd, tl) when String.unsafe_get k i = hd ->
                loop (succ i) tl
            | _ ->
                None
        else
            Some (x, s)
    in
    loop 0

let tok f s =
    match Lazy.force s with
    | Cf_seq.Z -> None
    | Cf_seq.P (hd, tl) ->
        match f hd with
        | Some r -> Some (r, tl)
        | None -> None

let opt p s =
    Some begin
        match p s with
        | None -> None, s
        | Some (r, s) -> Some r, s
    end

let seq =
    let rec loop u p s =
        match p s with
        | None -> Some (List.rev u, s)
        | Some (r, s) -> loop (r :: u) p s
    in
    let start p s = loop [] p s in
    start

let seq1 p =
    bind p (fun hd -> bind (seq p) (fun tl -> ret (hd, tl)))

let seqx =
    let rec loop u f g i s =
        match f i s with
        | None ->
            let d = i, List.rev u in
            Some (d, s)
        | Some (b, s) ->
            let i, c = g b in
            loop (c :: u) f g i s
    in
    let enter f g i s = loop [] f g i s in
    enter

let seqx1 =
    let ( >>= ) = bind in
    let enter f g i =
        f i >>= fun b ->
        let i, c = g b in
        seqx f g i >>= fun (i, cs) ->
        ret (i, c, cs)
    in
    enter

let rec seqf f a p s =
    match p s with
    | None -> Some (a, s)
    | Some (r, s) -> seqf f (f a r) p s

let rec alt ps s =
    match ps with
    | [] -> None
    | hd :: tl ->
        match hd s with
        | None -> alt tl s
        | Some _ as r -> r

let rec altz pz s =
    match Lazy.force pz with
    | Cf_seq.Z -> None
    | Cf_seq.P (hd, tl) ->
        match hd s with
        | None -> altz tl s
        | Some _ as r -> r

exception Error

let err =
    let aux _ = Error in
    fun ?(f = aux) () s -> raise (f s)

let req ?f p s =
    match p s with
    | None -> err ?f () s
    | Some _ as r -> r

let rec unfold =
    let aux _ = Error in
    let rec loop f p s =
        match p s with
        | None ->
            if Lazy.force s <> Cf_seq.Z then raise (f s);
            Cf_seq.Z
        | Some (r, s) ->
            Cf_seq.P (r, lazy (loop f p s))
    in
    let start ?(f = aux) p s = lazy (loop f p s) in
    start

module Op = struct
    let ( >>= ) = bind
    let ( ?. ) = eq
    let ( ?/ ) = opt
    let ( ?+ ) = seq1
    let ( ?* ) = seq
    let ( ?^ ) = alt
    let ( ?^~ ) = altz
end

(*--- $File$ ---*)
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.