Browse files

Added ArraySegmentPrimitives and tests. Fixed all but two failing tests.

  • Loading branch information...
1 parent 7c44e48 commit 1d6da2674e3f1adf2bff0fd8761bc6071168a081 @panesofglass panesofglass committed Mar 6, 2011
View
195 src/Cashel.Tests/ArraySegmentPrimitivesTest.fs
@@ -0,0 +1,195 @@
+module ArraySegmentPrimitivesTest
+open System
+
+let (!!) str = List.ofSeq str
+let (!!!) str = ArraySegment<_>(str)
+let (!!+) str offset = ArraySegment<_>(str, offset, str.Length - offset)
+let (!+) str = !!+str 1
+
+open NUnit.Framework
+open FsUnit
+
+open Cashel
+open Cashel.ArraySegmentPrimitives
+
+let inline (===>) (actual: (_ * ArraySegment<_>) option) (expected: (_ * ArraySegment<_>) option) =
+ 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
View
9 src/Cashel.Tests/Cashel.Tests.fsproj
@@ -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>
View
8 src/Cashel.Tests/primitives_test.fs → src/Cashel.Tests/ListPrimitivesTest.fs
@@ -1,4 +1,4 @@
-module PrimitivesTest
+module ListPrimitivesTest
let (!!) str = List.ofSeq str
@@ -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 () =
@@ -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 () =
@@ -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 () =
View
0 src/Cashel.Tests/parser_test.fs → src/Cashel.Tests/ParserTest.fs
File renamed without changes.
View
2 src/Cashel.Tests/peg2_test.fs → src/Cashel.Tests/Peg2Test.fs
@@ -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 () =
View
2 src/Cashel.Tests/peg_test.fs → src/Cashel.Tests/PegTest.fs
@@ -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 () =
View
46 src/Cashel/ArraySegmentPrimitives.fs
@@ -0,0 +1,46 @@
+namespace Cashel
+
+module ArraySegmentPrimitives =
+ 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
+
+ ///eof checks that we're at the end of the list being parsed
+ let eof : Parser<ArraySegment<'a>, unit> = fun input ->
+ 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 =
+ 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])
+
+
View
1 src/Cashel/Cashel.fsproj
@@ -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>
View
19 src/Cashel/parser.fs
@@ -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')))
+
View
5 src/Cashel/primitives.fs
@@ -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)
@@ -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 [])

0 comments on commit 1d6da26

Please sign in to comment.