Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

refactor parsing primitives

  • Loading branch information...
commit 531188d634ee61868f556383d9cdd500735a5786 1 parent 4e24fad
@devhawk authored
View
20 Cashel/Cashel.Tests/primitives.test.fs
@@ -135,3 +135,23 @@ let test_ignore_right () =
[<Fact>]
let test_ignore_right_fails () =
((item_equal 't') >>. (item_equal 's')) !!"test" |> should equal None
+
+[<Fact>]
+let test_parse_return_value () =
+ ((item_equal 't') >>$ "hello") !!"test" |> should equal (Some("hello", !!"est"))
+
+[<Fact>]
+let test_parse_return_value_fails () =
+ ((item_equal 'q') >>$ "hello") !!"test" |> should equal None
+
+[<Fact>]
+let test_repeat_until () =
+ (repeat_until item (item_equal 's')) !!"test" |> should equal (Some(!!"te", !!"t"))
+
+[<Fact>]
+let test_repeat_until_fail_1 () =
+ (repeat_until item (item_equal 'q')) !!"test" |> should equal None
+
+[<Fact>]
+let test_repeat_until_fail_2 () =
+ (repeat_until (item_equal 'q') (item_equal 's')) !!"test" |> should equal None
View
123 Cashel/Cashel/peg.fs
@@ -146,14 +146,12 @@ type Definition =
open DevHawk.Parser.Core
open DevHawk.Parser.Primitives
-let S2L s = List.of_seq s
-
///EndOfFile <- !.
let EndOfFile = eof
///EndOfLine <- '\r\n' / '\n' / '\r'
let EndOfLine = parse {
- return! items_equal (S2L "\r\n")
+ return! items_equal (List.of_seq "\r\n")
return! item_equal '\n' |> listify
return! item_equal '\r' |> listify }
@@ -165,11 +163,8 @@ let Space = parse {
///Comment <- '#' (!EndOfLine .)* EndOfLine
let Comment = parse {
- do! item_equal '#' |> ignore
- let! c = parse {
- do! !~ EndOfLine
- return! item} |> repeat
- do! EndOfLine |> ignore
+ do! skip_item '#'
+ let! c = repeat_until item EndOfLine
return c }
///Spacing <- (Space / Comment)*
@@ -205,14 +200,14 @@ let OPEN = item_equal '(' .>> Spacing
let CLOSE = item_equal ')' .>> Spacing
///LEFTARROW <- '<-' Spacing
-let LEFTARROW = items_equal (S2L "<-") .>> Spacing
+let LEFTARROW = items_equal (List.of_seq "<-") .>> Spacing
///Char <- '\\' [nrt'""\[\]\\] / '\\' [0-2][0-7][0-7] / '\\' [0-7][0-7]? / !'\\' .
let Char =
let c2i c = Char.code c - Char.code '0'
parse {
- do! item_equal '\\' |> ignore
+ do! skip_item '\\'
let! c = any_of ['n';'r';'t';'''; '"'; '['; ']'; '\\']
match c with
| 'n' -> return '\n'
@@ -221,14 +216,14 @@ let Char =
| _ -> return c }
+++
parse {
- do! item_equal '\\' |> ignore
+ do! skip_item '\\'
let! c1 = any_of ['0'..'2']
let! c2 = any_of ['0'..'7']
let! c3 = any_of ['0'..'7']
return Char.chr ((c2i c1)*64 + (c2i c2)*8 + (c2i c3)) }
+++
parse {
- do! item_equal '\\' |> ignore
+ do! skip_item '\\'
let! c1 = any_of ['0'..'7']
let! c2 = !? (any_of ['0'..'7'])
match c2 with
@@ -239,13 +234,11 @@ let Char =
do! !~ (item_equal '\\')
return! item }
-
-
///Range <- Char '-' Char / Char
let Range =
parse {
let! c1 = Char
- do! item_equal '-' |> ignore
+ do! skip_item '-'
let! c2 = Char
return Dual(c1, c2) }
+++
@@ -256,24 +249,18 @@ let Range =
///Class <- '[' (!']' Range)* ']' Spacing
let Class =
parse {
- do! item_equal '[' |> ignore
- let! rl = parse {
- do! !~ (item_equal ']')
- return! Range } |> repeat
- do! item_equal ']' |> ignore
- do! Spacing |> ignore
+ do! skip_item '['
+ let! rl = repeat_until Range (item_equal ']')
+ do! ignore Spacing
return rl
}
///Literal <- ['] (!['] Char)* ['] Spacing / ["] (!["] Char)* [""] Spacing
let Literal =
let literal_workhorse ch = parse {
- do! item_equal ch |> ignore
- let! cl = parse {
- do! !~ (item_equal ch)
- return! Char } |> repeat
- do! item_equal ch |> ignore
- do! Spacing |> ignore
+ do! skip_item ch
+ let! cl = repeat_until Char (item_equal ch)
+ do! ignore Spacing
return cl }
literal_workhorse ''' +++ literal_workhorse '"'
@@ -287,8 +274,8 @@ let Identifier =
parse {
let! c = IdentStart
- let! cs = IdentCont |> repeat
- do! Spacing |> ignore
+ let! cs = repeat IdentCont
+ do! ignore Spacing
return c::cs }
@@ -296,78 +283,56 @@ let Identifier =
//Had to name this method pPrimary to avoid conflict with Primary discriminated union
let rec pPrimary =
parse {
- return! parse {
- let! id = Identifier
- do! !~ LEFTARROW
- return Primary.Identifier(id) }
- return! parse {
- do! OPEN |> ignore
- let! exp = Expression
- do! CLOSE |> ignore
- return Primary.Expression(exp) }
- return! parse {
- let! lit = Literal
- return Primary.Literal(lit) }
- return! parse {
- let! cls = Class
- return Primary.Class(cls) }
- return! parse {
- do! DOT |> ignore
- return Dot } }
-
+ let! id = Identifier
+ do! !~ LEFTARROW
+ return Primary.Identifier(id) }
+ +++
+ parse {
+ do! ignore OPEN
+ let! exp = Expression
+ do! ignore CLOSE
+ return Primary.Expression(exp) }
+ +++
+ parse {
+ let! lit = Literal
+ return Primary.Literal(lit) }
+ +++
+ parse {
+ let! cls = Class
+ return Primary.Class(cls) }
+ +++
+ (DOT >>$ Dot)
+
///SequenceItem <- (AND / NOT)? Primary (QUESTION / STAR / PLUS)?
and SequenceItem =
- let prefix =
- parse {
- do! AND |> ignore
- return Prefix.And }
- +++
- parse {
- do! NOT |> ignore
- return Prefix.Not }
- let suffix =
- parse {
- do! QUESTION |> ignore
- return Suffix.Question }
- +++
- parse {
- do! STAR |> ignore
- return Suffix.Star }
- +++
- parse {
- do! PLUS |> ignore
- return Suffix.Plus }
-
+ let prefix = (AND >>$ Prefix.And) +++ (NOT >>$ Prefix.Not)
+ let suffix = (QUESTION >>$ Suffix.Question) +++ (STAR >>$ Suffix.Star) +++ (PLUS >>$ Suffix.Plus)
parse {
let! pre = !? prefix
let! pri = pPrimary
let! suf = !? suffix
- return {primaryItem=pri;itemPrefix=pre;itemSuffix=suf}
- }
+ return {primaryItem=pri;itemPrefix=pre;itemSuffix=suf} }
///Sequence <- SequenceItem*
-and Sequence = SequenceItem |> repeat
+and Sequence = repeat SequenceItem
///Expression <- Sequence (SLASH Sequence)*
and Expression =
parse {
let! s = Sequence
- let! sl = parse {
- do! SLASH |> ignore
- return! Sequence } |> repeat
- return s::sl
- }
+ let! sl = repeat (SLASH >>. Sequence)
+ return s::sl }
///Definition <- Identifier LEFTARROW Expression
let Definition =
parse {
let! id = Identifier
- do! LEFTARROW |> ignore
+ do! ignore LEFTARROW
let! ex = Expression
return {name=id;exp=ex} }
///Grammar <- Spacing Definition+ EndOfFile
-let Grammar = Spacing >>. (Definition |> repeat1) .>> EndOfFile
+let Grammar = Spacing >>. repeat1 Definition .>> EndOfFile
View
121 Cashel/Cashel/primitives.fs
@@ -6,94 +6,85 @@ module Primitives
open DevHawk.Parser.Core
-//let (!!) s = List.of_seq s
+///Custom bind operator >>$ binds parser p to result v, ignoring the return value of p
+let (>>$) p v = p >>= (fun _ -> result v)
+///Custom bind operator .>> binds p1 to p2, then returns the parse value of p1
+let (.>>) p1 p2 = p1 >>= (fun v -> p2 >>= (fun _ -> result v))
+
+///Custom bind operator .>> binds p1 to p2, then returns the parse value of p2
+let (>>.) p1 p2 = p1 >>= (fun _ -> p2 >>= (fun v -> result v))
-//item assumes the input is a list and returns a tuple of the head and tail
-let item =
- fun input ->
- match input with
- | x::xs -> Some(x,xs)
- | [] -> None
-
-//ignore tosses the result of parsing function p
-let ignore p = p >>= (fun x -> result ())
+///ignore tosses the result of parsing function p
+let ignore p = p >>$ ()
-//listify turns the result of parsing function p into a single item list
+///listify turns the result of parsing function p into a single item list
let listify p = p >>= (fun x -> result [x])
-//satisfy checks the value returned from item against the predicate function p
-let satisfy parser pred =
- parse {
- let! x = parser
- if pred x then return x }
-
-
-//any_of checks the value at the start of the input is in the list of items l
-let any_of l = satisfy item (fun x -> List.exists (fun y -> x = y) l)
-
-//item_equal checks the value at the start of the input matches the value v
-let item_equal v = satisfy item (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 items_equal l =
- match l with
- | [] -> result []
- | x::xs -> parse {
- let! i = item_equal x
- let! is = items_equal xs
- return i::is }
-
-//eof checks that we're at the end of the list being parsed
-let eof =
- fun input ->
- match input with
- | [] -> Some((), [])
- | _ -> None
-
-//repeat looks for zero or more instances of the parsing function p
-let rec repeat p =
- parse { return! repeat1 p
- return [] }
-
-//repeat looks for one or more instances of the parsing function p
-and repeat1 p =
- parse { let! x = p
- let! xs = repeat p
- return x::xs }
-
+///satisfy checks the value returned from item against the predicate function p
+let satisfy parser pred = parser >>= (fun x -> if pred 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 [])
-//Success Predicate
+///repeat1 looks for one or more instances of the parsing function p
+and repeat1 p = p >>= (fun x -> repeat p >>= (fun xs -> result (x::xs)))
+
+///Success Predicate
let (!&) f =
fun input ->
match f input with
| Some(_) -> Some((),input)
| None -> None
-//Failure Predicate
+///Failure Predicate
let (!~) f =
fun input ->
match f input with
| None -> Some((),input)
| Some(_) -> None
-//Option Predicate
+///Option Predicate
let (!?) f =
fun input ->
match f input with
| Some(v,input') -> Some(Some(v),input')
| None -> Some(None, input)
-
-//.>> parses both p1 and p2, but only returns the value of p1
-let (.>>) p1 p2 = parse {
- let! x = p1
- do! p2 |> ignore
- return x }
+
+///repeat_until calls p1 repeatedly until p2 succeeds
+let repeat_until p1 p2 = repeat (!~ p2 >>. p1) .>> p2
-//.>> parses both p1 and p2, but only returns the value of p2
-let (>>.) p1 p2 = parse {
- do! p1 |> ignore
- let! x = p2
- return x }
+
+//-------------------------List primitives-------------------------------------------
+///item assumes the input is a list and returns a tuple of the head and tail
+let item =
+ fun input ->
+ match input with
+ | x::xs -> Some(x,xs)
+ | [] -> None
+
+///eof checks that we're at the end of the list being parsed
+let eof =
+ fun input ->
+ match input with
+ | [] -> Some((), [])
+ | _ -> None
+
+///any_of checks the value at the start of the input is in the list of items l
+let any_of l = satisfy item (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 item_equal v = satisfy item (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 items_equal l =
+ match l with
+ | [] -> result []
+ | x::xs -> item_equal x >>= (fun i -> items_equal xs >>= (fun is -> result (i::is)))
+
+///skip_item calls item_equal but tosses the parse value
+let skip_item v = item_equal v |> ignore
+
+///skip_items calls items_equal but tosses the parse value
+let skip_items l = items_equal l |> ignore
Please sign in to comment.
Something went wrong with that request. Please try again.