-
Notifications
You must be signed in to change notification settings - Fork 161
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Add F# support via fslex and fsyacc #404
base: master
Are you sure you want to change the base?
Changes from all commits
c7b0f80
fac29ea
f7b9226
51303ec
88bf272
f51bb81
ca01da8
bf07c25
5e22c1c
63c46ee
3ca5055
File filter
Filter by extension
Conversations
Jump to
Diff view
Diff view
There are no files selected for viewing
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1 +1 @@ | ||
.shelly/ | ||
.shelly/ |
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,246 @@ | ||
{- | ||
BNF Converter: FSharp main file | ||
Copyright (C) 2021 Author: Grzegorz Dziadkiewicz | ||
|
||
-} | ||
|
||
-- based on BNFC OCaml backend | ||
|
||
{-# LANGUAGE QuasiQuotes #-} | ||
|
||
module BNFC.Backend.FSharp (makeFSharp) where | ||
|
||
import System.FilePath (pathSeparator, (</>)) | ||
|
||
import BNFC.Backend.Base (MkFiles, mkfile) | ||
import BNFC.Backend.Common.Makefile | ||
import BNFC.Backend.FSharp.CFtoFSharpAbs | ||
import BNFC.Backend.FSharp.CFtoFsLex | ||
import BNFC.Backend.FSharp.CFtoFSharpPrinter | ||
import BNFC.Backend.FSharp.CFtoFSharpShow | ||
import BNFC.Backend.FSharp.CFtoFSharpTemplate | ||
import BNFC.Backend.FSharp.CFtoFSharpTest (fsharpTestfile) | ||
import BNFC.Backend.FSharp.CFtoFsYacc | ||
import qualified BNFC.Backend.XML as XML | ||
import BNFC.CF | ||
import BNFC.PrettyPrint | ||
import BNFC.Options | ||
import BNFC.Utils | ||
import qualified BNFC.Backend.Common.Makefile as Makefile | ||
|
||
import qualified BNFC.Backend.C as C | ||
|
||
-- naming conventions | ||
|
||
noLang :: SharedOptions -> String -> String | ||
noLang _ name = name | ||
|
||
withLang :: SharedOptions -> String -> String | ||
withLang opts name = name ++ sanitizedLang opts | ||
|
||
mkMod :: (SharedOptions -> String -> String) -> String -> SharedOptions -> String | ||
mkMod addLang name opts = | ||
pref ++ if inDir opts then sanitizedLang opts ++ "." ++ name else addLang opts name | ||
where pref = maybe "" (++".") (inPackage opts) | ||
|
||
mkFile :: (SharedOptions -> String -> String) -> String -> String -> SharedOptions -> FilePath | ||
mkFile addLang name ext opts = | ||
pref ++ if inDir opts | ||
then sanitizedLang opts </> name ++ ext' | ||
else addLang opts name ++ if null ext then "" else ext' | ||
where pref = maybe "" (\ p -> pkgToDir p </> "") (inPackage opts) | ||
ext' = if null ext then "" else "." ++ ext | ||
|
||
-- | Turn language name into a valid fsharp module identifier. | ||
sanitizedLang :: SharedOptions -> String | ||
sanitizedLang = camelCase_ . lang | ||
|
||
|
||
absFile, absFileM, fslexFile, fslexFileM, fsyaccFile, fsyaccFileM, | ||
utilFile, utilFileM, templateFile, templateFileM, printerFile, printerFileM, | ||
tFile, tFileM, showFile, showFileM, fsprojFile, buildTarget :: SharedOptions -> String | ||
absFile = mkFile withLang "Abs" "fs" | ||
absFileM = mkMod withLang "Abs" | ||
fslexFile = mkFile withLang "Lex" "fsl" | ||
fslexFileM = mkMod withLang "Lex" | ||
fsyaccFile = mkFile withLang "Par" "fsy" | ||
fsyaccFileM = mkMod withLang "Par" | ||
templateFile = mkFile withLang "Skel" "fs" | ||
templateFileM = mkMod withLang "Skel" | ||
printerFile = mkFile withLang "Print" "fs" | ||
printerFileM = mkMod withLang "Print" | ||
showFile = mkFile withLang "Show" "fs" | ||
showFileM = mkMod withLang "Show" | ||
tFileM = mkMod withLang "Test" | ||
tFile = mkFile withLang "Test" "fs" | ||
utilFileM = mkMod noLang "BnfcUtil" | ||
utilFile = mkFile noLang "BnfcUtil" "fs" | ||
fsprojFile = mkFile withLang "" "fsproj" | ||
buildTarget = mkFile withLang "" "" | ||
|
||
makeFSharp :: SharedOptions -> CF -> MkFiles () | ||
makeFSharp opts cf = do | ||
let absMod = absFileM opts | ||
lexMod = fslexFileM opts | ||
parMod = fsyaccFileM opts | ||
prMod = printerFileM opts | ||
showMod = showFileM opts | ||
tFileMod = tFileM opts | ||
do | ||
mkfile (absFile opts) comment $ cf2Abstract absMod cf | ||
mkfile (fslexFile opts) comment $ cf2fslex lexMod parMod cf | ||
mkfile (fsyaccFile opts) C.comment $ | ||
cf2fsyacc parMod absMod lexMod cf | ||
mkfile (templateFile opts) comment $ cf2Template (templateFileM opts) absMod cf | ||
mkfile (printerFile opts) comment $ cf2Printer prMod absMod cf | ||
mkfile (showFile opts) comment $ cf2show showMod absMod cf | ||
mkfile (tFile opts) comment $ fsharpTestfile absMod lexMod parMod prMod showMod tFileMod cf | ||
mkfile (utilFile opts) comment $ utilM (utilFileM opts) | ||
mkfile (fsprojFile opts) XML.comment $ fsprojM opts | ||
mkMakefile opts $ makefile opts | ||
-- case xml opts of | ||
-- 2 -> makeXML opts True cf | ||
-- 1 -> makeXML opts False cf | ||
-- _ -> return () | ||
|
||
-- | Generate the makefile. | ||
makefile | ||
:: SharedOptions | ||
-> String -- ^ Filename of the makefile. | ||
-> Doc -- ^ Content of the makefile. | ||
makefile opts makeFile = vcat | ||
[ "# Makefile for building the parser and test program." | ||
, phonyRule | ||
, defaultRule | ||
, vcat [ "# Rules for building the parser." , "" ] | ||
-- If option -o was given, we have no access to the grammar file | ||
-- from the Makefile. Thus, we have to drop the rule for | ||
-- reinvokation of bnfc. | ||
, when (isDefault outDir opts) $ bnfcRule | ||
, testParserRule | ||
, vcat [ "# Rules for cleaning generated files." , "" ] | ||
, cleanRule | ||
, distCleanRule | ||
, "# EOF" | ||
] | ||
where | ||
-- | List non-file targets here. | ||
phonyRule :: Doc | ||
phonyRule = vcat | ||
[ "# List of goals not corresponding to file names." | ||
, "" | ||
, Makefile.mkRule ".PHONY" [ "all", "clean", "distclean" ] [] | ||
] | ||
-- | Default: build test parser(s). | ||
defaultRule :: Doc | ||
defaultRule = vcat | ||
[ "# Default goal." | ||
, "" | ||
, Makefile.mkRule "all" tgts [] | ||
] | ||
where | ||
tgts = [ buildTarget opts ] | ||
|
||
-- | Rule to build F# test parser. | ||
testParserRule :: Doc | ||
testParserRule = Makefile.mkRule tgt deps [ "dotnet build" ] | ||
where | ||
tgt :: String | ||
tgt = buildTarget opts | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I used a name that is not a file name. Is this a problem? There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Well, if the target is a file, then There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. For a moment I believed that there won't be a common file name for Linux and Windows but this turned out to be false. I will fix it. |
||
deps :: [String] | ||
deps = map ($ opts) | ||
[ absFile | ||
, printerFile | ||
, tFile | ||
, fslexFile | ||
, fsyaccFile | ||
, templateFile | ||
, showFile | ||
, utilFile | ||
, fsprojFile | ||
] | ||
cleanRule = | ||
mkRule "clean" [] | ||
[ "-rm -fr bin obj "] | ||
|
||
distCleanRule = | ||
mkRule "distclean" ["clean"] | ||
[ "-rm -f " ++ unwords [ mkFile withLang "Lex" "*" opts, | ||
mkFile withLang "Par" "*" opts, | ||
mkFile withLang "Layout" "*" opts, | ||
mkFile withLang "Skel" "*" opts, | ||
mkFile withLang "Print" "*" opts, | ||
mkFile withLang "Show" "*" opts, | ||
mkFile withLang "Test" "*" opts, | ||
mkFile withLang "Abs" "*" opts, | ||
mkFile withLang "Test" "" opts, | ||
mkFile withLang "" "fsproj" opts, | ||
utilFile opts, | ||
makeFile ]] | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I used the code from Haskell as a reference for this part, but I don't understand why it removes the makefile. There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. This is indeed debatable. I think the rationale was that |
||
|
||
-- | Rule to reinvoke @bnfc@ to updated parser. | ||
-- Reinvokation should not recreate @Makefile@! | ||
bnfcRule :: Doc | ||
bnfcRule = Makefile.mkRule tgts [ lbnfFile opts ] [ recipe ] | ||
where | ||
recipe = unwords [ "bnfc", printOptions opts{ make = Nothing } ] | ||
tgts = unwords . map ($ opts) $ | ||
[ absFile | ||
, fslexFile | ||
, fsyaccFile | ||
, utilFile | ||
, templateFile | ||
, printerFile | ||
, tFile | ||
, showFile | ||
] | ||
|
||
comment :: String -> String | ||
comment x = unwords [ "(*", x, "*)" ] | ||
|
||
pkgToDir :: String -> FilePath | ||
pkgToDir = replace '.' pathSeparator | ||
|
||
utilM :: String -> String | ||
utilM moduleName = unlines | ||
["//automatically generated by BNFC", | ||
"module" +++ moduleName, | ||
"open FSharp.Text.Lexing", | ||
"", | ||
"exception ParseError of Position * Position " | ||
] | ||
|
||
fsprojM :: SharedOptions -> String | ||
fsprojM opts = unlines | ||
["<Project Sdk=\"Microsoft.NET.Sdk\">" | ||
,"" | ||
," <PropertyGroup>" | ||
," <OutputType>Exe</OutputType>" | ||
," <TargetFramework>net5.0</TargetFramework>" | ||
," <WarnOn>3390;$(WarnOn)</WarnOn>" | ||
," </PropertyGroup>" | ||
,"" | ||
," <ItemGroup>" | ||
," <Compile Include=\"" ++ utilFile opts ++ "\" />" | ||
," <Compile Include=\"" ++ absFile opts ++ "\" />" | ||
," <FsYacc Include=\"" ++ fsyaccFile opts ++ "\" >" | ||
," <OtherFlags>--module " ++ fsyaccFileM opts ++ "</OtherFlags>" | ||
," </FsYacc>" | ||
," <FsLex Include=\"" ++ fslexFile opts ++ "\">" | ||
," <OtherFlags>--unicode</OtherFlags>" | ||
," </FsLex>" | ||
," <Compile Include=\"" ++ fsyaccFileM opts ++ ".fsi\" />" | ||
," <Compile Include=\"" ++ fsyaccFileM opts ++ ".fs\" />" | ||
," <Compile Include=\"" ++ fslexFileM opts ++ ".fs\" />" | ||
," <Compile Include=\"" ++ printerFile opts ++ "\" />" | ||
," <Compile Include=\"" ++ showFile opts ++ "\" />" | ||
," <Compile Include=\"" ++ templateFile opts ++ "\" />" | ||
," <Compile Include=\"" ++ tFile opts ++ "\" />" | ||
," </ItemGroup>" | ||
,"" | ||
," <ItemGroup>" | ||
," <PackageReference Include=\"FsLexYacc\" Version=\"10.2.0\" />" | ||
," </ItemGroup>" | ||
|
||
,"</Project>" | ||
] |
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,86 @@ | ||
{- | ||
BNF Converter: FSharp Abstract Syntax Generator | ||
Copyright (C) 2021 Author: Grzegorz Dziadkiewicz | ||
|
||
-} | ||
|
||
-- based on BNFC OCaml backend | ||
|
||
module BNFC.Backend.FSharp.CFtoFSharpAbs (cf2Abstract) where | ||
|
||
import Text.PrettyPrint | ||
|
||
import BNFC.CF | ||
import BNFC.Utils ( (+++), unless, parensIf ) | ||
import Data.List ( intersperse ) | ||
import BNFC.Backend.FSharp.FSharpUtil | ||
|
||
-- to produce an F# module | ||
cf2Abstract :: String -> CF -> String | ||
cf2Abstract absMod cf = unlines $ concat | ||
[ ["module" +++ absMod] | ||
, mutualRecDefs $ concat | ||
[ map (prSpecialData cf) (specialCats cf) | ||
, map prData (cf2data cf) | ||
] | ||
, unless (null defs) $ concat | ||
[ [ "(* defined constructors *)" | ||
, "" | ||
] | ||
, defs | ||
] | ||
] | ||
where | ||
defs = definedRules cf | ||
|
||
definedRules :: CF -> [String] | ||
definedRules cf = map mkDef $ definitions cf | ||
where | ||
mkDef (Define f args e _) = | ||
"let " ++ sanitizeFSharp (funName f) ++ " " ++ mkTuple (map fst args) ++ " = " ++ fsharpExp False e | ||
|
||
fsharpExp :: Bool -> Exp -> String | ||
fsharpExp p = \case | ||
Var s -> s | ||
App "(:)" _ [e1, e2] -> parensIf p $ unwords [ fsharpExp True e1, "::", fsharpExp False e2 ] | ||
App s _ [] -> sanitizeFSharp s | ||
App s _ [e] -> parensIf p $ sanitizeFSharp s ++ ' ' : fsharpExp True e | ||
App s _ es -> parensIf p $ sanitizeFSharp s ++ ' ' : mkTuple (map (fsharpExp False) es) | ||
LitInt i -> show i | ||
LitDouble d -> show d | ||
LitChar c -> "\'" ++ c : "\'" | ||
LitString s -> "\"" ++ s ++ "\"" | ||
|
||
-- allow mutual recursion so that we do not have to sort the type definitions in | ||
-- dependency order | ||
mutualRecDefs :: [String] -> [String] | ||
mutualRecDefs [] = [] | ||
mutualRecDefs (x:xs) = ("type" +++ x) : map ("and" +++) xs | ||
|
||
prData :: Data -> String | ||
prData (cat,rules) = | ||
fixType cat +++ "=" ++ | ||
concatMap (("\n | " ++) . prRule) rules ++ | ||
"\n" | ||
|
||
prRule (fun, []) = fun | ||
prRule (fun,cats) = fun +++ "of" +++ render (mkTupleType cats) | ||
|
||
-- | Creates an FSharp type tuple by intercalating * between type names | ||
-- >>> mkTupleType [Cat "A"] | ||
-- A | ||
-- | ||
-- >>> mkTupleType [Cat "A", Cat "Abc", Cat "S"] | ||
-- A * Abc * S | ||
mkTupleType :: [Cat] -> Doc | ||
mkTupleType = hsep . intersperse (char '*') . map (text . fixType) | ||
|
||
prSpecialData :: CF -> TokenCat -> String | ||
prSpecialData cf cat = fixType (TokenCat cat) +++ "=" +++ fixType (TokenCat cat) +++ "of" +++ contentSpec cf cat | ||
|
||
-- unwords ["newtype",cat,"=",cat,contentSpec cf cat,"deriving (Eq,Ord,Show)"] | ||
|
||
contentSpec :: CF -> TokenCat -> String | ||
contentSpec cf cat | ||
| isPositionCat cf cat = "((int * int) * string)" | ||
| otherwise = "string" |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
My testParserRule also does not correspond to a file name. Should I add it here?
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Yes, please.