the experimental export to Lambda Prolog is now obsolete and is removed

gf.cabal

@@ -196,7 +196,6 @@ Library
     GF.Haskell
     GF.Compile.ConcreteToHaskell
     GF.Compile.PGFtoJS
-    GF.Compile.PGFtoLProlog
     GF.Compile.PGFtoProlog
     GF.Compile.PGFtoPython
     GF.Compile.ReadFiles

src/compiler/GF/Compile/Export.hs

@@ -5,7 +5,6 @@ import PGF.Internal(ppPGF)
 import GF.Compile.PGFtoHaskell
 import GF.Compile.PGFtoJava
 import GF.Compile.PGFtoProlog
-import GF.Compile.PGFtoLProlog
 import GF.Compile.PGFtoJS
 import GF.Compile.PGFtoPython
 import GF.Infra.Option
@@ -40,7 +39,6 @@ exportPGF opts fmt pgf =
       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
       FmtEBNF         -> single "ebnf"  (ebnfPrinter opts)
       FmtSRGS_XML     -> single "grxml" (srgsXmlPrinter opts)

src/compiler/GF/Compile/PGFtoLProlog.hs

@@ -1,164 +0,0 @@
-module GF.Compile.PGFtoLProlog(grammar2lambdaprolog_mod, grammar2lambdaprolog_sig) where
-
-import PGF(mkCId,ppCId,showCId,wildCId)
-import PGF.Internal hiding (ppExpr,ppType,ppHypo,ppCat,ppFun)
---import PGF.Macros
-import Data.List
-import Data.Maybe
-import GF.Text.Pretty
-import qualified Data.Map as Map
---import Debug.Trace
-
-grammar2lambdaprolog_mod pgf = render $
-  "module" <+> ppCId (absname pgf) <> '.' $$
-  ' ' $$
-  vcat [ppClauses cat fns | (cat,(_,fs,_)) <- Map.toList (cats (abstract pgf)),
-                            let fns = [(f,fromJust (Map.lookup f (funs (abstract pgf)))) | (_,f) <- fs]]
-  where
-    ppClauses cat fns =
-      "/*" <+> ppCId cat <+> "*/" $$
-      vcat [snd (ppClause (abstract pgf) 0 1 [] f ty) <> dot | (f,(ty,_,Nothing,_)) <- fns] $$
-      ' ' $$
-      vcat [vcat (map (\eq -> equation2clause (abstract pgf) f eq <> dot) eqs) | (f,(_,_,Just (eqs,_),_)) <- fns] $$
-      ' '
-
-grammar2lambdaprolog_sig pgf = render $
-  "sig" <+> ppCId (absname pgf) <> '.' $$
-  ' ' $$
-  vcat [ppCat c hyps <> dot | (c,(hyps,_,_)) <- Map.toList (cats (abstract pgf))] $$
-  ' ' $$
-  vcat [ppFun f ty <> dot | (f,(ty,_,Nothing,_)) <- Map.toList (funs (abstract pgf))] $$
-  ' ' $$
-  vcat [ppExport c hyps <> dot | (c,(hyps,_,_)) <- Map.toList (cats (abstract pgf))] $$
-  vcat [ppFunPred f (hyps ++ [(Explicit,wildCId,DTyp [] c es)]) <> dot | (f,(DTyp hyps c es,_,Just _,_)) <- Map.toList (funs (abstract pgf))]
-
-ppCat :: CId -> [Hypo] -> Doc
-ppCat c hyps = "kind" <+> ppKind c <+> "type"
-
-ppFun :: CId -> Type -> Doc
-ppFun f ty = "type" <+> ppCId f <+> ppType 0 ty
-
-ppExport :: CId -> [Hypo] -> Doc
-ppExport c hyps = "exportdef" <+> ppPred c <+> foldr (\hyp doc -> ppHypo 1 hyp <+> "->" <+> doc) (pp "o") (hyp:hyps)
-  where
-    hyp = (Explicit,wildCId,DTyp [] c [])
-
-ppFunPred :: CId -> [Hypo] -> Doc
-ppFunPred c hyps = "exportdef" <+> ppCId c <+> foldr (\hyp doc -> ppHypo 1 hyp <+> "->" <+> doc) (pp "o") hyps
-
-ppClause :: Abstr -> Int -> Int -> [CId] -> CId -> Type -> (Int,Doc)
-ppClause abstr d i scope f ty@(DTyp hyps cat args)
-  | null hyps = let res = EFun f
-                    (goals,i',head) = ppRes i scope cat (res : args)
-                in (i',(if null goals
-                          then empty
-                          else hsep (punctuate ',' (map (ppExpr 0 i' scope) goals)) <> ',')
-                       <+>
-                       head)
-  | otherwise = let (i',vars,scope',hdocs) = ppHypos i [] scope hyps (depType [] ty)
-                    res  = foldl EApp (EFun f) (map EFun (reverse vars))
-                    quants = if d > 0
-                               then hsep (map (\v -> "pi" <+> ppCId v <+> '\\') vars)
-                               else empty
-                    (goals,i'',head) = ppRes i' scope' cat (res : args)
-                    docs = map (ppExpr 0 i'' scope') goals ++ hdocs
-                in (i'',ppParens (d > 0) (quants <+> head <+> 
-                                          (if null docs
-                                             then empty
-                                             else ":-" <+> hsep (punctuate ',' docs))))
-  where
-    ppRes i scope cat es = 
-       let ((goals,i'),es') = mapAccumL (\(goals,i) e -> let (goals',i',e') = expr2goal abstr scope goals i e []
-                                                         in ((goals',i'),e')) ([],i) es
-       in (goals,i',ppParens (d > 3) (ppPred cat <+> hsep (map (ppExpr 4 i' scope) es')))
-
-    ppHypos :: Int -> [CId] -> [CId] -> [(BindType,CId,Type)] -> [Int] -> (Int,[CId],[CId],[Doc])
-    ppHypos i vars scope [] []
-                     = (i,vars,scope,[])
-    ppHypos i vars scope ((_,x,typ):hyps) (c:cs)
-      | x /= wildCId = let v = mkVar i
-                           (i',doc) = ppClause abstr 1 (i+1) scope v typ
-                           (i'',vars',scope',docs) = ppHypos i' (v:vars) (v:scope) hyps cs
-                       in (i'',vars',scope',if c == 0 then doc : docs else docs)
-    ppHypos i vars scope ((_,x,typ):hyps)    cs
-                     = let v = mkVar i
-                           (i',doc) = ppClause abstr 1 (i+1) scope v typ
-                           (i'',vars',scope',docs) = ppHypos i' (v:vars)    scope  hyps cs
-                       in (i'',vars',scope',doc : docs)
-
-mkVar i = mkCId ("X_"++show i)
-
-ppPred :: CId -> Doc
-ppPred cat = "p_" <> ppCId cat
-
-ppKind :: CId -> Doc
-ppKind cat = "k_" <> ppCId cat
-
-ppType :: Int -> Type -> Doc
-ppType d (DTyp hyps cat args)
-  | null hyps = ppKind cat
-  | otherwise = ppParens (d > 0) (foldr (\hyp doc -> ppHypo 1 hyp <+> "->" <+> doc) (ppKind cat) hyps)
-
-ppHypo d (_,_,typ) = ppType d typ
-
-ppExpr d i scope (EAbs b x e) = let v = mkVar i
-                                in ppParens (d > 1) (ppCId v <+> '\\' <+> ppExpr 1 (i+1) (v:scope) e)
-ppExpr d i scope (EApp e1 e2) = ppParens (d > 3) ((ppExpr 3 i scope e1) <+> (ppExpr 4 i scope e2))
-ppExpr d i scope (ELit l)     = ppLit l
-ppExpr d i scope (EMeta n)    = ppMeta n
-ppExpr d i scope (EFun f)     = ppCId f
-ppExpr d i scope (EVar j)     = ppCId (scope !! j)
-ppExpr d i scope (ETyped e ty)= ppExpr d i scope e
-ppExpr d i scope (EImplArg e) = ppExpr 0 i scope e
-
-dot = '.'
-
-depType counts (DTyp hyps cat es) =
-  foldl' depExpr (foldl' depHypo counts hyps) es
-
-depHypo counts (_,x,ty)
-  | x == wildCId =   depType counts ty
-  | otherwise    = 0:depType counts ty
-
-depExpr counts (EAbs b x e) = tail (depExpr (0:counts) e)
-depExpr counts (EApp e1 e2) = depExpr (depExpr counts e1) e2
-depExpr counts (ELit l)     = counts
-depExpr counts (EMeta n)    = counts
-depExpr counts (EFun f)     = counts
-depExpr counts (EVar j)     = let (xs,c:ys) = splitAt j counts
-                              in xs++(c+1):ys
-depExpr counts (ETyped e ty)= depExpr counts e
-depExpr counts (EImplArg e) = depExpr counts e
-
-equation2clause abstr f (Equ ps e) =
-  let scope0 = foldl pattScope [] ps
-      scope  = [mkVar i | i <- [0..n-1]]
-      n = length scope0
-      
-      es = map (patt2expr scope0) ps
-
-      (goals,_,goal) = expr2goal abstr scope [] n e []
-
-  in ppCId f <+> hsep (map (ppExpr 4 n scope) (es++[goal])) <+> 
-     if null goals
-       then empty
-       else ":-" <+> hsep (punctuate ',' (map (ppExpr 0 n scope) (reverse goals)))
-
-
-patt2expr scope (PApp f ps) = foldl EApp (EFun f) (map (patt2expr scope) ps)
-patt2expr scope (PLit l)    = ELit l
-patt2expr scope (PVar x)    = case findIndex (==x) scope of
-                                Just i  -> EVar i
-                                Nothing -> error ("unknown variable "++showCId x)
-patt2expr scope (PImplArg p)= EImplArg (patt2expr scope p)
-
-expr2goal abstr scope goals i (EApp e1 e2) args =
-  let (goals',i',e2') = expr2goal abstr scope goals i e2 []
-  in expr2goal abstr scope goals' i' e1 (e2':args)
-expr2goal abstr scope goals i (EFun f)     args =
-  case Map.lookup f (funs abstr) of
-    Just (_,_,Just _,_) -> let e = EFun (mkVar i)
-                           in (foldl EApp (EFun f) (args++[e]) : goals, i+1, e)
-    _                   -> (goals,i,foldl EApp (EFun f) args)
-expr2goal abstr scope goals i (EVar j)     args =
-  (goals,i,foldl EApp (EVar j) args)

src/compiler/GF/Compiler.hs

@@ -56,7 +56,7 @@ compileSourceFiles opts fs =
                                return (t,[cnc_gr])
 
     cncs2haskell output =
-      when (FmtHaskell `elem` outputFormats opts &&
+      when (FmtHaskell `elem` flag optOutputFormats opts &&
             haskellOption opts HaskellConcrete) $
         mapM_ cnc2haskell (snd output)
 
@@ -130,7 +130,7 @@ unionPGFFiles opts fs =
 writeOutputs :: Options -> PGF -> IOE ()
 writeOutputs opts pgf = do
   sequence_ [writeOutput opts name str 
-                 | fmt <- outputFormats opts,
+                 | fmt <- flag optOutputFormats opts,
                    (name,str) <- exportPGF opts fmt pgf]
 
 -- | Write the result of compiling a grammar (e.g. with 'compileToPGF' or
@@ -163,7 +163,6 @@ grammarName :: Options -> PGF -> String
 grammarName opts pgf = grammarName' opts (showCId (abstractName pgf))
 grammarName' opts abs = fromMaybe abs (flag optName opts)
 
-outputFormats opts = [fmt | fmt <- flag optOutputFormats opts, fmt/=FmtByteCode]
 outputJustPGF opts = null (flag optOutputFormats opts) && not (flag optSplitPGF opts)
 
 outputPath opts file = maybe id (</>) (flag optOutputDir opts) file

src/compiler/GF/Infra/Option.hs

@@ -92,8 +92,6 @@ data OutputFormat = FmtPGFPretty
                   | FmtHaskell 
                   | FmtJava
                   | FmtProlog
-                  | FmtLambdaProlog
-                  | FmtByteCode
                   | FmtBNF
                   | FmtEBNF
                   | FmtRegular
@@ -478,8 +476,6 @@ outputFormatsExpl =
      (("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)"),
      (("bnf",          FmtBNF),"BNF (context-free grammar)"),
      (("ebnf",         FmtEBNF),"Extended BNF"),
      (("regular",      FmtRegular),"* regular grammar"),