Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Added ArraySegmentPrimitives and tests. Fixed all but two failing tests.
  • Loading branch information
panesofglass committed Mar 6, 2011
1 parent 7c44e48 commit 1d6da26
Show file tree
Hide file tree
Showing 10 changed files with 272 additions and 15 deletions.
195 changes: 195 additions & 0 deletions src/Cashel.Tests/ArraySegmentPrimitivesTest.fs
@@ -0,0 +1,195 @@
module ArraySegmentPrimitivesTest
open System

let (!!) str = List.ofSeq str

This comment has been minimized.

Copy link
@panesofglass

panesofglass Mar 21, 2011

Author Owner

Creates a list from a given string.

let (!!!) str = ArraySegment<_>(str)

This comment has been minimized.

Copy link
@panesofglass

panesofglass Mar 21, 2011

Author Owner

Creates an array segment from the provided string input.

let (!!+) str offset = ArraySegment<_>(str, offset, str.Length - offset)

This comment has been minimized.

Copy link
@panesofglass

panesofglass Mar 21, 2011

Author Owner

Creates a new array segment given a string and an offset. This creates an underlying array from the string with an offset already set.

let (!+) str = !!+str 1

This comment has been minimized.

Copy link
@panesofglass

panesofglass Mar 21, 2011

Author Owner

Same as line 6, but defaulted to an offset of 1 for single character matches.


open NUnit.Framework
open FsUnit

open Cashel
open Cashel.ArraySegmentPrimitives

let inline (===>) (actual: (_ * ArraySegment<_>) option) (expected: (_ * ArraySegment<_>) option) =

This comment has been minimized.

Copy link
@panesofglass

panesofglass Mar 21, 2011

Author Owner

F# generally uses structural comparisons. However, NUnit does not, especially when working with general .NET types like ArraySegment. This operator tests the structural sameness of two array segments. The goal is not to have identical ArraySegment instances or even two instances using the same underlying array, as most tests are recreating the array as well for readability. These will likely be refactored once the ArraySegmentPrimitives are refactored to always use the same underlying buffer.

if actual.IsNone && expected.IsNone then actual |> should equal expected
else
let avalue, asegment = actual |> Option.get
let evalue, esegment = expected |> Option.get
evalue = avalue |> should be True
asegment.Array |> should equal esegment.Array
asegment.Offset |> should equal esegment.Offset
asegment.Count |> should equal esegment.Count

let test = "test"B
let test_me = "test me"B
let ttttest = "ttttest"B

[<Test>]
let test_token () =
let exp = Some('t'B, !+test)
token !!!test ===> exp

[<Test>]
let test_token_empty_list () =
token !!!""B ===> None

[<Test>]
let test_token_single_token () =
let t = "t"B
let exp = Some('t'B, !+t)
token !!!t ===> exp

[<Test>]
let test_ignore_with_token () =
let exp = Some((), !+test)
forget token !!!test ===> exp

[<Test>]
let test_listify_with_token () =
let exp = Some(['t'B], !+test)
listify token !!!test ===> exp

[<Test>]
let test_filter_simple_predicate () =
let exp = Some('t'B, !+test)
filter token (fun x -> x = 't'B) !!!test ===> exp

[<Test>]
let test_filter_failure_predicate () =
filter token (fun x -> x = 'e'B) !!!test ===> None

[<Test>]
let test_any_success_predicate () =
any ['q'B..'v'B] !!!test ===> (Some('t'B, !+test))

[<Test>]
let test_any_failure_predicate () =
any ['a'B..'e'B] !!!test ===> None

[<Test>]
let test_matchToken () =
matchToken 't'B !!!test ===> (Some('t'B, !+test))

[<Test>]
let test_matchToken_failure () =
matchToken 'e'B !!!test ===> None

[<Test>]
let test_matchTokens () =
matchTokens !!test !!!test_me ===> (Some(!!test, !!+test_me 4))

[<Test>]
let test_matchTokens_failue () =
matchTokens !!test !!!"tesp me"B ===> None

[<Test>]
let test_eof () =
eof !!!""B ===> (Some((),!!!""B))

[<Test>]
let test_eof_fails_not_at_end () =
eof !!!test ===> None

[<Test>]
let test_repeat () =
repeat (matchToken 't'B) !!!ttttest ===> (Some(!!"tttt"B, !!+ttttest 4))

[<Test>]
let test_repeat_one_match() =
repeat (matchToken 't'B) !!!test ===> (Some(['t'B], !+test))

[<Test>]
let test_repeat_no_matches () =
repeat (matchToken 'e'B) !!!ttttest ===> (Some([], !!!ttttest))

[<Test>]
let test_repeat1 () =
repeat1 (matchToken 't'B) !!!ttttest ===> (Some(!!"tttt"B, !!+ttttest 4))

[<Test>]
let test_repeat1_one_match() =
repeat1 (matchToken 't'B) !!!test ===> (Some(['t'B], !+test))

[<Test>]
let test_repeat1_no_matches () =
repeat1 (matchToken 'e'B) !!!ttttest ===> None

[<Test>]
let test_failure_predicate_parser_success() =
!~ (matchToken 't'B) !!!test ===> None

[<Test>]
let test_failure_predicate_parser_fails () =
!~ (matchToken 'e'B) !!!test ===> (Some((), !!!test))

[<Test>]
let test_Success_predicate_parser_success() =
!& (matchToken 't'B) !!!test ===> (Some((), !!!test))

[<Test>]
let test_success_predicate_parser_fails () =
!& (matchToken 'e'B) !!!test ===> None

[<Test>]
let test_option_predicate_one () =
!? (matchToken 't'B) !!!test ===> (Some(Some('t'B), !+test))

[<Test>]
let test_option_predicate_zero () =
!? (matchToken 'e'B) !!!test ===> (Some(None, !!!test))

[<Test>]
let test_ignore_left () =
((matchToken 't'B) .>> (matchToken 'e'B)) !!!test ===> (Some('t'B, !!+test 2))

[<Test>]
let test_ignore_left_fails () =
((matchToken 'e'B) .>> (matchToken 'e'B)) !!!test ===> None

[<Test>]
let test_ignore_right () =
((matchToken 't'B) >>. (matchToken 'e'B)) !!!test ===> (Some('e'B, !!+test 2))

[<Test>]
let test_ignore_right_fails () =
((matchToken 't'B) >>. (matchToken 's'B)) !!!test ===> None

[<Test>]
let test_parse_return_value () =
((matchToken 't'B) >>! !!"hello"B) !!!test ===> (Some(!!"hello"B, !+test))

[<Test>]
let test_parse_return_value_fails () =
((matchToken 'q'B) >>! !!"hello"B) !!!test ===> None

[<Test>]
let test_until () =
(until token (matchToken 's'B)) !!!test ===> (Some(!!"te"B, !!+test 3))

[<Test>]
let test_until_fail_1 () =
(until token (matchToken 'q'B)) !!!test ===> None

[<Test>]
let test_until_fail_2 () =
(until (matchToken 'q'B) (matchToken 's'B)) !!!test ===> None

[<Test>]
let test_skip () =
let exp = Some((), !+test)
skip 't'B !!!test ===> exp

[<Test>]
let test_skip_fail () =
skip 'e'B !!!test ===> None

[<Test>]
let test_skips () =
let exp = Some((), !!+test 2)
skips !!"te"B !!!test ===> exp

[<Test>]
let test_skips_fail () =
skips !!"ts"B !!!test ===> None
9 changes: 5 additions & 4 deletions src/Cashel.Tests/Cashel.Tests.fsproj
Expand Up @@ -41,10 +41,11 @@
</PropertyGroup>
<Import Project="..\..\lib\FSharp\Microsoft.FSharp.Targets" />
<ItemGroup>
<Compile Include="parser_test.fs" />
<Compile Include="primitives_test.fs" />
<Compile Include="peg_test.fs" />
<Compile Include="peg2_test.fs" />
<Compile Include="ParserTest.fs" />
<Compile Include="ListPrimitivesTest.fs" />
<Compile Include="ArraySegmentPrimitivesTest.fs" />
<Compile Include="PegTest.fs" />
<Compile Include="Peg2Test.fs" />
<None Include="packages.config" />
</ItemGroup>
<ItemGroup>
Expand Down
@@ -1,4 +1,4 @@
module PrimitivesTest
module ListPrimitivesTest

let (!!) str = List.ofSeq str

Expand All @@ -20,7 +20,7 @@ let test_token_empty_list () =
[<Test>]
let test_token_single_token () =
let exp = Some('t', [])
token ['t'] |> should equal exp
token ['t'] = exp |> should be True

[<Test>]
let test_ignore_with_token () =
Expand Down Expand Up @@ -83,7 +83,7 @@ let test_repeat_one_match() =

[<Test>]
let test_repeat_no_matches () =
repeat (matchToken 'e') !!"ttttest" |> should equal (Some([], !!"ttttest"))
repeat (matchToken 'e') !!"ttttest" = (Some([], !!"ttttest")) |> should be True

[<Test>]
let test_repeat1 () =
Expand Down Expand Up @@ -119,7 +119,7 @@ let test_option_predicate_one () =

[<Test>]
let test_option_predicate_zero () =
!? (matchToken 'e') !!"test" |> should equal (Some(None, !!"test"))
!? (matchToken 'e') !!"test" = (Some(None, !!"test")) |> should be True

[<Test>]
let test_ignore_left () =
Expand Down
File renamed without changes.
Expand Up @@ -66,7 +66,7 @@ let (>|>) act exp =

[<Test>]
let test_eof () =
_EndOfFile [] |> should equal (Some((),[]))
_EndOfFile [] = (Some((),[]))|> should be True

[<Test>]
let test_eof_fails_not_at_end () =
Expand Down
Expand Up @@ -68,7 +68,7 @@ let test_Comment_not_comment () =

[<Test>]
let test_Spacing_with_no_comment () =
Spacing !!"test comment\r\nmore text" |> should equal (Some([], !!"test comment\r\nmore text"))
Spacing !!"test comment\r\nmore text" = (Some([], !!"test comment\r\nmore text")) |> should be True

[<Test>]
let test_Spacing_with_comment () =
Expand Down
46 changes: 46 additions & 0 deletions src/Cashel/ArraySegmentPrimitives.fs
@@ -0,0 +1,46 @@
namespace Cashel

module ArraySegmentPrimitives =

This comment has been minimized.

Copy link
@panesofglass

panesofglass Mar 21, 2011

Author Owner

These are intended to be used in single-threaded event loop state machines (a mouthful) which share a single, segmented memory buffer. Given the specificity of the intended target, this may best be removed. However, it also serves as an example of how one might extend the core functionality of the cashel Parser monad.

open System
open Cashel

//-------------------------ArraySegment helpers----------------------------------------------

let slice (input:ArraySegment<_>) =
match input with
| x when x.Count = 0 -> None
| x -> Some(x.Array.[x.Offset], ArraySegment<'a>(x.Array, x.Offset + 1, x.Count - 1))

//-------------------------ArraySegment primitives-------------------------------------------

///token assumes the input is a list and returns a tuple of the head and tail
let token : Parser<ArraySegment<'a>, 'a> = slice

This comment has been minimized.

Copy link
@panesofglass

panesofglass Mar 21, 2011

Author Owner

This should really be of type Parser<ArraySegment<'a> list, ArraySegment<'a>>.


///eof checks that we're at the end of the list being parsed
let eof : Parser<ArraySegment<'a>, unit> = fun input ->

This comment has been minimized.

Copy link
@panesofglass

panesofglass Mar 21, 2011

Author Owner

Again, type should be Parser<ArraySegment<'a> list, unit>.

match input with
| x when x.Count = 0 -> Some((), x)
| _ -> None

///any checks the value at the start of the input is in the list of items l
let any l = filter token (fun x -> l |> List.exists (fun y -> x = y))

///item_equal checks the value at the start of the input matches the value v
let matchToken v = filter token (fun x -> x = v)

///items_equal recursively uses item_equal to check to see if a list of values l matches the start of the input
let rec matchTokens l =

This comment has been minimized.

Copy link
@panesofglass

panesofglass Mar 21, 2011

Author Owner

Combinators matching more than one value should ideally be typed as Parser<ArraySegment<'a> list, ArraySegment<'a> list>. This begins looking hairy, but it matches the intent: keep the values in the original buffer and provide a way to access them. One might presume that a single ArraySegment<'a> is all that's necessary; however, you quickly lose the ability to skip characters that are not needed, and the combinations further up the parse may not match anymore.

match l with
| [] -> result []
| x::xs -> matchToken x >>= (fun i -> matchTokens xs >>= (fun is -> result (i::is)))

///skip_item calls item_equal but tosses the parse value
let skip v = matchToken v |> forget

///skip_items calls items_equal but tosses the parse value
let skips l = matchTokens l |> forget

///listify turns the result of parsing function p into a single item list
let listify p = p >>= (fun x -> result [x])


1 change: 1 addition & 0 deletions src/Cashel/Cashel.fsproj
Expand Up @@ -48,6 +48,7 @@
<Compile Include="primitives.fs" />
<Compile Include="ListPrimitives.fs" />
<Compile Include="CharListPrimitives.fs" />
<Compile Include="ArraySegmentPrimitives.fs" />
</ItemGroup>
<Import Project="..\..\lib\FSharp\Microsoft.FSharp.Targets" />
</Project>
19 changes: 18 additions & 1 deletion src/Cashel/parser.fs
Expand Up @@ -38,4 +38,21 @@ module Parser =
member w.Combine(p1,p2) = p1 +++ p2

let parser = ParserBuilder()


///map applies the function f to the results of the parser p
let map p f = p >>= (fun x -> result (f x))

///filter checks the value returned from item against the predicate function f
let filter p f = p >>= (fun x -> if f x then result x else zero)

///unfold generates a parser from the inital seed value filter f and a function to get the next value
let unfold seed f next =
let rec loop curr = parser {
if f curr then return curr
else return! zero
return! loop (next curr) }
loop seed

///pure applicative functor
let (<*>) f a = f >>= (fun f' -> a >>= (fun a' -> result (f' a')))

5 changes: 1 addition & 4 deletions src/Cashel/primitives.fs
Expand Up @@ -6,7 +6,7 @@ module Primitives =

//-------------------------Basic primitives----------------------------------------------------
//These primitives make no assumption as to the basic types of the parser input or result types

///Custom bind operator >>! binds parser p to result v, ignoring the return value of p
let (>>!) p v = p >>= (fun _ -> result v)

Expand All @@ -21,9 +21,6 @@ module Primitives =

///listify turns the result of parsing function p into a single item list
let listify p = p >>= (fun x -> result [x])

///filter checks the value returned from item against the predicate function f
let filter p f = p >>= (fun x -> if f x then result x else zero)

///repeat looks for zero or more instances of the parsing function p
let rec repeat p = (repeat1 p) +++ (result [])
Expand Down

0 comments on commit 1d6da26

Please sign in to comment.