Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Update to new Visual F# project system and v1.9.5.4 of F#

  • Loading branch information...
commit 1dd447ff6f597d01e91ed9af23d85ac932004c61 1 parent 48370db
@devhawk authored
View
9 .gitignore
@@ -1,4 +1,5 @@
-*.dll
-*.pdb
-*.exe
-*.suo
+old/*
+*.SCC
+*.suo
+*/*/bin/*
+*/*/obj/*
View
68 Cashel/Cashel.Tests/Cashel.Tests.fsharpp
@@ -1,68 +0,0 @@
-"General"
-{
-"ProjectIdGuid" = "{B07E7515-ABC3-4491-8EC0-BA4C8E6A6C3C}"
-}
-"Configurations"
-{
- "Debug|Win32"
- {
- "ProjectType" = "DLL"
- "OptLevel" = "Off"
- "StrongNamingLevel" = "None"
- "OutputPath" = ""
- "SearchPath" = "-R \"..\\..\\External\\xunit.dll\" -R \"..\\..\\External\\FsTest.dll\" -R \"D:\\HPierson.Files\\Projects\\Quinault\\Cashel\\Cashel\\cashel.dll\""
- "StrongNameFile" = ""
- "OutputBase" = ""
- "CustomCommandLine" = ""
- "CustomCompiler" = ""
- "DebugCheck" = "TRUE"
- "CustomCompilationCheck" = "FALSE"
- "DebugStartMode" = "0"
- "StartApp" = "D:\\HPierson.Files\\Projects\\Quinault\\External\\xunit.console.exe"
- "StartAppPath" = ""
- "CustomStartupArguments" = "cashel.tests.dll /wait "
- }
- "Release|Win32"
- {
- "ProjectType" = "DLL"
- "OptLevel" = "3"
- "StrongNamingLevel" = "None"
- "OutputPath" = ""
- "SearchPath" = "-I \"..\\..\\External\" -R \"xunit.dll\" -R \"FsUtil.dll\""
- "StrongNameFile" = ""
- "OutputBase" = ""
- "CustomCommandLine" = ""
- "CustomCompiler" = ""
- "DebugCheck" = "FALSE"
- "CustomCompilationCheck" = "FALSE"
- "DebugStartMode" = "0"
- "StartApp" = ""
- "StartAppPath" = ""
- "CustomStartupArguments" = ""
- }
-}
-"Files"
-{
- "parser.tests.fs"
- {
- "ProjRelPath" = "T"
- }
- "primitives.test.fs"
- {
- "ProjRelPath" = "T"
- }
- "peg.test.fs"
- {
- "ProjRelPath" = "T"
- }
- "peg2.test.fs"
- {
- "ProjRelPath" = "T"
- }
-}
-"ProjStartupServices"
-{
-}
-"Globals"
-{
-}
View
79 Cashel/Cashel.Tests/Cashel.Tests.fsproj
@@ -0,0 +1,79 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project ToolsVersion="3.5" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <PropertyGroup>
+ <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
+ <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
+ <ProductVersion>8.0.30703</ProductVersion>
+ <SchemaVersion>2.0</SchemaVersion>
+ <ProjectGuid>{25d2af80-078e-46a1-8ebb-01a905dbad48}</ProjectGuid>
+ <OutputType>Library</OutputType>
+ <RootNamespace>Cashel.Tests</RootNamespace>
+ <AssemblyName>Cashel.Tests</AssemblyName>
+ <TargetFrameworkVersion>v3.5</TargetFrameworkVersion>
+ <FileAlignment>512</FileAlignment>
+ <Name>Cashel.Tests</Name>
+ </PropertyGroup>
+ <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
+ <DebugSymbols>true</DebugSymbols>
+ <DebugType>full</DebugType>
+ <Optimize>false</Optimize>
+ <OutputPath>bin\Debug\</OutputPath>
+ <DefineConstants>DEBUG;TRACE</DefineConstants>
+ <ErrorReport>prompt</ErrorReport>
+ <WarningLevel>3</WarningLevel>
+ </PropertyGroup>
+ <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
+ <DebugType>pdbonly</DebugType>
+ <Optimize>true</Optimize>
+ <OutputPath>bin\Release\</OutputPath>
+ <DefineConstants>TRACE</DefineConstants>
+ <ErrorReport>prompt</ErrorReport>
+ <WarningLevel>3</WarningLevel>
+ </PropertyGroup>
+ <PropertyGroup Condition=" '$(Configuration)' == 'Debug' ">
+ <StartAction>Program</StartAction>
+ <StartProgram>D:\HPierson.Files\Projects\Quinault\External\xunit.console.exe</StartProgram>
+ <StartWorkingDirectory>
+ </StartWorkingDirectory>
+ <StartArguments>..\Cashel\Cashel.Tests\bin\Debug\Cashel.Tests.dll /wait</StartArguments>
+ </PropertyGroup>
+ <ItemGroup>
+ <Reference Include="FsTest, Version=0.0.0.0, Culture=neutral, PublicKeyToken=null">
+ <Name>FsTest</Name>
+ <AssemblyName>FsTest.dll</AssemblyName>
+ <HintPath>..\..\External\FsTest.dll</HintPath>
+ <Private>True</Private>
+ </Reference>
+ <Reference Include="System" />
+ <Reference Include="System.Core">
+ <RequiredTargetFramework>3.5</RequiredTargetFramework>
+ </Reference>
+ <Reference Include="xunit, Version=1.0.2.1283, Culture=neutral, PublicKeyToken=8d05b1bb7a6fdb6c">
+ <Name>xunit</Name>
+ <AssemblyName>xunit.dll</AssemblyName>
+ <HintPath>..\..\External\xunit.dll</HintPath>
+ <Private>True</Private>
+ </Reference>
+ </ItemGroup>
+ <ItemGroup>
+ <Compile Include="peg2_test.fs" />
+ <Compile Include="parser_test.fs" />
+ <Compile Include="peg_test.fs" />
+ <Compile Include="primitives_test.fs" />
+ </ItemGroup>
+ <ItemGroup>
+ <ProjectReference Include="..\Cashel\Cashel.fsproj">
+ <Name>Cashel</Name>
+ <Project>{6b89dd99-f2d4-4c0b-9a9a-12ae0028edd1}</Project>
+ <Private>True</Private>
+ </ProjectReference>
+ </ItemGroup>
+ <Import Project="$(MSBuildExtensionsPath)\FSharp\1.0\Microsoft.FSharp.Targets" />
+ <!-- To modify your build process, add your task inside one of the targets below and uncomment it.
+ Other similar extension points exist, see Microsoft.Common.targets.
+ <Target Name="BeforeBuild">
+ </Target>
+ <Target Name="AfterBuild">
+ </Target>
+ -->
+</Project>
View
2  Cashel/Cashel.Tests/parser.tests.fs → Cashel/Cashel.Tests/parser_test.fs
@@ -50,7 +50,7 @@ let test_combine_both_fail () =
[<Fact>]
let test_monad_zero () =
- let p = parse { if false then return 't' }
+ let p = parser { if false then return 't' }
p "test" |> should equal None
View
131 Cashel/Cashel.Tests/peg2.test.fs → Cashel/Cashel.Tests/peg2_test.fs
@@ -1,7 +1,49 @@
#light
let (!!) str = List.of_seq str
-let chr = Char.chr
+let chr (c:int) = System.Convert.ToChar(c)
+
+let peg2grammar = @"
+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)? => pia;
+ 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;
+ Primary <- i:Identifier => i / OPEN p:Production CLOSE => p/ l:Literal => l/ c:Class => c / DOT => dot;
+ Action <- i:Identifier => i;
+ Identifier <- p1:[a-zA-Z_] pr:[_a-zA-Z0-9]* Spacing => p1pr;
+ Literal <- ['] cl:(!['] c:Char=>c)* ['] Spacing => cl / [""] cl:(![""] c:Char=>c)* [""] Spacing => cl ;
+ Class <- '[' r:(!']' r:Range=>r)* ']' Spacing => r;
+ Range <- c1:Char '-' c2:Char => c1c2 / c:Char => c;
+ Char <- '\\' c:[nrt'""\[\]\\] => c / '\\u' h1:HexDigit h2:HexDigit h3:HexDigit h4:HexDigit =>h1h2h3h4/ !'\\' c:. => c;
+ HexDigit <- c:[a-fA-F0-9] => c;
+ LEFTARROW <- '<-' Spacing;
+ CLOSE <- ')' Spacing;
+ OPEN <- '(' Spacing;
+ SLASH <- '/' Spacing;
+ RIGHTARROW <- '=>' Spacing;
+ COLON <- ':' Spacing;
+ SEMICOLON <- ';' Spacing;
+ DOT <- '.' Spacing;
+ OPEN <- '(' Spacing;
+ CLOSE <- ')' Spacing;
+ AND <- '&' Spacing;
+ NOT <- '!' Spacing;
+ QUESTION <- '?' Spacing;
+ STAR <- '*' Spacing;
+ PLUS <- '+' Spacing;
+ Spacing <- SpaceOrComment*;
+ SpaceOrComment <- Space / Comment;
+ Comment <- '#' (!EndOfLine .)* EndOfLine;
+ Space <- ' ' / '\t' / EndOfLine;
+ EndOfLine <- '\r\n' / '\n' / '\r';
+ EndOfFile <- !.;
+}
+
+"
open Xunit
open FsxUnit.Syntax
@@ -22,18 +64,26 @@ let (>|>) act exp =
[<Fact>]
+let test_eof () =
+ _EndOfFile [] |> should equal (Some((),[]))
+
+[<Fact>]
+let test_eof_fails_not_at_end () =
+ _EndOfFile !!"test" |> should equal None
+
+[<Fact>]
let test_EndOfLine_with_slashr_slashn () =
- let exp = Some(!!"\r\n",!!"test")
+ let exp = Some((),!!"test")
_EndOfLine !!"\r\ntest" >|> exp
[<Fact>]
let test_EndOfLine_with_slashr () =
- let exp = Some(!!"\r",!!"test")
+ let exp = Some((),!!"test")
_EndOfLine !!"\rtest" >|> exp
[<Fact>]
let test_EndOfLine_with_slashn () =
- let exp = Some(!!"\n",!!"test")
+ let exp = Some((),!!"test")
_EndOfLine !!"\ntest" >|> exp
[<Fact>]
@@ -42,27 +92,27 @@ let test_EndOfLine_with_no_slash () =
[<Fact>]
let test_EndOfLine_with_slashn_slashr () =
- let exp = Some(!!"\n",!!"\rtest")
+ let exp = Some((),!!"\rtest")
_EndOfLine !!"\n\rtest" >|> exp
[<Fact>]
let test_Space_with_space () =
- let exp = Some(!!" ",!!"test")
+ let exp = Some((),!!"test")
_Space !!" test" >|> exp
[<Fact>]
let test_Space_with_slasht () =
- let exp = Some(!!"\t",!!"test")
+ let exp = Some((),!!"test")
_Space !!"\ttest" >|> exp
[<Fact>]
let test_Space_with_eol () =
- let exp = Some(!!"\r\n",!!"test")
+ let exp = Some((),!!"test")
_Space !!"\r\ntest" >|> exp
[<Fact>]
let test_Comment () =
- let exp = Some(!!"test _Comment",!!"more text")
+ let exp = Some((),!!"more text")
_Comment !!"#test _Comment\r\nmore text" >|> exp
[<Fact>]
@@ -71,55 +121,55 @@ let test_Comment_not_comment () =
[<Fact>]
let test_Spacing_with_no_comment () =
- _Spacing !!"test _Comment\r\nmore text" >|> (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")
+ let exp = Some((),!!"more text")
_Spacing !!"#test _Comment\r\nmore text" >|> exp
[<Fact>]
let test_Spacing_with_space () =
- let exp = Some([!!" "],!!"more text")
+ let exp = Some((),!!"more text")
_Spacing !!" more text" >|> exp
[<Fact>]
let test_Spacing_with_comment_and_space () =
- let exp = Some([!!" ";!!"test _Comment"],!!"more text")
+ let exp = Some((),!!"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 exp = Some((),!!"more text")
let act = _Spacing !!"#test _Comment\r\n more text"
act >|> exp
[<Fact>]
-let test_dot () = _DOT !!".test" >|> (Some('.', !!"test"))
+let test_dot () = _DOT !!".test" >|> (Some((), !!"test"))
[<Fact>]
-let test_dot_with_space () = _DOT !!". \t test" >|> (Some('.', !!"test"))
+let test_dot_with_space () = _DOT !!". \t test" >|> (Some((), !!"test"))
[<Fact>]
-let test_dot_with_slasht () = _DOT !!".\test" >|> (Some('.', !!"est"))
+let test_dot_with_slasht () = _DOT !!".\test" >|> (Some((), !!"est"))
[<Fact>]
let test_dot_fail () = _DOT !!"test" >|> None
[<Fact>]
-let test_slash () = _SLASH !!"/test" >|> (Some('/', !!"test"))
+let test_slash () = _SLASH !!"/test" >|> (Some((), !!"test"))
[<Fact>]
let test_slash_fail () = _SLASH !!"test" >|> None
[<Fact>]
let test_LEFTARROW () =
- let exp = Some(!!"<-",!!"more text")
+ let exp = Some((),!!"more text")
_LEFTARROW !!"<-more text" >|> exp
[<Fact>]
let test_LEFTARROW_with_space () =
- let exp = Some(!!"<-",!!"more text")
+ let exp = Some((),!!"more text")
_LEFTARROW !!"<-\r\nmore text" >|> exp
[<Fact>]
@@ -267,8 +317,8 @@ let test_Primary_dot_extra_debug () =
try
act >|> exp
with ex ->
- let Some(ev, et) = exp
- let Some(av, at) = act
+ let ev, et = exp |> Option.get
+ let av, at = act |> Option.get
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)
@@ -379,45 +429,18 @@ let test_Rule_two_productions_with_actions () =
let act = _Rule !!"rulename <- test me now => Action1/ another test => Action2; foobar"
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 g, cl = _Grammar !!peg2grammar |> Option.get
let {name=id; rules=rl} = g
Assert.Equal("PEG2", id)
- Assert.Equal(6, (List.length rl))
+ Assert.Equal(35, (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 g = Parse peg2grammar |> Option.get
let {name=id; rules=rl} = g
Assert.Equal("PEG2", id)
- Assert.Equal(6, (List.length rl))
+ Assert.Equal(35, (List.length rl))
View
4 Cashel/Cashel.Tests/peg.test.fs → Cashel/Cashel.Tests/peg_test.fs
@@ -1,7 +1,7 @@
#light
let (!!) str = List.of_seq str
-let chr = Char.chr
+let chr (c:int) = System.Convert.ToChar(c)
open Xunit
open FsxUnit.Syntax
@@ -357,6 +357,6 @@ Space <- ' ' / '\t' / EndOfLine
EndOfLine <- '\r\n' / '\n' / '\r'
EndOfFile <- !."
- let Some(defs, cl) = peg_grammar |> Grammar
+ let defs, cl = peg_grammar |> Grammar |> Option.get
defs |> List.length |> should equal 29
cl |> should equal []
View
0  Cashel/Cashel.Tests/primitives.test.fs → Cashel/Cashel.Tests/primitives_test.fs
File renamed without changes
View
24 Cashel/Cashel.sln
@@ -1,24 +1,24 @@

Microsoft Visual Studio Solution File, Format Version 10.00
# Visual Studio 2008
-Project("{94D665CA-D915-4DE1-AA53-913450A1AE2D}") = "Cashel", "Cashel\Cashel.fsharpp", "{59211AE5-5C67-4AD4-9A51-DCFD95117140}"
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Cashel", "Cashel\Cashel.fsproj", "{6B89DD99-F2D4-4C0B-9A9A-12AE0028EDD1}"
EndProject
-Project("{94D665CA-D915-4DE1-AA53-913450A1AE2D}") = "Cashel.Tests", "Cashel.Tests\Cashel.Tests.fsharpp", "{B07E7515-ABC3-4491-8EC0-BA4C8E6A6C3C}"
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Cashel.Tests", "Cashel.Tests\Cashel.Tests.fsproj", "{25D2AF80-078E-46A1-8EBB-01A905DBAD48}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
- Debug|Win32 = Debug|Win32
- Release|Win32 = Release|Win32
+ Debug|Any CPU = Debug|Any CPU
+ Release|Any CPU = Release|Any CPU
EndGlobalSection
GlobalSection(ProjectConfigurationPlatforms) = postSolution
- {59211AE5-5C67-4AD4-9A51-DCFD95117140}.Debug|Win32.ActiveCfg = Debug|Win32
- {59211AE5-5C67-4AD4-9A51-DCFD95117140}.Debug|Win32.Build.0 = Debug|Win32
- {59211AE5-5C67-4AD4-9A51-DCFD95117140}.Release|Win32.ActiveCfg = Release|Win32
- {59211AE5-5C67-4AD4-9A51-DCFD95117140}.Release|Win32.Build.0 = Release|Win32
- {B07E7515-ABC3-4491-8EC0-BA4C8E6A6C3C}.Debug|Win32.ActiveCfg = Debug|Win32
- {B07E7515-ABC3-4491-8EC0-BA4C8E6A6C3C}.Debug|Win32.Build.0 = Debug|Win32
- {B07E7515-ABC3-4491-8EC0-BA4C8E6A6C3C}.Release|Win32.ActiveCfg = Release|Win32
- {B07E7515-ABC3-4491-8EC0-BA4C8E6A6C3C}.Release|Win32.Build.0 = Release|Win32
+ {6B89DD99-F2D4-4C0B-9A9A-12AE0028EDD1}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+ {6B89DD99-F2D4-4C0B-9A9A-12AE0028EDD1}.Debug|Any CPU.Build.0 = Debug|Any CPU
+ {6B89DD99-F2D4-4C0B-9A9A-12AE0028EDD1}.Release|Any CPU.ActiveCfg = Release|Any CPU
+ {6B89DD99-F2D4-4C0B-9A9A-12AE0028EDD1}.Release|Any CPU.Build.0 = Release|Any CPU
+ {25D2AF80-078E-46A1-8EBB-01A905DBAD48}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+ {25D2AF80-078E-46A1-8EBB-01A905DBAD48}.Debug|Any CPU.Build.0 = Debug|Any CPU
+ {25D2AF80-078E-46A1-8EBB-01A905DBAD48}.Release|Any CPU.ActiveCfg = Release|Any CPU
+ {25D2AF80-078E-46A1-8EBB-01A905DBAD48}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
View
68 Cashel/Cashel/Cashel.fsharpp
@@ -1,68 +0,0 @@
-"General"
-{
-"ProjectIdGuid" = "{59211AE5-5C67-4AD4-9A51-DCFD95117140}"
-}
-"Configurations"
-{
- "Debug|Win32"
- {
- "ProjectType" = "DLL"
- "OptLevel" = "Off"
- "StrongNamingLevel" = "None"
- "OutputPath" = ""
- "SearchPath" = ""
- "StrongNameFile" = ""
- "OutputBase" = ""
- "CustomCommandLine" = ""
- "CustomCompiler" = ""
- "DebugCheck" = "TRUE"
- "CustomCompilationCheck" = "FALSE"
- "DebugStartMode" = "0"
- "StartApp" = ""
- "StartAppPath" = ""
- "CustomStartupArguments" = ""
- }
- "Release|Win32"
- {
- "ProjectType" = "EXE"
- "OptLevel" = "3"
- "StrongNamingLevel" = "None"
- "OutputPath" = ""
- "SearchPath" = ""
- "StrongNameFile" = ""
- "OutputBase" = ""
- "CustomCommandLine" = ""
- "CustomCompiler" = ""
- "DebugCheck" = "FALSE"
- "CustomCompilationCheck" = "FALSE"
- "DebugStartMode" = "0"
- "StartApp" = ""
- "StartAppPath" = ""
- "CustomStartupArguments" = ""
- }
-}
-"Files"
-{
- "parser.fs"
- {
- "ProjRelPath" = "T"
- }
- "primitives.fs"
- {
- "ProjRelPath" = "T"
- }
- "peg.fs"
- {
- "ProjRelPath" = "T"
- }
- "peg2.fs"
- {
- "ProjRelPath" = "T"
- }
-}
-"ProjStartupServices"
-{
-}
-"Globals"
-{
-}
View
53 Cashel/Cashel/Cashel.fsproj
@@ -0,0 +1,53 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project ToolsVersion="3.5" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <PropertyGroup>
+ <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
+ <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
+ <ProductVersion>8.0.30703</ProductVersion>
+ <SchemaVersion>2.0</SchemaVersion>
+ <ProjectGuid>{6b89dd99-f2d4-4c0b-9a9a-12ae0028edd1}</ProjectGuid>
+ <OutputType>Library</OutputType>
+ <RootNamespace>Cashel</RootNamespace>
+ <AssemblyName>Cashel</AssemblyName>
+ <TargetFrameworkVersion>v3.5</TargetFrameworkVersion>
+ <FileAlignment>512</FileAlignment>
+ <Name>Cashel</Name>
+ </PropertyGroup>
+ <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
+ <DebugSymbols>true</DebugSymbols>
+ <DebugType>full</DebugType>
+ <Optimize>false</Optimize>
+ <OutputPath>bin\Debug\</OutputPath>
+ <DefineConstants>DEBUG;TRACE</DefineConstants>
+ <ErrorReport>prompt</ErrorReport>
+ <WarningLevel>3</WarningLevel>
+ </PropertyGroup>
+ <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
+ <DebugType>pdbonly</DebugType>
+ <Optimize>true</Optimize>
+ <OutputPath>bin\Release\</OutputPath>
+ <DefineConstants>TRACE</DefineConstants>
+ <ErrorReport>prompt</ErrorReport>
+ <WarningLevel>3</WarningLevel>
+ </PropertyGroup>
+ <ItemGroup>
+ <Reference Include="System" />
+ <Reference Include="System.Core">
+ <RequiredTargetFramework>3.5</RequiredTargetFramework>
+ </Reference>
+ </ItemGroup>
+ <ItemGroup>
+ <Compile Include="parser.fs" />
+ <Compile Include="primitives.fs" />
+ <Compile Include="peg.fs" />
+ <Compile Include="peg2.fs" />
+ </ItemGroup>
+ <Import Project="$(MSBuildExtensionsPath)\FSharp\1.0\Microsoft.FSharp.Targets" />
+ <!-- To modify your build process, add your task inside one of the targets below and uncomment it.
+ Other similar extension points exist, see Microsoft.Common.targets.
+ <Target Name="BeforeBuild">
+ </Target>
+ <Target Name="AfterBuild">
+ </Target>
+ -->
+</Project>
View
2  Cashel/Cashel/parser.fs
@@ -38,7 +38,7 @@ type ParserBuilder() =
member w.Bind(p, f) = p >>= f
member w.Combine(p1,p2) = p1 +++ p2
-let parse = ParserBuilder()
+let parser = ParserBuilder()
View
50 Cashel/Cashel/peg.fs
@@ -150,25 +150,25 @@ open DevHawk.Parser.Primitives
let EndOfFile = eof
///EndOfLine <- '\r\n' / '\n' / '\r'
-let EndOfLine = parse {
+let EndOfLine = parser {
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 = parser {
return! item_equal ' ' |> listify
return! item_equal '\t' |> listify
return! EndOfLine }
///Comment <- '#' (!EndOfLine .)* EndOfLine
-let Comment = parse {
+let Comment = parser {
do! skip_item '#'
let! c = repeat_until item EndOfLine
return c }
///Spacing <- (Space / Comment)*
-let Spacing = parse {
+let Spacing = parser {
return! Space
return! Comment } |> repeat
@@ -204,9 +204,9 @@ 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'
+ let c2i c = int c - int '0'
- parse {
+ parser {
do! skip_item '\\'
let! c = any_of ['n';'r';'t';'''; '"'; '['; ']'; '\\']
match c with
@@ -215,40 +215,40 @@ let Char =
| 't' -> return '\t'
| _ -> return c }
+++
- parse {
+ parser {
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)) }
+ return char ((c2i c1)*64 + (c2i c2)*8 + (c2i c3)) }
+++
- parse {
+ parser {
do! skip_item '\\'
let! c1 = any_of ['0'..'7']
let! c2 = !? (any_of ['0'..'7'])
match c2 with
- | Some(c2) -> return Char.chr ((c2i c1)*8 + (c2i c2))
- | None -> return Char.chr (c2i c1) }
+ | Some(c2) -> return char ((c2i c1)*8 + (c2i c2))
+ | None -> return char (c2i c1) }
+++
- parse {
+ parser {
do! !~ (item_equal '\\')
return! item }
///Range <- Char '-' Char / Char
let Range =
- parse {
+ parser {
let! c1 = Char
do! skip_item '-'
let! c2 = Char
return Dual(c1, c2) }
+++
- parse {
+ parser {
let! c1 = Char
return Single(c1) }
///Class <- '[' (!']' Range)* ']' Spacing
let Class =
- parse {
+ parser {
do! skip_item '['
let! rl = repeat_until Range (item_equal ']')
do! ignore Spacing
@@ -257,7 +257,7 @@ let Class =
///Literal <- ['] (!['] Char)* ['] Spacing / ["] (!["] Char)* [""] Spacing
let Literal =
- let literal_workhorse ch = parse {
+ let literal_workhorse ch = parser {
do! skip_item ch
let! cl = repeat_until Char (item_equal ch)
do! ignore Spacing
@@ -269,10 +269,10 @@ let Literal =
//IdentStart <- [a-zA-Z_]
//IdentCont <- IdentStart / [0-9]
let Identifier =
- let IdentStart = any_of (List.flatten [['a'..'z']; ['A'..'Z']; ['_']])
+ let IdentStart = any_of (['a'..'z']@['A'..'Z']@['_'])
let IdentCont = IdentStart +++ any_of ['0'..'9']
- parse {
+ parser {
let! c = IdentStart
let! cs = repeat IdentCont
do! ignore Spacing
@@ -282,22 +282,22 @@ let Identifier =
///Primary <- Identifier !LEFTARROW / OPEN Expression CLOSE / Literal / Class / DOT
//Had to name this method pPrimary to avoid conflict with Primary discriminated union
let rec pPrimary =
- parse {
+ parser {
let! id = Identifier
do! !~ LEFTARROW
return Primary.Identifier(id) }
+++
- parse {
+ parser {
do! ignore OPEN
let! exp = Expression
do! ignore CLOSE
return Primary.Expression(exp) }
+++
- parse {
+ parser {
let! lit = Literal
return Primary.Literal(lit) }
+++
- parse {
+ parser {
let! cls = Class
return Primary.Class(cls) }
+++
@@ -308,7 +308,7 @@ let rec pPrimary =
and SequenceItem =
let prefix = (AND >>$ Prefix.And) +++ (NOT >>$ Prefix.Not)
let suffix = (QUESTION >>$ Suffix.Question) +++ (STAR >>$ Suffix.Star) +++ (PLUS >>$ Suffix.Plus)
- parse {
+ parser {
let! pre = !? prefix
let! pri = pPrimary
let! suf = !? suffix
@@ -319,14 +319,14 @@ and Sequence = repeat SequenceItem
///Expression <- Sequence (SLASH Sequence)*
and Expression =
- parse {
+ parser {
let! s = Sequence
let! sl = repeat (SLASH >>. Sequence)
return s::sl }
///Definition <- Identifier LEFTARROW Expression
let Definition =
- parse {
+ parser {
let! id = Identifier
do! ignore LEFTARROW
let! ex = Expression
View
109 Cashel/Cashel/peg2.fs
@@ -174,74 +174,78 @@ type Grammar =
open DevHawk.Parser.Core
open DevHawk.Parser.Primitives
+let _EndOfFile = !~ item
+
///EndOfLine <- '\r\n' / '\n' / '\r'
-let _EndOfLine = parse {
+let _EndOfLine = parser {
return! items_equal (List.of_seq "\r\n")
return! item_equal '\n' |> listify
- return! item_equal '\r' |> listify }
+ return! item_equal '\r' |> listify } |> ignore
///Space <- ' ' / '\t' / EndOfLine
-let _Space = parse {
- return! item_equal ' ' |> listify
- return! item_equal '\t' |> listify
- return! _EndOfLine }
+let _Space = parser {
+ return! item_equal ' ' |> ignore
+ return! item_equal '\t' |> ignore
+ return! _EndOfLine } |> ignore
///Comment <- '#' (!EndOfLine .)* EndOfLine
-let _Comment = parse {
+let _Comment = parser {
do! skip_item '#'
- let! c = repeat_until item _EndOfLine
- return c }
+ do! repeat_until item _EndOfLine |> ignore
+ return () }
///Spacing <- (Space / Comment)*
-let _Spacing = parse {
+let _Spacing = ignore (parser {
return! _Space
- return! _Comment } |> repeat
+ return! _Comment } |> repeat)
+let parse p = _Spacing >>. p
+let token p = ignore (p .>> _Spacing)
///DOT <- '.' Spacing
-let _DOT = item_equal '.' .>> _Spacing
+let _DOT = token (item_equal '.')
///OPEN <- '(' Spacing
-let _OPAREN = item_equal '(' .>> _Spacing
+let _OPAREN = token (item_equal '(')
///CLOSE <- ')' Spacing
-let _CPAREN = item_equal ')' .>> _Spacing
+let _CPAREN = token (item_equal ')')
///AND <- '&' Spacing
-let _AND = item_equal '&' .>> _Spacing
+let _AND = token (item_equal '&')
///NOT <- '!' Spacing
-let _NOT = item_equal '!' .>> _Spacing
+let _NOT = token (item_equal '!')
///QUESTION <- '?' Spacing
-let _QUESTION = item_equal '?' .>> _Spacing
+let _QUESTION = token (item_equal '?')
///STAR <- '*' Spacing
-let _STAR = item_equal '*' .>> _Spacing
+let _STAR = token (item_equal '*')
///PLUS <- '+' Spacing
-let _PLUS = item_equal '+' .>> _Spacing
+let _PLUS = token (item_equal '+')
///COLON <- ':' Spacing
-let _COLON = item_equal ':' .>> _Spacing
+let _COLON = token (item_equal ':')
-///COLON <- ':' Spacing
-let _SEMICOLON = item_equal ';' .>> _Spacing
+///SEMICOLON <- ';' Spacing
+let _SEMICOLON = token (item_equal ';')
///RIGHTARROW <- '=>' Spacing
-let _RIGHTARROW = items_equal (List.of_seq "=>") .>> _Spacing
+let _RIGHTARROW = token (items_equal (List.of_seq "=>"))
///SLASH <- '/' Spacing
-let _SLASH = item_equal '/' .>> _Spacing
+let _SLASH = token (item_equal '/')
///OPEN <- '(' Spacing
-let _OCURLY = item_equal '{' .>> _Spacing
+let _OCURLY = token (item_equal '{')
///CLOSE <- ')' Spacing
-let _CCURLY = item_equal '}' .>> _Spacing
+let _CCURLY = token (item_equal '}')
///LEFTARROW <- '<-' Spacing
-let _LEFTARROW = items_equal (List.of_seq "<-") .>> _Spacing
+let _LEFTARROW = token (items_equal (List.of_seq "<-"))
///Char <- '\\' [nrt'""\[\]\\] / '\\u' [a-fA-F0-9] [a-fA-F0-9] [a-fA-F0-9] [a-fA-F0-9] / !'\\' .
@@ -251,11 +255,11 @@ let _Char =
let hex2int c =
let c = System.Char.ToUpper(c)
- if System.Char.IsDigit(c) then Char.code c - Char.code '0'
- elif 'A' <= c && c <= 'F' then Char.code c - Char.code 'A' + 10
+ if System.Char.IsDigit(c) then int c - int '0'
+ elif 'A' <= c && c <= 'F' then int c - int 'A' + 10
else failwith "Invalid Hex Digit"
- parse {
+ parser {
do! skip_item '\\'
let! c = any_of ['n';'r';'t';'''; '"'; '['; ']'; '\\']
match c with
@@ -264,34 +268,34 @@ let _Char =
| 't' -> return '\t'
| _ -> return c }
+++
- parse {
+ parser {
do! skip_item '\\'
do! skip_item 'u'
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)) }
+ return char ((hex2int h1)*4096 + (hex2int h2)*256 + (hex2int h3)*16 + (hex2int h4)) }
+++
- parse {
+ parser {
do! !~ (item_equal '\\')
return! item }
///Range <- Char '-' Char / Char
let _Range =
- parse {
+ parser {
let! c1 = _Char
do! skip_item '-'
let! c2 = _Char
return Dual(c1, c2) }
+++
- parse {
+ parser {
let! c1 = _Char
return Single(c1) }
///Class <- '[' (!']' Range)* ']' Spacing
let _Class =
- parse {
+ parser {
do! skip_item '['
let! rl = repeat_until _Range (item_equal ']')
do! ignore _Spacing
@@ -301,7 +305,7 @@ let _Class =
///Literal <- ['] (!['] Char)* ['] Spacing / ["] (!["] Char)* [""] Spacing
let _Literal =
let literal_workhorse ch =
- parse {
+ parser {
do! skip_item ch
let! cl = repeat_until _Char (item_equal ch)
do! ignore _Spacing
@@ -311,7 +315,7 @@ let _Literal =
///Identifier <- [a-zA-Z_] ([_a-zA-Z0-9])* Spacing
let _Identifier =
- parse {
+ parser {
let! c = any_of (['_'] @ ['a'..'z'] @ ['A'..'Z'])
let! cs = repeat (any_of (['_'] @ ['a'..'z'] @ ['A'..'Z'] @ ['0'..'9']))
do! ignore _Spacing
@@ -320,24 +324,24 @@ let _Identifier =
//Stub out Action for now
let _Action = _Identifier
-///Primary <- Identifier !LEFTARROW / OPEN Production CLOSE / Literal / Class / DOT
+///Primary <- Identifier / OPEN Production CLOSE / Literal / Class / DOT
//Had to name this method pPrimary to avoid conflict with Primary discriminated union
let rec _Primary =
- parse {
+ parser {
let! id = _Identifier
return Identifier(id) }
+++
- parse {
+ parser {
do! ignore _OPAREN
let! prod = _Production
do! ignore _CPAREN
return Production(prod) }
+++
- parse {
+ parser {
let! lit = _Literal
return Literal(lit) }
+++
- parse {
+ parser {
let! cls = _Class
return Class(cls) }
+++
@@ -353,7 +357,7 @@ and _PatternItem =
+++
(_NOT >>$ FailurePredicate)
+++
- parse {
+ parser {
let! id = _Identifier
do! _COLON |> ignore
return Variable(id) }
@@ -365,7 +369,7 @@ and _PatternItem =
+++
(_PLUS >>$ OneOrMore)
- parse {
+ parser {
let! pre = !? _Prefix
let! pri = _Primary
let! suf = !? _Arity
@@ -373,14 +377,14 @@ and _PatternItem =
///Production <- PatternItem+ (RIGHTARROW Action)?
and _Production =
- parse {
+ parser {
let! pl = repeat1 _PatternItem
let! a = !? (_RIGHTARROW >>. _Action)
return {pattern=pl; action=a} }
///Rule <- Identifier LEFTARROW Production (SLASH Production)* SEMICOLON
let _Rule =
- parse {
+ parser {
let! id = _Identifier
do! ignore _LEFTARROW
let! p = _Production
@@ -390,13 +394,13 @@ let _Rule =
///Grammar <- Spacing Identifier OCURLY Rule+ CCURLY EndOfFile
let _Grammar =
- parse {
+ parser {
do! ignore _Spacing
let! id = _Identifier
- do! ignore _OCURLY
+ do! _OCURLY
let! rl = repeat1 _Rule
- do! ignore _CCURLY
- do! eof
+ do! _CCURLY
+ do! _EndOfFile
return {name=id; rules=rl} }
let Parse (input:string) =
@@ -404,3 +408,6 @@ let Parse (input:string) =
match g with
| Some(g, []) -> Some(g)
| _ -> None
+
+
+
View
21 Cashel/Cashel/primitives.fs
@@ -6,6 +6,9 @@ module Primitives
open DevHawk.Parser.Core
+//-------------------------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)
@@ -57,14 +60,14 @@ let repeat_until p1 p2 = repeat (!~ p2 >>. p1) .>> p2
//-------------------------List primitives-------------------------------------------
///item assumes the input is a list and returns a tuple of the head and tail
-let item =
+let item : Parser<'a list, 'a> =
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 =
+let eof : Parser<'a list, unit> =
fun input ->
match input with
| [] -> Some((), [])
@@ -88,3 +91,17 @@ 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
+
+//-------------------------char list primitives-------------------------------------------
+
+let add_line_and_col cl =
+ let rec worker cl line col =
+ match cl with
+ | '\r'::'\n'::tail -> ('\r', line, col)::('\n', line, (col+1))::(worker tail (line+1) 1)
+ | '\n'::tail -> ('\n', line, col)::(worker tail (line+1) 1)
+ | '\r'::tail -> ('\r', line, col)::(worker tail (line+1) 1)
+ | head::tail -> (head, line, col)::(worker tail line (col+1))
+ | [] -> []
+ worker cl 1 1
+
+
View
2  External/.gitignore
@@ -0,0 +1,2 @@
+FsTest/*
+xunit.net/*
View
BIN  External/FsTest.dll
Binary file not shown
Please sign in to comment.
Something went wrong with that request. Please try again.