Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

General Housekeeping (more tests, added ToString overrides, changed n…

…ames of parsing functions to start with underscore)
  • Loading branch information...
commit 48370dbd62f47cb4b56852e4aba458d3746a1452 1 parent e14f62c
@devhawk authored
Showing with 272 additions and 173 deletions.
  1. +158 −123 Cashel/Cashel.Tests/peg2.test.fs
  2. +114 −50 Cashel/Cashel/peg2.fs
View
281 Cashel/Cashel.Tests/peg2.test.fs
@@ -6,303 +6,342 @@ let chr = Char.chr
open Xunit
open FsxUnit.Syntax
-
open DevHawk.Parser.Peg2
+let (>|>) act exp =
+ match exp with
+ | None -> act |> should equal exp
+ | Some(expV, expT) ->
+ match act with
+ | Some(actV, actT) ->
+ actV |> should equal expV
+ let expT' = new System.String(List.to_array expT)
+ let actT' = new System.String(List.to_array actT)
+ actT' |> should equal expT'
+ | _ -> act |> should equal exp
+
+
[<Fact>]
let test_EndOfLine_with_slashr_slashn () =
let exp = Some(!!"\r\n",!!"test")
- EndOfLine !!"\r\ntest" |> should equal exp
+ _EndOfLine !!"\r\ntest" >|> exp
[<Fact>]
let test_EndOfLine_with_slashr () =
let exp = Some(!!"\r",!!"test")
- EndOfLine !!"\rtest" |> should equal exp
+ _EndOfLine !!"\rtest" >|> exp
[<Fact>]
let test_EndOfLine_with_slashn () =
let exp = Some(!!"\n",!!"test")
- EndOfLine !!"\ntest" |> should equal exp
+ _EndOfLine !!"\ntest" >|> exp
[<Fact>]
let test_EndOfLine_with_no_slash () =
- EndOfLine !!"test" |> should equal None
+ _EndOfLine !!"test" >|> None
[<Fact>]
let test_EndOfLine_with_slashn_slashr () =
let exp = Some(!!"\n",!!"\rtest")
- EndOfLine !!"\n\rtest" |> should equal exp
+ _EndOfLine !!"\n\rtest" >|> exp
[<Fact>]
let test_Space_with_space () =
let exp = Some(!!" ",!!"test")
- Space !!" test" |> should equal exp
+ _Space !!" test" >|> exp
[<Fact>]
let test_Space_with_slasht () =
let exp = Some(!!"\t",!!"test")
- Space !!"\ttest" |> should equal exp
+ _Space !!"\ttest" >|> exp
[<Fact>]
let test_Space_with_eol () =
let exp = Some(!!"\r\n",!!"test")
- Space !!"\r\ntest" |> should equal exp
+ _Space !!"\r\ntest" >|> exp
[<Fact>]
let test_Comment () =
- let exp = Some(!!"test comment",!!"more text")
- Comment !!"#test comment\r\nmore text" |> should equal exp
+ let exp = Some(!!"test _Comment",!!"more text")
+ _Comment !!"#test _Comment\r\nmore text" >|> exp
[<Fact>]
let test_Comment_not_comment () =
- Comment !!"test comment\r\nmore text" |> should equal None
+ _Comment !!"test _Comment\r\nmore text" >|> None
[<Fact>]
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"))
[<Fact>]
let test_Spacing_with_comment () =
- let exp = Some([!!"test comment"],!!"more text")
- Spacing !!"#test comment\r\nmore text" |> should equal exp
+ let exp = Some([!!"test _Comment"],!!"more text")
+ _Spacing !!"#test _Comment\r\nmore text" >|> exp
[<Fact>]
let test_Spacing_with_space () =
let exp = Some([!!" "],!!"more text")
- Spacing !!" more text" |> should equal exp
+ _Spacing !!" more text" >|> exp
[<Fact>]
let test_Spacing_with_comment_and_space () =
- let exp = Some([!!" ";!!"test comment"],!!"more text")
- Spacing !!" #test comment\r\nmore text" |> should equal exp
+ let exp = Some([!!" ";!!"test _Comment"],!!"more text")
+ _Spacing !!" #test _Comment\r\nmore text" >|> exp
[<Fact>]
let test_Spacing_with_space_and_comment () =
- let exp = Some([!!"test comment";[' '];[' '];[' '];[' ']],!!"more text")
- let act = Spacing !!"#test comment\r\n more text"
- act |> should equal exp
+ let exp = Some([!!"test _Comment";[' '];[' '];[' '];[' ']],!!"more text")
+ let act = _Spacing !!"#test _Comment\r\n more text"
+ act >|> exp
[<Fact>]
-let test_dot () = DOT !!".test" |> should equal (Some('.', !!"test"))
+let test_dot () = _DOT !!".test" >|> (Some('.', !!"test"))
[<Fact>]
-let test_dot_with_space () = DOT !!". \t test" |> should equal (Some('.', !!"test"))
+let test_dot_with_space () = _DOT !!". \t test" >|> (Some('.', !!"test"))
[<Fact>]
-let test_dot_with_slasht () = DOT !!".\test" |> should equal (Some('.', !!"est"))
+let test_dot_with_slasht () = _DOT !!".\test" >|> (Some('.', !!"est"))
[<Fact>]
-let test_dot_fail () = DOT !!"test" |> should equal None
+let test_dot_fail () = _DOT !!"test" >|> None
[<Fact>]
-let test_slash () = SLASH !!"/test" |> should equal (Some('/', !!"test"))
+let test_slash () = _SLASH !!"/test" >|> (Some('/', !!"test"))
[<Fact>]
-let test_slash_fail () = SLASH !!"test" |> should equal None
+let test_slash_fail () = _SLASH !!"test" >|> None
[<Fact>]
let test_LEFTARROW () =
let exp = Some(!!"<-",!!"more text")
- LEFTARROW !!"<-more text" |> should equal exp
+ _LEFTARROW !!"<-more text" >|> exp
[<Fact>]
let test_LEFTARROW_with_space () =
let exp = Some(!!"<-",!!"more text")
- LEFTARROW !!"<-\r\nmore text" |> should equal exp
+ _LEFTARROW !!"<-\r\nmore text" >|> exp
[<Fact>]
let test_LEFTARROW_fail () =
- LEFTARROW !!"q<-more text" |> should equal None
+ _LEFTARROW !!"q<-more text" >|> None
[<Fact>]
let test_Char_with_slashn () =
let exp = Some('\n', !!"test")
- _Char !! @"\ntest" |> should equal exp
+ _Char !! @"\ntest" >|> exp
[<Fact>]
let test_Char_with_slashr () =
let exp = Some('\r', !!"test")
- _Char !! @"\rtest" |> should equal exp
+ _Char !! @"\rtest" >|> exp
[<Fact>]
let test_Char_with_slasht () =
let exp = Some('\t', !!"test")
- _Char !! @"\ttest" |> should equal exp
+ _Char !! @"\ttest" >|> exp
[<Fact>]
let test_Char_with_slash () =
let exp = Some('\\', !!"test")
- _Char !! @"\\test" |> should equal exp
+ _Char !! @"\\test" >|> exp
[<Fact>]
let test_Char_with_no_slash () =
let exp = Some('t', !!"est")
- let act = _Char !! "test"
- act |> should equal exp
+ _Char !! "test" >|> exp
[<Fact>]
let test_Char_with_unicode_specification_0000 () =
let exp = Some((chr 0x0000), !!"test")
- _Char !! @"\u0000test" |> should equal exp
+ _Char !! @"\u0000test" >|> exp
[<Fact>]
let test_Char_with_unicode_specification_abcd () =
let exp = Some((chr 0xabcd), !!"test")
- _Char !! @"\uabcdtest" |> should equal exp
+ _Char !! @"\uabcdtest" >|> exp
[<Fact>]
let test_Char_with_unicode_specification_ABCD () =
let exp = Some((chr 0xABCD), !!"test")
- _Char !! @"\uABCDtest" |> should equal exp
+ _Char !! @"\uABCDtest" >|> exp
[<Fact>]
let test_Range_single () =
let exp = Some(Single('t'), !!"est")
- _Range !! "test" |> should equal exp
+ _Range !! "test" >|> exp
[<Fact>]
let test_Range_dual () =
let exp = Some(Dual('t', 'e'), !!"st")
- _Range !! "t-est" |> should equal exp
+ _Range !! "t-est" >|> exp
[<Fact>]
let test_Range_dual_fail_back_to_single () =
let exp = Some(Single('t'), !!"-\\st")
- _Range !! "t-\\st" |> should equal exp
+ _Range !! "t-\\st" >|> exp
[<Fact>]
let test_Range_single_fail () =
- _Range !! "\\st" |> should equal None
+ _Range !! "\\st" >|> None
[<Fact>]
let test_Class_single () =
- _Class !! "[a]test" |> should equal (Some([Single('a')], !!"test"))
+ _Class !! "[a]test" >|> (Some([Single('a')], !!"test"))
[<Fact>]
let test_Class_single_spacing () =
- _Class !! "[a]\t\ttest" |> should equal (Some([Single('a')], !!"test"))
+ _Class !! "[a]\t\ttest" >|> (Some([Single('a')], !!"test"))
[<Fact>]
let test_Class_single_range () =
- _Class !! "[a-z]test" |> should equal (Some([Dual('a', 'z')], !!"test"))
+ _Class !! "[a-z]test" >|> (Some([Dual('a', 'z')], !!"test"))
[<Fact>]
let test_Class_multiple () =
- _Class !! "[ab-z]test" |> should equal (Some([Single('a');Dual('b','z')], !!"test"))
+ _Class !! "[ab-z]test" >|> (Some([Single('a');Dual('b','z')], !!"test"))
[<Fact>]
let test_Class_failure_no_end_bracket () =
- _Class !! "[ab-ztest" |> should equal None
+ _Class !! "[ab-ztest" >|> None
[<Fact>]
let test_Class_failure () =
- _Class !! "ab-z]test" |> should equal None
+ _Class !! "ab-z]test" >|> None
[<Fact>]
let test_Literal_single_quote () =
- _Literal !! "'test' me" |> should equal (Some("test", !!"me"))
+ _Literal !! "'test' me" >|> (Some("test", !!"me"))
[<Fact>]
let test_Literal_double_quote () =
- _Literal !! "\"test\" me" |> should equal (Some("test", !!"me"))
+ _Literal !! "\"test\" me" >|> (Some("test", !!"me"))
[<Fact>]
let test_Literal_no_end_quote () =
- _Literal !! "\"test me" |> should equal None
+ _Literal !! "\"test me" >|> None
[<Fact>]
let test_Identifier () =
- _Identifier !! "tE_s9t me" |> should equal (Some("tE_s9t", !!"me"))
+ _Identifier !! "tE_s9t me" >|> (Some("tE_s9t", !!"me"))
[<Fact>]
let test_Identifier_start_with_underscore () =
- _Identifier !! "_9test me" |> should equal (Some("_9test", !!"me"))
+ _Identifier !! "_9test me" >|> (Some("_9test", !!"me"))
[<Fact>]
let test_Identifier_fail_start_with_number () =
- _Identifier !! "9test me" |> should equal None
+ _Identifier !! "9test me" >|> None
[<Fact>]
let test_Primary_Identifier () =
- _Primary !!"test me" |> should equal (Some(Identifier("test"), !!"me"))
+ _Primary !!"test me" >|> (Some(Identifier("test"), !!"me"))
[<Fact>]
let test_Primary_Literal () =
- _Primary !!"'test' me" |> should equal (Some(Literal("test"), !!"me"))
+ _Primary !!"'test' me" >|> (Some(Literal("test"), !!"me"))
[<Fact>]
let test_Primary_class () =
let exp = Some(Class([Dual('t','v');Single('z')]), !!"st me")
- _Primary !!"[t-vz] st me" |> should equal exp
+ _Primary !!"[t-vz] st me" >|> exp
+
+[<Fact>]
+let test_Primary_production () =
+ let pl = [{item=Identifier("test");prefix=None;arity=None};{item=Identifier("me");prefix=None;arity=None};{item=Identifier("now");prefix=None;arity=None}]
+ let prod = Production({pattern=pl; action=Some("action3")})
+ let exp = Some(prod, !!"more testing")
+ _Primary !!"(test me now => action3)? more testing" >|> Some(prod, !!"? more testing")
-//TODO - test primary produciton
+
[<Fact>]
let test_Primary_dot () =
- _Primary !!".\test me" |> should equal (Some(Primary.Dot, !!"est me"))
+ _Primary !!".\test me" >|> (Some(Dot, !!"est me"))
+[<Fact>]
+let test_Primary_dot_extra_debug () =
+ let input = !!".\test me"
+ let exp = (Some(Dot, !!"est me"))
+ let act = _Primary input
+ try
+ act >|> exp
+ with ex ->
+ let Some(ev, et) = exp
+ let Some(av, at) = act
+ let msg = sprintf "\ninput:\n%O \nExpected value:\n%O (%s) \nActual value:\n%O (%s)" (new System.String(List.to_array input)) ev (new System.String(List.to_array et)) av (new System.String(List.to_array at))
+ Assert.False(true, msg)
+
[<Fact>]
let test_PatternItem () =
let exp = Some({item=Identifier("test");prefix=None;arity=None}, !!"me")
- _PatternItem !!"test me" |> should equal exp
+ _PatternItem !!"test me" >|> exp
+
+[<Fact>]
+let test_patternitem_production () =
+ let pl = [{item=Identifier("test");prefix=None;arity=None};{item=Identifier("me");prefix=None;arity=None};{item=Identifier("now");prefix=None;arity=None}]
+ let prod = Production({pattern=pl; action=Some("action3")})
+ let pi = {item=prod;prefix=Some(Variable("s"));arity=Some(ZeroOrOne)}
+ _PatternItem !!"s:(test me now => action3)? more testing" >|> Some(pi, !!"more testing")
+
[<Fact>]
let test_PatternItem_plus_suffix () =
let exp = Some({item=Identifier("test");prefix=None;arity=Some(OneOrMore)}, !!"me")
- _PatternItem !!"test+ me" |> should equal exp
+ _PatternItem !!"test+ me" >|> exp
[<Fact>]
let test_PatternItem_star_suffix () =
let exp = Some({item=Identifier("test");prefix=None;arity=Some(ZeroOrMore)}, !!"me")
- _PatternItem !!"test* me" |> should equal exp
+ _PatternItem !!"test* me" >|> exp
[<Fact>]
let test_PatternItem_question_suffix () =
let exp = Some({item=Identifier("test");prefix=None;arity=Some(ZeroOrOne)}, !!"me")
- _PatternItem !!"test? me" |> should equal exp
+ _PatternItem !!"test? me" >|> exp
[<Fact>]
let test_PatternItem_and_prefix () =
let exp = Some({item=Identifier("test");prefix=Some(SuccessPredicate);arity=None}, !!"me")
- _PatternItem !!"&test me" |> should equal exp
+ _PatternItem !!"&test me" >|> exp
[<Fact>]
let test_PatternItem_bang_prefix () =
let exp = Some({item=Identifier("test");prefix=Some(FailurePredicate);arity=None}, !!"me")
- _PatternItem !!"!test me" |> should equal exp
+ _PatternItem !!"!test me" >|> exp
[<Fact>]
let test_PatternItem_variable_prefix () =
let exp = Some({item=Identifier("test");prefix=Some(Variable("qa"));arity=None}, !!"me")
- _PatternItem !!"qa:test me" |> should equal exp
+ _PatternItem !!"qa:test me" >|> exp
[<Fact>]
let test_PatternItem_variable_prefix_star_suffix () =
let exp = Some({item=Identifier("test");prefix=Some(Variable("qa"));arity=Some(ZeroOrMore)}, !!"me")
- _PatternItem !!"qa:test* me" |> should equal exp
+ _PatternItem !!"qa:test* me" >|> exp
[<Fact>]
let test_Production_one_pattern_item_no_action () =
let exp = Some({pattern=[{item=Identifier("test");prefix=None;arity=None}]; action=None}, !!"/")
- _Production !!"test /" |> should equal exp
+ _Production !!"test /" >|> exp
[<Fact>]
let test_Production_three_pattern_items_no_action () =
let pl = [{item=Identifier("test");prefix=None;arity=None};{item=Identifier("me");prefix=None;arity=None};{item=Identifier("now");prefix=None;arity=None}]
let exp = Some({pattern=pl; action=None}, !!"/")
- _Production !!"test me now/" |> should equal exp
+ _Production !!"test me now/" >|> exp
[<Fact>]
let test_Production_one_pattern_item_with_action () =
let exp = Some({pattern=[{item=Identifier("test");prefix=None;arity=None}]; action=Some("action")}, !!"/")
- _Production !!"test => action/" |> should equal exp
+ _Production !!"test => action/" >|> exp
[<Fact>]
let test_Production_three_pattern_items_with_action () =
let pl = [{item=Identifier("test");prefix=None;arity=None};{item=Identifier("me");prefix=None;arity=None};{item=Identifier("now");prefix=None;arity=None}]
let exp = Some({pattern=pl; action=Some("action")}, !!"/")
- _Production !!"test me now => action/" |> should equal exp
+ _Production !!"test me now => action/" >|> exp
[<Fact>]
let test_Rule_one_production () =
@@ -311,7 +350,7 @@ let test_Rule_one_production () =
let exprule = {name="rulename";productions=[prod]}
let exp = Some(exprule, !!"foobar")
let act = _Rule !!"rulename <- test me now ; foobar"
- act |> should equal exp
+ act >|> exp
[<Fact>]
let test_Rule_two_productions () =
@@ -320,7 +359,7 @@ let test_Rule_two_productions () =
let exprule = {name="rulename";productions=[prod1;prod2]}
let exp = Some(exprule, !!"foobar")
let act = _Rule !!"rulename <- test me now / another test; foobar"
- act |> should equal exp
+ act >|> exp
[<Fact>]
let test_Rule_one_production_with_action () =
@@ -329,7 +368,7 @@ let test_Rule_one_production_with_action () =
let exprule = {name="rulename";productions=[prod]}
let exp = Some(exprule, !!"foobar")
let act = _Rule !!"rulename <- test me now => Action; foobar"
- act |> should equal exp
+ act >|> exp
[<Fact>]
let test_Rule_two_productions_with_actions () =
@@ -338,51 +377,47 @@ let test_Rule_two_productions_with_actions () =
let exprule = {name="rulename";productions=[prod1;prod2]}
let exp = Some(exprule, !!"foobar")
let act = _Rule !!"rulename <- test me now => Action1/ another test => Action2; foobar"
- act |> should equal exp
-
-
-(*[<Fact>]
-let test_PEG_grammar () =
- let peg_grammar = !! @"
-
-# Hierarchical syntax
-Grammar <- Spacing Definition+ EndOfFile
-Definition <- Identifier LEFTARROW Expression
-Expression <- Sequence (SLASH Sequence)*
-Sequence <- Prefix*
-Prefix <- (AND / NOT)? arity
-arity <- Primary (QUESTION / STAR / PLUS)?
-Primary <- Identifier !LEFTARROW / OPEN Expression CLOSE / Literal / Class / DOT
-
-# Lexical syntax
-Identifier <- IdentStart IdentCont* Spacing
-IdentStart <- [a-zA-Z_]
-IdentCont <- IdentStart / [0-9]
-
-Literal <- ['] (!['] _Char)* ['] Spacing / [""] (![""] _Char)* [""] Spacing
-Class <- '[' (!']' _Range)* ']' Spacing
-_Range <- _Char '-' _Char / _Char
-_Char <- '\\' [nrt'""\[\]\\] / '\\' [0-2][0-7][0-7] / '\\' [0-7][0-7]? / !'\\' .
-
-LEFTARROW <- '<-' Spacing
-SLASH <- '/' Spacing
-AND <- '&' Spacing
-NOT <- '!' Spacing
-QUESTION <- '?' Spacing
-STAR <- '*' Spacing
-PLUS <- '+' Spacing
-OPEN <- '(' Spacing
-CLOSE <- ')' Spacing
-DOT <- '.' Spacing
-
-Spacing <- (Space / Comment)*
-Comment <- '#' (!EndOfLine .)* EndOfLine
-Space <- ' ' / '\t' / EndOfLine
-EndOfLine <- '\r\n' / '\n' / '\r'
-EndOfFile <- !."
-
- let Some(defs, cl) = peg_grammar |> Grammar
- defs |> List.length |> should equal 29
- cl |> should equal []*)
-
-
+ act >|> exp
+
+[<Fact>]
+let test_sample_grammar () =
+ let grammar = !! @"
+PEG2
+{
+ Grammar <- Spacing i:Identifier OCURLY r:Rule+ CCURLY EndOfFile => ir;
+ Rule <- i:Identifier LEFTARROW p1:Production p2:(SLASH p3:Production => p3)* SEMICOLON => ip1p2;
+ Production <- pi:PatternItem+ a:(RIGHTARROW a:Action => a)?;
+ Suffix <- QUESTION => ZeroOrOne / STAR => ZeroOrMore / PLUS => OneOrMore;
+ Prefix <- AND => SucessPred / NOT => FailPred / i:Identifier COLON => il;
+ PatternItem <- pre:Prefix? pri:Primary suf:Suffix? => pre_pri_suf;
+}
+
+"
+
+
+ let Some(g, cl) = _Grammar grammar
+ let {name=id; rules=rl} = g
+ Assert.Equal("PEG2", id)
+ Assert.Equal(6, (List.length rl))
+ Assert.Equal([], cl)
+
+[<Fact>]
+let test_parse () =
+ let input = @"
+PEG2
+{
+ Grammar <- Spacing i:Identifier OCURLY r:Rule+ CCURLY EndOfFile => ir;
+ Rule <- i:Identifier LEFTARROW p1:Production p2:(SLASH p3:Production => p3)* SEMICOLON => ip1p2;
+ Production <- pi:PatternItem+ a:(RIGHTARROW a:Action => a)?;
+ Suffix <- QUESTION => ZeroOrOne / STAR => ZeroOrMore / PLUS => OneOrMore;
+ Prefix <- AND => SucessPred / NOT => FailPred / i:Identifier COLON => il;
+ PatternItem <- pre:Prefix? pri:Primary suf:Suffix? => pre_pri_suf;
+}
+
+"
+
+
+ let Some(g) = Parse input
+ let {name=id; rules=rl} = g
+ Assert.Equal("PEG2", id)
+ Assert.Equal(6, (List.length rl))
View
164 Cashel/Cashel/peg2.fs
@@ -54,7 +54,6 @@ EndOfFile <- !.
namespace DevHawk.Parser
-
module Peg2
//---------------------------------------------------------------------------------------------
@@ -64,6 +63,7 @@ let List2String cl =
let sb = cl |> List.fold_left (fun (s:System.Text.StringBuilder) (c : char) -> s.Append(c)) (new System.Text.StringBuilder())
sb.ToString()
+let ListFoldString l = l |> List.fold_left (fun s p -> sprintf "%s %O" s p) ""
//---------------------------------------------------------------------------------------------
//AST Types
@@ -71,17 +71,34 @@ let List2String cl =
type Range =
| Single of char
| Dual of char * char
-
+ with
+ override this.ToString() =
+ match this with
+ | Single x -> sprintf "Range.Single (%c)" x
+ | Dual (x,y) -> sprintf "Range.Dual (%c,%c)" x y
+
type Arity =
| ZeroOrOne
| ZeroOrMore
| OneOrMore
-
+ with
+ override this.ToString() =
+ match this with
+ | ZeroOrOne -> sprintf "Arity.ZeroOrOne"
+ | ZeroOrMore -> sprintf "Arity.ZeroOrMore"
+ | OneOrMore -> sprintf "Arity.OneOrMore"
+
type Prefix =
| SuccessPredicate
| FailurePredicate
| Variable of string
-
+ with
+ override this.ToString() =
+ match this with
+ | SuccessPredicate -> sprintf "Prefix.Success"
+ | FailurePredicate -> sprintf "Prefix.Failure"
+ | Variable s -> sprintf "Prefix.Var (%s)" s
+
///Action type not defined yet. Using string as a stub
type Action = string //TBD
@@ -93,6 +110,14 @@ type Primary =
| Literal of string
| Class of Range list
| Dot
+ with
+ override this.ToString() =
+ match this with
+ | Identifier s -> sprintf "Primary.Identifier(%s)" s
+ | Production p -> sprintf "Primary.Production %O" p
+ | Literal s -> sprintf "Primary.Literal(\"%s\")" s
+ | Class rl -> sprintf "Primary.Class(%s)" (ListFoldString rl)
+ | Dot -> sprintf "Primary.Dot"
///A PatternItem is a Primary with an optional prefix and/or optional suffix
and PatternItem =
@@ -101,13 +126,29 @@ and PatternItem =
prefix: Prefix option;
arity: Arity option;
}
-
+ with
+ override this.ToString() =
+ let sb = new System.Text.StringBuilder("PatternItem (")
+ if Option.is_some this.prefix then
+ sb.AppendFormat("{0} ", (Option.get this.prefix)) |> ignore
+ sb.Append(this.item) |> ignore
+ if Option.is_some this.arity then
+ sb.AppendFormat(" {0}", (Option.get this.arity)) |> ignore
+ sb.Append(')') |> ignore
+ sb.ToString()
+
///A Production is a list of Pattern Items and an assoicated optional Action
and Production =
{
pattern: PatternItem list;
action: Action option;
}
+ with
+ override this.ToString() =
+ let pil = ListFoldString this.pattern
+ if Option.is_some this.action
+ then sprintf "Production (Pattern: %s, Action: %s)" pil (Option.get this.action)
+ else sprintf "Production (Pattern: %s)" pil
///A Rule is a named list of Productions (in decending priority choice order)
type Rule =
@@ -115,6 +156,8 @@ type Rule =
name: string;
productions: Production list;
}
+ with
+ override this.ToString() = sprintf "Rule \"%s\" (%s)" this.name (ListFoldString this.productions)
///A Grammar is a named list of Rules
type Grammar =
@@ -122,6 +165,8 @@ type Grammar =
name: string;
rules: Rule list;
}
+ with
+ override this.ToString() = sprintf "Grammar \"%s\" (%s)" this.name (ListFoldString this.rules)
//---------------------------------------------------------------------------------------------
@@ -130,79 +175,79 @@ open DevHawk.Parser.Core
open DevHawk.Parser.Primitives
///EndOfLine <- '\r\n' / '\n' / '\r'
-let EndOfLine = parse {
+let _EndOfLine = parse {
return! items_equal (List.of_seq "\r\n")
return! item_equal '\n' |> listify
return! item_equal '\r' |> listify }
///Space <- ' ' / '\t' / EndOfLine
-let Space = parse {
+let _Space = parse {
return! item_equal ' ' |> listify
return! item_equal '\t' |> listify
- return! EndOfLine }
+ return! _EndOfLine }
///Comment <- '#' (!EndOfLine .)* EndOfLine
-let Comment = parse {
+let _Comment = parse {
do! skip_item '#'
- let! c = repeat_until item EndOfLine
+ let! c = repeat_until item _EndOfLine
return c }
///Spacing <- (Space / Comment)*
-let Spacing = parse {
- return! Space
- return! Comment } |> repeat
+let _Spacing = parse {
+ return! _Space
+ return! _Comment } |> repeat
///DOT <- '.' Spacing
-let DOT = item_equal '.' .>> Spacing
+let _DOT = item_equal '.' .>> _Spacing
///OPEN <- '(' Spacing
-let OPAREN = item_equal '(' .>> Spacing
+let _OPAREN = item_equal '(' .>> _Spacing
///CLOSE <- ')' Spacing
-let CPAREN = item_equal ')' .>> Spacing
+let _CPAREN = item_equal ')' .>> _Spacing
///AND <- '&' Spacing
-let AND = item_equal '&' .>> Spacing
+let _AND = item_equal '&' .>> _Spacing
///NOT <- '!' Spacing
-let NOT = item_equal '!' .>> Spacing
+let _NOT = item_equal '!' .>> _Spacing
///QUESTION <- '?' Spacing
-let QUESTION = item_equal '?' .>> Spacing
+let _QUESTION = item_equal '?' .>> _Spacing
///STAR <- '*' Spacing
-let STAR = item_equal '*' .>> Spacing
+let _STAR = item_equal '*' .>> _Spacing
///PLUS <- '+' Spacing
-let PLUS = item_equal '+' .>> Spacing
+let _PLUS = item_equal '+' .>> _Spacing
///COLON <- ':' Spacing
-let COLON = item_equal ':' .>> Spacing
+let _COLON = item_equal ':' .>> _Spacing
///COLON <- ':' Spacing
-let SEMICOLON = item_equal ';' .>> Spacing
+let _SEMICOLON = item_equal ';' .>> _Spacing
///RIGHTARROW <- '=>' Spacing
-let RIGHTARROW = items_equal (List.of_seq "=>") .>> Spacing
+let _RIGHTARROW = items_equal (List.of_seq "=>") .>> _Spacing
///SLASH <- '/' Spacing
-let SLASH = item_equal '/' .>> Spacing
+let _SLASH = item_equal '/' .>> _Spacing
///OPEN <- '(' Spacing
-let OCURLY = item_equal '{' .>> Spacing
+let _OCURLY = item_equal '{' .>> _Spacing
///CLOSE <- ')' Spacing
-let CCURLY = item_equal '}' .>> Spacing
+let _CCURLY = item_equal '}' .>> _Spacing
///LEFTARROW <- '<-' Spacing
-let LEFTARROW = items_equal (List.of_seq "<-") .>> Spacing
+let _LEFTARROW = items_equal (List.of_seq "<-") .>> _Spacing
///Char <- '\\' [nrt'""\[\]\\] / '\\u' [a-fA-F0-9] [a-fA-F0-9] [a-fA-F0-9] [a-fA-F0-9] / !'\\' .
let _Char =
///HexDigit <- [a-fA-F0-9]
- let HexDigit = any_of (['a'..'f'] @ ['A'..'F'] @ ['0'..'9'])
+ let _HexDigit = any_of (['a'..'f'] @ ['A'..'F'] @ ['0'..'9'])
let hex2int c =
let c = System.Char.ToUpper(c)
@@ -222,10 +267,10 @@ let _Char =
parse {
do! skip_item '\\'
do! skip_item 'u'
- let! h1 = HexDigit
- let! h2 = HexDigit
- let! h3 = HexDigit
- let! h4 = HexDigit
+ let! h1 = _HexDigit
+ let! h2 = _HexDigit
+ let! h3 = _HexDigit
+ let! h4 = _HexDigit
return Char.chr ((hex2int h1)*4096 + (hex2int h2)*256 + (hex2int h3)*16 + (hex2int h4)) }
+++
parse {
@@ -243,13 +288,13 @@ let _Range =
parse {
let! c1 = _Char
return Single(c1) }
-
+
///Class <- '[' (!']' Range)* ']' Spacing
let _Class =
parse {
do! skip_item '['
let! rl = repeat_until _Range (item_equal ']')
- do! ignore Spacing
+ do! ignore _Spacing
return rl
}
@@ -259,7 +304,7 @@ let _Literal =
parse {
do! skip_item ch
let! cl = repeat_until _Char (item_equal ch)
- do! ignore Spacing
+ do! ignore _Spacing
return List2String cl }
literal_workhorse ''' +++ literal_workhorse '"'
@@ -269,7 +314,7 @@ let _Identifier =
parse {
let! c = any_of (['_'] @ ['a'..'z'] @ ['A'..'Z'])
let! cs = repeat (any_of (['_'] @ ['a'..'z'] @ ['A'..'Z'] @ ['0'..'9']))
- do! ignore Spacing
+ do! ignore _Spacing
return List2String (c::cs) }
//Stub out Action for now
@@ -283,9 +328,9 @@ let rec _Primary =
return Identifier(id) }
+++
parse {
- do! ignore OPAREN
+ do! ignore _OPAREN
let! prod = _Production
- do! ignore CPAREN
+ do! ignore _CPAREN
return Production(prod) }
+++
parse {
@@ -296,15 +341,30 @@ let rec _Primary =
let! cls = _Class
return Class(cls) }
+++
- (DOT >>$ Primary.Dot)
+ (_DOT >>$ Dot )
///Suffix <- QUESTION / STAR / PLUS
///Prefix <- AND / NOT / Identifier COLON
///PatternItem <- Prefix? Primary Suffix?
and _PatternItem =
- let _Prefix = (AND >>$ SuccessPredicate) +++ (NOT >>$ FailurePredicate) +++ (_Identifier >>= (fun id -> COLON >>$ Variable(id)))
- let _Arity = (QUESTION >>$ ZeroOrOne) +++ (STAR >>$ ZeroOrMore) +++ (PLUS >>$ OneOrMore)
+ let _Prefix =
+ (_AND >>$ SuccessPredicate)
+ +++
+ (_NOT >>$ FailurePredicate)
+ +++
+ parse {
+ let! id = _Identifier
+ do! _COLON |> ignore
+ return Variable(id) }
+
+ let _Arity =
+ (_QUESTION >>$ ZeroOrOne)
+ +++
+ (_STAR >>$ ZeroOrMore)
+ +++
+ (_PLUS >>$ OneOrMore)
+
parse {
let! pre = !? _Prefix
let! pri = _Primary
@@ -315,28 +375,32 @@ and _PatternItem =
and _Production =
parse {
let! pl = repeat1 _PatternItem
- let! a = !? (RIGHTARROW >>. _Action)
+ let! a = !? (_RIGHTARROW >>. _Action)
return {pattern=pl; action=a} }
///Rule <- Identifier LEFTARROW Production (SLASH Production)* SEMICOLON
let _Rule =
parse {
let! id = _Identifier
- do! ignore LEFTARROW
+ do! ignore _LEFTARROW
let! p = _Production
- let! pl = repeat (SLASH >>. _Production)
- do! ignore SEMICOLON
+ let! pl = repeat (_SLASH >>. _Production)
+ do! ignore _SEMICOLON
return {name=id;productions=p::pl} }
///Grammar <- Spacing Identifier OCURLY Rule+ CCURLY EndOfFile
let _Grammar =
parse {
- do! ignore Spacing
+ do! ignore _Spacing
let! id = _Identifier
- do! ignore OCURLY
+ do! ignore _OCURLY
let! rl = repeat1 _Rule
- do! ignore CCURLY
+ do! ignore _CCURLY
do! eof
return {name=id; rules=rl} }
-
+let Parse (input:string) =
+ let g = _Grammar (List.of_seq input)
+ match g with
+ | Some(g, []) -> Some(g)
+ | _ -> None
Please sign in to comment.
Something went wrong with that request. Please try again.