Commits

Paweł Wieczorek committed 7732d0d Draft

added files for monadic forward-parser

  • Participants
  • Parent commits 6baf62d
  • Branches monadic_parser

Comments (0)

Files changed (2)

src/Sip_monadic_parser.ml

+(*********************************************************************************************************************
+ * Copyrights (C) 2012 by Pawel Wieczorek <wieczyk at gmail>
+ *  http://bitbucket.org/wieczyk/ocaml-sip
+ *)
+
+open Batteries
+
+
+module Util = struct
+
+    let eol_sep = "\r\n"
+
+    let is_sep seps = function
+        | c when List.mem c seps -> true
+        | _ -> false
+
+    let rec skip_seps seps buf = function
+        | n when n = String.length buf ->
+            n
+
+        | n when is_sep seps (String.get buf n) ->
+            skip_seps seps buf (succ n)
+
+        | n ->
+            n
+
+    let find_sep seps start last buf =
+        let rec find_end start = function
+            | n when n = String.length buf ->
+                (String.slice buf ~first:start ~last:n, n, last)
+
+            | n when is_sep seps (String.get buf n) ->
+                (String.slice buf ~first:start ~last:n, n, true)
+
+            | n ->
+                find_end start (succ n)
+
+            in
+
+        let remember_arg f x = f x x 
+            in
+        (remember_arg find_end -| skip_seps seps buf) start
+
+    let find_word = find_sep [' '; '\r'; '\n'] 
+
+    let find_endline index buf =
+        let last = String.find_from buf index eol_sep in
+        (String.slice buf ~first:index ~last:last, succ (succ last))
+
+end
+
+module Monad = struct
+
+    type state = string * int * bool
+    type ('a, 'b) either = Left of 'a | Right of 'b
+
+    type 'a t
+        = Step of (state -> ('a * state, 'a t) either )
+        | Fault of exn 
+        | Coroutine of (state -> 'a t)
+
+    let rec (>>=) (m : 'a t) (f : 'a -> 'b t) : 'b t = 
+        match m with
+        | Step ma ->
+            begin try
+                let mb s0  = 
+                    match ma s0 with
+                    | Left (a, s1) -> Right (f a )
+                    | Right t -> raise Exit
+                    in
+                Step mb
+            with exn ->
+                Fault exn
+            end
+
+        | Fault exn ->
+            Fault exn
+
+        | Coroutine co ->
+            raise Exit
+
+(*
+    let resume monad last buffer = match monad with
+        | Coroutine co ->
+            co (buffer, 0, last)
+
+        | x ->
+            failwith "resume: cannot resume finalized parser"
+
+    let embed x _ = x
+
+    let run m s0 = match m with
+        | Step f -> f s0
+
+        | _ -> 
+            failwith "run: cannot run not-Step monad"
+
+
+    let _get_word (buffer, index, last) =
+        let (word, index, found) = Util.find_word index last buffer in
+        if found
+        then (word, (buffer, index, last))
+        else raise Exit
+
+    let get_word = Step _get_word
+*)
+end
+
+open Monad
+
+let word = "WORD"

tests/Test_monadic_parser.ml

+(*********************************************************************************************************************
+ * Copyrights (C) 2012 by Pawel Wieczorek <wieczyk at gmail>
+ *  http://bitbucket.org/wieczyk/ocaml-sip
+ *)
+
+open Sip_monadic_parser
+open OUnit
+
+let test_suite = "Monadic parser" >:::
+    [
+    ]