From 1e4ab95e418fd704d414b85524d94ae64175b179 Mon Sep 17 00:00:00 2001
From: Krasimir Angelov <kr.angelov@gmail.com>
Date: Tue, 29 Aug 2017 20:53:47 +0200
Subject: [PATCH] added option -output-format=java for producing code for
 embedded grammars in Java

---
 gf.cabal                             |  1 +
 src/compiler/GF/Compile/Export.hs    |  2 ++
 src/compiler/GF/Compile/PGFtoJava.hs | 44 ++++++++++++++++++++++++++++
 src/compiler/GF/Infra/Option.hs      |  2 ++
 4 files changed, 49 insertions(+)
 create mode 100644 src/compiler/GF/Compile/PGFtoJava.hs

diff --git a/gf.cabal b/gf.cabal
index 120b11b2f..54c0ad4e1 100644
--- a/gf.cabal
+++ b/gf.cabal
@@ -195,6 +195,7 @@ Library
     GF.Compile.Multi
     GF.Compile.Optimize
     GF.Compile.PGFtoHaskell
+    GF.Compile.PGFtoJava
     GF.Haskell
     GF.Compile.ConcreteToHaskell
     GF.Compile.PGFtoJS
diff --git a/src/compiler/GF/Compile/Export.hs b/src/compiler/GF/Compile/Export.hs
index 5518d2ee2..b8b8ed1ac 100644
--- a/src/compiler/GF/Compile/Export.hs
+++ b/src/compiler/GF/Compile/Export.hs
@@ -3,6 +3,7 @@ module GF.Compile.Export where
 import PGF
 import PGF.Internal(ppPGF)
 import GF.Compile.PGFtoHaskell
+import GF.Compile.PGFtoJava
 import GF.Compile.PGFtoProlog
 import GF.Compile.PGFtoLProlog
 import GF.Compile.PGFtoJS
@@ -37,6 +38,7 @@ exportPGF opts fmt pgf =
       FmtJavaScript   -> multi "js"  pgf2js
       FmtPython       -> multi "py"  pgf2python
       FmtHaskell      -> multi "hs"  (grammar2haskell opts name)
+      FmtJava         -> multi "java" (grammar2java opts name)
       FmtProlog       -> multi "pl"  grammar2prolog
       FmtLambdaProlog -> multi "mod" grammar2lambdaprolog_mod ++ multi "sig" grammar2lambdaprolog_sig
       FmtBNF          -> single "bnf"   bnfPrinter
diff --git a/src/compiler/GF/Compile/PGFtoJava.hs b/src/compiler/GF/Compile/PGFtoJava.hs
new file mode 100644
index 000000000..9aa7412a0
--- /dev/null
+++ b/src/compiler/GF/Compile/PGFtoJava.hs
@@ -0,0 +1,44 @@
+module GF.Compile.PGFtoJava (grammar2java) where
+
+import PGF
+import Data.Maybe(maybe)
+import Data.List(intercalate)
+import GF.Infra.Option
+
+-- | the main function
+grammar2java :: Options
+                -> String  -- ^ Module name.
+                -> PGF
+                -> String
+grammar2java opts name gr = unlines $  
+  javaPreamble name ++ methods ++ javaEnding
+  where
+    methods = [javaMethod gr fun | fun <- functions gr]
+
+javaPreamble name =
+ [
+  "import org.grammaticalframework.pgf.*;",
+  "",
+  "public class " ++ name ++ " {",
+  ""
+ ]
+ 
+javaMethod gr fun =
+  "  public static Expr "++name++"("++arg_decls++") { return new Expr("++show name++args++"); }"
+  where
+    name  = showCId fun
+    arity = maybe 0 getArrity (functionType gr fun)
+    vars  = ['e':show i | i <- [1..arity]]
+    
+    arg_decls = intercalate "," ["Expr "++v | v <- vars]
+    args      = if null vars then ",new Expr[] {}" else ","++intercalate "," vars
+
+    getArrity ty = length hypos
+      where
+        (hypos,_,_) = unType ty
+
+javaEnding =
+ [
+  "",
+  "}"
+ ]
diff --git a/src/compiler/GF/Infra/Option.hs b/src/compiler/GF/Infra/Option.hs
index 48cb25cc7..efd59ca0b 100644
--- a/src/compiler/GF/Infra/Option.hs
+++ b/src/compiler/GF/Infra/Option.hs
@@ -90,6 +90,7 @@ data OutputFormat = FmtPGFPretty
                   | FmtJavaScript 
                   | FmtPython 
                   | FmtHaskell 
+                  | FmtJava
                   | FmtProlog
                   | FmtLambdaProlog
                   | FmtByteCode
@@ -475,6 +476,7 @@ outputFormatsExpl =
      (("js",           FmtJavaScript),"JavaScript (whole grammar)"),
      (("python",       FmtPython),"Python (whole grammar)"),
      (("haskell",      FmtHaskell),"Haskell (abstract syntax)"),
+     (("java",         FmtJava),"Java (abstract syntax)"),
      (("prolog",       FmtProlog),"Prolog (whole grammar)"),
      (("lambda_prolog",FmtLambdaProlog),"LambdaProlog (abstract syntax)"),
      (("lp_byte_code", FmtByteCode),"Bytecode for Teyjus (abstract syntax, experimental)"),