gf 3.11.0 → 3.12

raw patch · 39 files changed

+592/−239 lines, 39 filesdep +template-haskelldep ~basedep ~bytestringdep ~ghc-primsetup-changednew-uploader

Dependencies added: template-haskell

Dependency ranges changed: base, bytestring, ghc-prim, json, mtl, network, time, transformers-compat, unix

Files

CHANGELOG.md +12/−0
README.md +69/−0
Setup.hs +48/−33
gf.cabal +28/−27
src/compiler/GF/Command/Commands.hs +34/−26
src/compiler/GF/Command/CommonCommands.hs +6/−0
src/compiler/GF/Command/TreeOperations.hs +21/−2
src/compiler/GF/Compile/Compute/Concrete.hs +9/−9
src/compiler/GF/Compile/GeneratePMCFG.hs +2/−2
src/compiler/GF/Compile/GetGrammar.hs +2/−1
src/compiler/GF/Compile/PGFtoHaskell.hs +1/−1
src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs +2/−2
src/compiler/GF/CompileInParallel.hs +9/−9
src/compiler/GF/Data/BacktrackM.hs +2/−2
src/compiler/GF/Data/ErrM.hs +2/−2
src/compiler/GF/Grammar/Grammar.hs +15/−4
src/compiler/GF/Grammar/Lexer.x +11/−4
src/compiler/GF/Grammar/Parser.y +16/−2
src/compiler/GF/Infra/BuildInfo.hs +23/−2
src/compiler/GF/Infra/CheckM.hs +2/−2
src/compiler/GF/Infra/SIO.hs +2/−2
src/compiler/GF/Interactive.hs +4/−1
src/compiler/GF/Interactive2.hs +1/−1
src/compiler/GF/Main.hs +6/−1
src/compiler/GF/Text/Coding.hs +1/−1
src/runtime/haskell-bind/PGF2.hsc +4/−1
src/runtime/haskell/Data/Binary/Builder.hs +19/−3
src/runtime/haskell/Data/Binary/Get.hs +20/−2
src/runtime/haskell/Data/Binary/Put.hs +8/−6
src/runtime/haskell/PGF.hs +1/−1
src/runtime/haskell/PGF/Expr.hs +15/−4
src/runtime/haskell/PGF/Linearize.hs +1/−1
src/runtime/haskell/PGF/TypeCheck.hs +10/−5
src/runtime/haskell/PGF/VisualizeTree.hs +1/−0
src/server/CGIUtils.hs +5/−0
src/server/PGFService.hs +8/−6
src/www/gf-web-api.html +170/−73
src/www/index.html +1/−1
testsuite/run.hs +1/−0

+ CHANGELOG.md view

@@ -0,0 +1,12 @@+### New since 3.12 (WIP)++### 3.12+See <https://www.grammaticalframework.org/download/release-3.12.html>++### 3.11++See <https://www.grammaticalframework.org/download/release-3.11.html>++### 3.10++See <https://www.grammaticalframework.org/download/release-3.10.html>

+ README.md view

@@ -0,0 +1,69 @@+![GF Logo](https://www.grammaticalframework.org/doc/Logos/gf1.svg)++# Grammatical Framework (GF)++The Grammatical Framework is a grammar formalism based on type theory.+It consists of:++- a special-purpose programming language+- a compiler of the language+- a generic grammar processor++The compiler reads GF grammars from user-provided files, and the+generic grammar processor performs various tasks with the grammars:++- generation+- parsing+- translation+- type checking+- computation+- paraphrasing+- random generation+- syntax editing++GF particularly addresses four aspects of grammars:++- multilinguality (parallel grammars for different languages)+- semantics (semantic conditions of well-formedness, semantic properties of expressions)+- grammar engineering (modularity, abstractions, libraries)+- embeddability in programs written in other languages (C, C++, Haskell, Java, JavaScript)++## Compilation and installation++The simplest way of installing GF from source is with the command:+```+cabal install+```+or:+```+stack install+```+Note that if you are unlucky to have Cabal 3.0 or later, then it uses+the so-called Nix style commands. Using those for GF development is+a pain. Every time when you change something in the source code, Cabal+will generate a new folder for GF to look for the GF libraries and+the GF cloud. Either reinstall everything with every change in the+compiler, or be sane and stop using cabal-install. Instead you can do:+```+runghc Setup.hs configure+runghc Setup.hs build+sudo runghc Setup.hs install+```+The script will install the GF dependencies globally. The only solution+to the Nix madness that I found is radical:++  "No person, no problem" (Нет человека – нет проблемы).++For more information, including links to precompiled binaries, see the [download page](https://www.grammaticalframework.org/download/index.html).++## About this repository++On 2018-07-25, the monolithic [GF repository](https://github.com/GrammaticalFramework/GF)+was split in two:++1. [gf-core](https://github.com/GrammaticalFramework/gf-core) —  the GF compiler, shell and runtimes+2. [gf-rgl](https://github.com/GrammaticalFramework/gf-rgl) — the resource grammar library++The former repository is now archived and no longer updated.+The split was performed using [this script](https://github.com/GrammaticalFramework/GF/blob/30ae1b5a5f73513ac5825ca6712186ef8afe9fd4/split/run.sh)+and the output of that script is [here](https://gist.github.com/johnjcamilleri/a6c43ff61f15a9657b457ac94ab7db61).

Setup.hs view

@@ -4,42 +4,68 @@ import Distribution.Simple.Setup(BuildFlags(..),Flag(..),InstallFlags(..),CopyDest(..),CopyFlags(..),SDistFlags(..)) import Distribution.PackageDescription(PackageDescription(..),emptyHookedBuildInfo) import Distribution.Simple.BuildPaths(exeExtension)+import System.Directory import System.FilePath((</>),(<.>))+import System.Process+import Control.Monad(forM_,unless)+import Control.Exception(bracket_)+import Data.Char(isSpace)  import WebSetup --- | Notice about RGL not built anymore-noRGLmsg :: IO ()-noRGLmsg = putStrLn "Notice: the RGL is not built as part of GF anymore. See https://github.com/GrammaticalFramework/gf-rgl"- main :: IO () main = defaultMainWithHooks simpleUserHooks-  { preBuild  = gfPreBuild+  { preConf   = gfPreConf+  , preBuild  = gfPreBuild   , postBuild = gfPostBuild   , preInst   = gfPreInst   , postInst  = gfPostInst   , postCopy  = gfPostCopy   }   where-    gfPreBuild args  = gfPre args . buildDistPref-    gfPreInst args = gfPre args . installDistPref+    gfPreConf args flags = do+      pkgs <- fmap (map (dropWhile isSpace) . tail . lines)+                   (readProcess "ghc-pkg" ["list"] "")+      forM_ dependencies $ \pkg -> do+        let name = takeWhile (/='/') (drop 36 pkg)+        unless (name `elem` pkgs) $ do+          let fname = name <.> ".tar.gz"+          callProcess "wget" [pkg,"-O",fname]+          callProcess "tar"  ["-xzf",fname]+          removeFile fname+          bracket_ (setCurrentDirectory name) (setCurrentDirectory ".." >> removeDirectoryRecursive name) $ do+            exists <- doesFileExist "Setup.hs"+            unless exists $ do+              writeFile "Setup.hs" (unlines [+                  "import Distribution.Simple",+                  "main = defaultMain"+                ])+            let to_descr = reverse .+                           (++) (reverse ".cabal") . +                           drop 1 . +                           dropWhile (/='-') . +                           reverse+            callProcess "wget"   [to_descr pkg, "-O", to_descr name]+            callProcess "runghc" ["Setup.hs","configure"]+            callProcess "runghc" ["Setup.hs","build"]+            callProcess "sudo" ["runghc","Setup.hs","install"]+          +      preConf simpleUserHooks args flags +    gfPreBuild args = gfPre args . buildDistPref+    gfPreInst  args = gfPre args . installDistPref+     gfPre args distFlag = do       return emptyHookedBuildInfo      gfPostBuild args flags pkg lbi = do-      -- noRGLmsg       let gf = default_gf lbi       buildWeb gf flags (pkg,lbi)      gfPostInst args flags pkg lbi = do-      -- noRGLmsg-      saveInstallPath args flags (pkg,lbi)       installWeb (pkg,lbi)      gfPostCopy args flags  pkg lbi = do-      -- noRGLmsg-      saveCopyPath args flags (pkg,lbi)       copyWeb flags (pkg,lbi)      -- `cabal sdist` will not make a proper dist archive, for that see `make sdist`@@ -47,27 +73,16 @@     gfSDist pkg lbi hooks flags = do       return () -saveInstallPath :: [String] -> InstallFlags -> (PackageDescription, LocalBuildInfo) -> IO ()-saveInstallPath args flags bi = do-  let-    dest = NoCopyDest-    dir = datadir (uncurry absoluteInstallDirs bi dest)-  writeFile dataDirFile dir--saveCopyPath :: [String] -> CopyFlags -> (PackageDescription, LocalBuildInfo) -> IO ()-saveCopyPath args flags bi = do-  let-    dest = case copyDest flags of-      NoFlag -> NoCopyDest-      Flag d -> d-    dir = datadir (uncurry absoluteInstallDirs bi dest)-  writeFile dataDirFile dir---- | Name of file where installation's data directory is recording--- This is a last-resort way in which the seprate RGL build script--- can determine where to put the compiled RGL files-dataDirFile :: String-dataDirFile = "DATA_DIR"+dependencies = [+  "https://hackage.haskell.org/package/utf8-string-1.0.2/utf8-string-1.0.2.tar.gz",+  "https://hackage.haskell.org/package/json-0.10/json-0.10.tar.gz",+  "https://hackage.haskell.org/package/network-bsd-2.8.1.0/network-bsd-2.8.1.0.tar.gz",+  "https://hackage.haskell.org/package/httpd-shed-0.4.1.1/httpd-shed-0.4.1.1.tar.gz",+  "https://hackage.haskell.org/package/exceptions-0.10.5/exceptions-0.10.5.tar.gz",+  "https://hackage.haskell.org/package/stringsearch-0.3.6.6/stringsearch-0.3.6.6.tar.gz",+  "https://hackage.haskell.org/package/multipart-0.2.1/multipart-0.2.1.tar.gz",+  "https://hackage.haskell.org/package/cgi-3001.5.0.0/cgi-3001.5.0.0.tar.gz"+  ]  -- | Get path to locally-built gf default_gf :: LocalBuildInfo -> FilePath

gf.cabal view

@@ -1,8 +1,8 @@ name: gf-version: 3.11.0+version: 3.12  cabal-version: 1.22-build-type: Custom+build-type: Simple license: OtherLicense license-file: LICENSE category: Natural Language Processing, Compiler@@ -11,10 +11,12 @@ maintainer: John J. Camilleri <john@digitalgrammars.com> homepage: https://www.grammaticalframework.org/ bug-reports: https://github.com/GrammaticalFramework/gf-core/issues-tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.10.4+tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.10.4, GHC==9.0.2, GHC==9.2.4, GHC==9.6.7  data-dir: src extra-source-files:+  README.md+  CHANGELOG.md   WebSetup.hs   doc/Logos/gf0.png data-files:@@ -42,14 +44,6 @@   www/translator/*.css   www/translator/*.js -custom-setup-  setup-depends:-    base >= 4.9.1 && < 4.15,-    Cabal >= 1.22.0.0,-    directory >= 1.3.0 && < 1.4,-    filepath >= 1.4.1 && < 1.5,-    process >= 1.0.1.1 && < 1.7- source-repository head   type: git   location: https://github.com/GrammaticalFramework/gf-core.git@@ -79,20 +73,20 @@   build-depends:     -- GHC 8.0.2 to GHC 8.10.4     array >= 0.5.1 && < 0.6,-    base >= 4.9.1 && < 4.15,-    bytestring >= 0.10.8 && < 0.11,+    base >= 4.9.1 && < 4.22,+    bytestring >= 0.10.8 && < 0.12,     containers >= 0.5.7 && < 0.7,     exceptions >= 0.8.3 && < 0.11,-    ghc-prim >= 0.5.0 && < 0.7,-    mtl >= 2.2.1 && < 2.3,+    ghc-prim >= 0.5.0 && <= 0.10.0,+    mtl >= 2.2.1 && <= 2.3.1,     pretty >= 1.1.3 && < 1.2,     random >= 1.1 && < 1.3,-    utf8-string >= 1.0.1.1 && < 1.1,-    -- We need transformers-compat >= 0.6.3, but that is only in newer snapshots where it is redundant.-    transformers-compat >= 0.5.1.4 && < 0.7+    utf8-string >= 1.0.1.1 && < 1.1    if impl(ghc<8.0)     build-depends:+      -- We need this in order for ghc-7.10 to build+      transformers-compat >= 0.6.3 && < 0.7,       fail >= 4.9.0 && < 4.10    hs-source-dirs: src/runtime/haskell@@ -161,10 +155,11 @@     directory >= 1.3.0 && < 1.4,     filepath >= 1.4.1 && < 1.5,     haskeline >= 0.7.3 && < 0.9,-    json >= 0.9.1 && < 0.11,+    json >= 0.9.1 && <= 0.11,     parallel >= 3.2.1.1 && < 3.3,     process >= 1.4.3 && < 1.7,-    time >= 1.6.0 && < 1.10+    time >= 1.6.0 && <= 1.12.2,+    template-haskell >= 2.13.0.0 && < 2.21    hs-source-dirs: src/compiler   exposed-modules:@@ -300,14 +295,14 @@     build-depends:       cgi >= 3001.3.0.2 && < 3001.6,       httpd-shed >= 0.4.0 && < 0.5,-      network>=2.3 && <2.7+      network>=2.3 && <3.2     if flag(network-uri)       build-depends:         network-uri >= 2.6.1.0 && < 2.7,-        network>=2.6 && <2.7+        network>=2.6 && <3.2     else       build-depends:-        network >= 2.5 && <2.6+        network >= 2.5 && <3.2      cpp-options: -DSERVER_MODE     other-modules:@@ -352,9 +347,15 @@       Win32 >= 2.3.1.1 && < 2.7   else     build-depends:-      terminfo >=0.4.0 && < 0.5,-      unix >= 2.7.2 && < 2.8+      terminfo >=0.4.0 && < 0.5 +    if impl(ghc >= 9.6.6)+      build-depends: unix >= 2.8 && < 2.9++    else+      build-depends: unix >= 2.7.2 && < 2.8++   if impl(ghc>=8.2)     ghc-options: -fhide-source-paths @@ -364,7 +365,7 @@   default-language: Haskell2010   build-depends:     gf,-    base+    base >= 4.9.1 && < 4.22   ghc-options: -threaded --ghc-options: -fwarn-unused-imports @@ -398,7 +399,7 @@   main-is: run.hs   hs-source-dirs: testsuite   build-depends:-    base >= 4.9.1 && < 4.15,+    base >= 4.9.1 && < 4.22,     Cabal >= 1.8,     directory >= 1.3.0 && < 1.4,     filepath >= 1.4.1 && < 1.5,

src/compiler/GF/Command/Commands.hs view

@@ -4,6 +4,7 @@   options,flags,   ) where import Prelude hiding (putStrLn,(<>)) -- GHC 8.4.1 clash with Text.PrettyPrint+import System.Info(os)  import PGF @@ -21,6 +22,7 @@ import GF.Command.Abstract import GF.Command.CommandInfo import GF.Command.CommonCommands+import qualified GF.Command.CommonCommands as Common import GF.Text.Clitics import GF.Quiz @@ -165,14 +167,15 @@      synopsis = "generate random trees in the current abstract syntax",      syntax = "gr [-cat=CAT] [-number=INT]",      examples = [-       mkEx "gr                     -- one tree in the startcat of the current grammar",-       mkEx "gr -cat=NP -number=16  -- 16 trees in the category NP",-       mkEx "gr -lang=LangHin,LangTha -cat=Cl  -- Cl, both in LangHin and LangTha",-       mkEx "gr -probs=FILE         -- generate with bias",-       mkEx "gr (AdjCN ? (UseN ?))  -- generate trees of form (AdjCN ? (UseN ?))"+       mkEx $ "gr                     -- one tree in the startcat of the current grammar, up to depth " ++ Common.default_depth_str,+       mkEx   "gr -cat=NP -number=16  -- 16 trees in the category NP",+       mkEx   "gr -cat=NP -depth=2    -- one tree in the category NP, up to depth 2",+       mkEx   "gr -lang=LangHin,LangTha -cat=Cl  -- Cl, both in LangHin and LangTha",+       mkEx   "gr -probs=FILE         -- generate with bias",+       mkEx   "gr (AdjCN ? (UseN ?))  -- generate trees of form (AdjCN ? (UseN ?))"        ],      explanation = unlines [-       "Generates a list of random trees, by default one tree.",+       "Generates a list of random trees, by default one tree up to depth " ++ Common.default_depth_str ++ ".",        "If a tree argument is given, the command completes the Tree with values to",        "all metavariables in the tree. The generation can be biased by probabilities,",        "given in a file in the -probs flag."@@ -181,13 +184,13 @@        ("cat","generation category"),        ("lang","uses only functions that have linearizations in all these languages"),        ("number","number of trees generated"),-       ("depth","the maximum generation depth"),+       ("depth","the maximum generation depth (default: " ++ Common.default_depth_str ++ ")"),        ("probs", "file with biased probabilities (format 'f 0.4' one by line)")        ],      exec = getEnv $ \ opts arg (Env pgf mos) -> do        pgf <- optProbs opts (optRestricted opts pgf)        gen <- newStdGen-       let dp = valIntOpts "depth" 4 opts+       let dp = valIntOpts "depth" Common.default_depth opts        let ts  = case mexp (toExprs arg) of                    Just ex -> generateRandomFromDepth gen pgf ex (Just dp)                    Nothing -> generateRandomDepth     gen pgf (optType pgf opts) (Just dp)@@ -198,28 +201,28 @@      synopsis = "generates a list of trees, by default exhaustive",      explanation = unlines [        "Generates all trees of a given category. By default, ",-       "the depth is limited to 4, but this can be changed by a flag.",+       "the depth is limited to " ++ Common.default_depth_str ++ ", but this can be changed by a flag.",        "If a Tree argument is given, the command completes the Tree with values",        "to all metavariables in the tree."        ],      flags = [        ("cat","the generation category"),-       ("depth","the maximum generation depth"),+       ("depth","the maximum generation depth (default: " ++ Common.default_depth_str ++ ")"),        ("lang","excludes functions that have no linearization in this language"),        ("number","the number of trees generated")        ],      examples = [-       mkEx "gt                     -- all trees in the startcat, to depth 4",-       mkEx "gt -cat=NP -number=16  -- 16 trees in the category NP",-       mkEx "gt -cat=NP -depth=2    -- trees in the category NP to depth 2",-       mkEx "gt (AdjCN ? (UseN ?))  -- trees of form (AdjCN ? (UseN ?))"+       mkEx $ "gt                     -- all trees in the startcat, to depth " ++ Common.default_depth_str,+       mkEx   "gt -cat=NP -number=16  -- 16 trees in the category NP",+       mkEx   "gt -cat=NP -depth=2    -- trees in the category NP to depth 2",+       mkEx   "gt (AdjCN ? (UseN ?))  -- trees of form (AdjCN ? (UseN ?))"        ],      exec = getEnv $ \ opts arg (Env pgf mos) -> do        let pgfr = optRestricted opts pgf-       let dp = valIntOpts "depth" 4 opts-       let ts = case mexp (toExprs arg) of-                  Just ex -> generateFromDepth pgfr ex (Just dp)-                  Nothing -> generateAllDepth pgfr (optType pgf opts) (Just dp)+       let dp = valIntOpts "depth" Common.default_depth opts+       let ts = case toExprs arg of+                  [] -> generateAllDepth pgfr (optType pgf opts) (Just dp)+                  es -> concat [generateFromDepth pgfr e (Just dp) | e <- es]        returnFromExprs $ take (optNumInf opts) ts      }),   ("i", emptyCommandInfo {@@ -427,7 +430,8 @@        "are type checking and semantic computation."        ],      examples = [-       mkEx "pt -compute (plus one two)                               -- compute value"+       mkEx "pt -compute (plus one two)                               -- compute value",+       mkEx ("p \"the 4 dogs\" | pt -transfer=digits2numeral | l  -- \"the four dogs\" ")        ],      exec = getEnv $ \ opts arg (Env pgf mos) ->             returnFromExprs . takeOptNum opts . treeOps pgf opts $ toExprs arg,@@ -545,7 +549,7 @@        "which is processed by dot (graphviz) and displayed by the program indicated",        "by the view flag. The target format is png, unless overridden by the",        "flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick).",-       "See also 'vp -showdep' for another visualization of dependencies." +       "See also 'vp -showdep' for another visualization of dependencies."        ],      exec = getEnv $ \ opts arg (Env pgf mos) -> do          let absname = abstractName pgf@@ -758,7 +762,7 @@                   []        -> [parse_ pgf lang (optType pgf opts) (Just dp) s | lang <- optLangs pgf opts]                   open_typs -> [parseWithRecovery pgf lang (optType pgf opts) open_typs (Just dp) s | lang <- optLangs pgf opts]      where-       dp = valIntOpts "depth" 4 opts+       dp = valIntOpts "depth" Common.default_depth opts     fromParse opts = foldr (joinPiped . fromParse1 opts) void @@ -798,9 +802,9 @@        _ | isOpt "tabtreebank" opts ->          return $ concat $ intersperse "\t" $ (showExpr [] t) :                    [s | lang <- optLangs pgf opts, s <- linear pgf opts lang t]-       _ | isOpt "chunks" opts -> map snd $ linChunks pgf opts t   +       _ | isOpt "chunks" opts -> map snd $ linChunks pgf opts t        _ -> [s | lang <- optLangs pgf opts, s<-linear pgf opts lang t]-   linChunks pgf opts t = +   linChunks pgf opts t =      [(lang, unwords (intersperse "<+>" (map (unlines . linear pgf opts lang) (treeChunks t)))) | lang <- optLangs pgf opts]     linear :: PGF -> [Option] -> CId -> Expr -> [String]@@ -882,11 +886,15 @@                        Right ty   -> ty           Nothing -> error ("Can't parse '"++str++"' as a type")    optViewFormat opts = valStrOpts "format" "png" opts-   optViewGraph opts = valStrOpts "view" "open" opts+   optViewGraph opts = valStrOpts "view" open_cmd opts    optNum opts = valIntOpts "number" 1 opts    optNumInf opts = valIntOpts "number" 1000000000 opts ---- 10^9    takeOptNum opts = take (optNumInf opts) +   open_cmd | os == "linux"   = "xdg-open"+            | os == "mingw32" = "start"+            | otherwise       = "open"+    returnFromExprs es = return $ case es of      [] -> pipeMessage "no trees found"      _  -> fromExprs es@@ -1000,13 +1008,13 @@   restrictedSystem $ "pdflatex " ++ texfile   restrictedSystem $ view ++ " " ++ pdffile   return void-  + ---- copied from VisualizeTree ; not sure about proper place AR Nov 2015 latexDoc :: [String] -> String latexDoc body = unlines $     "\\batchmode"   : "\\documentclass{article}"-  : "\\usepackage[utf8]{inputenc}"  +  : "\\usepackage[utf8]{inputenc}"   : "\\begin{document}"   : spaces body   ++ ["\\end{document}"]

src/compiler/GF/Command/CommonCommands.hs view

@@ -19,6 +19,12 @@  import qualified PGF as H(showCId,showExpr,toATree,toTrie,Trie(..)) +-- store default generation depth in a variable and use everywhere+default_depth :: Int+default_depth = 5+default_depth_str = show default_depth++ extend old new = Map.union (Map.fromList new) old -- Map.union is left-biased  commonCommands :: (Monad m,MonadSIO m) => Map.Map String (CommandInfo m)

src/compiler/GF/Command/TreeOperations.hs view

@@ -5,6 +5,8 @@   ) where  import PGF(Expr,PGF,CId,compute,mkApp,unApp,unapply,unMeta,exprSize,exprFunctions)+import PGF.Data(Expr(EApp,EFun))+import PGF.TypeCheck(inferExpr) import Data.List  type TreeOp = [Expr] -> [Expr]@@ -16,15 +18,17 @@ allTreeOps pgf = [    ("compute",("compute by using semantic definitions (def)",       Left  $ map (compute pgf))),+   ("transfer",("apply this transfer function to all maximal subtrees of suitable type",+      Right $ \f -> map (transfer pgf f))), -- HL 12/24, modified from gf-3.3    ("largest",("sort trees from largest to smallest, in number of nodes",       Left  $ largest)),-   ("nub",("remove duplicate trees",+   ("nub\t",("remove duplicate trees",       Left  $ nub)),    ("smallest",("sort trees from smallest to largest, in number of nodes",       Left  $ smallest)),    ("subtrees",("return all fully applied subtrees (stopping at abstractions), by default sorted from the largest",       Left  $ concatMap subtrees)),-   ("funs",("return all fun functions appearing in the tree, with duplications",+   ("funs\t",("return all fun functions appearing in the tree, with duplications",       Left  $ \es -> [mkApp f [] | e <- es, f <- exprFunctions e]))   ] @@ -48,3 +52,18 @@ subtrees t = t : case unApp t of   Just (f,ts) -> concatMap subtrees ts   _ -> []  -- don't go under abstractions++-- Apply transfer function f:C -> D to all maximal subtrees s:C of tree e and replace+-- these s by the values of f(s). This modifies the 'simple-minded transfer' of gf-3.3.+-- If applied to strict subtrees s of e, better use with f:C -> C only.  HL 12/2024++transfer :: PGF -> CId -> Expr -> Expr+transfer pgf f e = case inferExpr pgf (appf e) of+     Left _err -> case e of+                    EApp g a -> EApp (transfer pgf f g) (transfer pgf f a)+                    _ -> e+     Right _ty -> case (compute pgf (appf e)) of+                    v | v /= (appf e) -> v+                    _ -> e          -- default case of f, or f has no computation rule+ where+  appf = EApp (EFun f)

src/compiler/GF/Compile/Compute/Concrete.hs view

@@ -172,11 +172,11 @@     ImplArg t -> (VImplArg.) # value env t     Table p res -> liftM2 VTblType # value env p <# value env res     RecType rs -> do lovs <- mapPairsM (value env) rs-                     return $ \vs->VRecType $ mapSnd ($vs) lovs+                     return $ \vs->VRecType $ mapSnd ($ vs) lovs     t@(ExtR t1 t2) -> ((extR t.)# both id) # both (value env) (t1,t2)     FV ts   -> ((vfv .) # sequence) # mapM (value env) ts     R as    -> do lovs <- mapPairsM (value env.snd) as-                  return $ \ vs->VRec $ mapSnd ($vs) lovs+                  return $ \ vs->VRec $ mapSnd ($ vs) lovs     T i cs  -> valueTable env i cs     V ty ts -> do pvs <- paramValues env ty                   ((VV ty pvs .) . sequence) # mapM (value env) ts@@ -376,10 +376,10 @@   where     dynamic cs' ty _ = cases cs' # value env ty -    cases cs' vty vs = err keep ($vs) (convertv cs' (vty vs))+    cases cs' vty vs = err keep ($ vs) (convertv cs' (vty vs))       where         keep msg = --trace (msg++"\n"++render (ppTerm Unqualified 0 (T i cs))) $-                   VT wild (vty vs) (mapSnd ($vs) cs')+                   VT wild (vty vs) (mapSnd ($ vs) cs')      wild = case i of TWild _ -> True; _ -> False @@ -392,7 +392,7 @@     convert' cs' ((pty,vs),pvs) =       do sts  <- mapM (matchPattern cs') vs          return $ \ vs -> VV pty pvs $ map (err bug id . valueMatch env)-                                           (mapFst ($vs) sts)+                                           (mapFst ($ vs) sts)      valueCase (p,t) = do p' <- measurePatt # inlinePattMacro p                          pvs <- linPattVars p'@@ -430,19 +430,19 @@ apply' env t [] = value env t apply' env t vs =   case t of-    QC x                   -> return $ \ svs -> VCApp x (map ($svs) vs)+    QC x                   -> return $ \ svs -> VCApp x (map ($ svs) vs) {-     Q x@(m,f) | m==cPredef -> return $                               let constr = --trace ("predef "++show x) .                                            VApp x                               in \ svs -> maybe constr id (Map.lookup f predefs)-                                          $ map ($svs) vs+                                          $ map ($ svs) vs               | otherwise  -> do r <- resource env x-                                 return $ \ svs -> vapply (gloc env) r (map ($svs) vs)+                                 return $ \ svs -> vapply (gloc env) r (map ($ svs) vs) -}     App t1 t2              -> apply' env t1 . (:vs) =<< value env t2     _                      -> do fv <- value env t-                                 return $ \ svs -> vapply (gloc env) (fv svs) (map ($svs) vs)+                                 return $ \ svs -> vapply (gloc env) (fv svs) (map ($ svs) vs)  vapply :: GLocation -> Value -> [Value] -> Value vapply loc v [] = v

src/compiler/GF/Compile/GeneratePMCFG.hs view

@@ -201,11 +201,11 @@   fail = bug  instance Applicative CnvMonad where-  pure = return+  pure a = CM (\gr c s -> c a s)   (<*>) = ap  instance Monad CnvMonad where-    return a   = CM (\gr c s -> c a s)+    return     = pure     CM m >>= k = CM (\gr c s -> m gr (\a s -> unCM (k a) gr c s) s)  instance MonadState ([ProtoFCat],[Symbol]) CnvMonad where

src/compiler/GF/Compile/GetGrammar.hs view

@@ -42,11 +42,12 @@      raw <- liftIO $ keepTemp tmp    --ePutStrLn $ "1 "++file0      (optCoding,parsed) <- parseSource opts pModDef raw+     let indentLines = unlines . map ("   "++) . lines      case parsed of        Left (Pn l c,msg) -> do file <- liftIO $ writeTemp tmp                                cwd <- getCurrentDirectory                                let location = makeRelative cwd file++":"++show l++":"++show c-                               raise (location++":\n   "++msg)+                               raise (location++":\n" ++ indentLines msg)        Right (i,mi0) ->          do liftIO $ removeTemp tmp             let mi =mi0 {mflags=mflags mi0 `addOptions` opts, msrc=file0}

src/compiler/GF/Compile/PGFtoHaskell.hs view

@@ -51,7 +51,7 @@           derivingClause                  | dataExt = "deriving (Show,Data)"                  | otherwise = "deriving Show"-          extraImports | gadt = ["import Control.Monad.Identity", "import Data.Monoid"]+          extraImports | gadt = ["import Control.Monad.Identity", "import Control.Monad", "import Data.Monoid"]                        | dataExt = ["import Data.Data"]                        | otherwise = []           pgfImports | pgf2 = ["import PGF2 hiding (Tree)", "", "showCId :: CId -> String", "showCId = id"]

src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs view

@@ -644,7 +644,7 @@ newtype TcM a = TcM {unTcM :: MetaStore -> [Message] -> TcResult a}  instance Monad TcM where-  return x = TcM (\ms msgs -> TcOk x ms msgs)+  return = pure   f >>= g  = TcM (\ms msgs -> case unTcM f ms msgs of                                 TcOk x ms msgs -> unTcM (g x) ms msgs                                 TcFail    msgs -> TcFail msgs)@@ -659,7 +659,7 @@   instance Applicative TcM where-  pure = return+  pure x = TcM (\ms msgs -> TcOk x ms msgs)   (<*>) = ap  instance Functor TcM where

src/compiler/GF/CompileInParallel.hs view

@@ -61,11 +61,11 @@          usesPresent (_,paths) = take 1 libs==["present"]           where-            libs = [p|path<-paths,-                      let (d,p0) = splitAt n path-                          p = dropSlash p0,-                      d==lib_dir,p `elem` all_modes]-            n = length lib_dir  +            libs = [p | path<-paths,+                        let (d,p0) = splitAt n path+                            p = dropSlash p0,+                      d==lib_dir, p `elem` all_modes]+            n = length lib_dir          all_modes = ["alltenses","present"] @@ -175,7 +175,7 @@                    " from being compiled."        else return (maximum ts,(cnc,gr)) -splitEither es = ([x|Left x<-es],[y|Right y<-es])+splitEither es = ([x | Left x<-es], [y | Right y<-es])  canonical path = liftIO $ D.canonicalizePath path `catch` const (return path) @@ -238,12 +238,12 @@ instance Functor m => Functor (CollectOutput m) where    fmap f (CO m) = CO (fmap (fmap f) m) -instance (Functor m,Monad m) => Applicative (CollectOutput m) where -  pure = return+instance (Functor m,Monad m) => Applicative (CollectOutput m) where+  pure x = CO (return (return (),x))   (<*>) = ap  instance Monad m => Monad (CollectOutput m) where-  return x = CO (return (return (),x))+  return     = pure   CO m >>= f = CO $ do (o1,x) <- m                        let CO m2 = f x                        (o2,y) <- m2

src/compiler/GF/Data/BacktrackM.hs view

@@ -64,11 +64,11 @@ finalStates bm = map fst . runBM bm  instance Applicative (BacktrackM s) where-    pure = return+    pure a = BM (\c s b -> c a s b)     (<*>) = ap  instance Monad (BacktrackM s) where-    return a   = BM (\c s b -> c a s b)+    return     = pure     BM m >>= k = BM (\c s b -> m (\a s b -> unBM (k a) c s b) s b)         where unBM (BM m) = m

src/compiler/GF/Data/ErrM.hs view

@@ -34,7 +34,7 @@ fromErr a = err (const a) id  instance Monad Err where-  return      = Ok+  return      = pure   Ok a  >>= f = f a   Bad s >>= f = Bad s @@ -54,7 +54,7 @@   fmap f (Bad s) = Bad s  instance Applicative Err where-  pure = return+  pure = Ok   (<*>) = ap  -- | added by KJ

src/compiler/GF/Grammar/Grammar.hs view

@@ -78,6 +78,7 @@ import Data.Array.IArray(Array) import Data.Array.Unboxed(UArray) import qualified Data.Map as Map+import qualified Data.Set as Set import GF.Text.Pretty  @@ -125,10 +126,20 @@ extends = map fst . mextend  isInherited :: MInclude -> Ident -> Bool-isInherited c i = case c of-  MIAll -> True-  MIOnly is -> elem i is-  MIExcept is -> notElem i is+isInherited c =+  case c of+    MIAll -> const True+    MIOnly is -> elemOrd is+    MIExcept is -> not . elemOrd is++-- | Faster version of `elem`, using a `Set`.+-- Make sure you give this the first argument _outside_ of the inner loop+--+-- Example:+-- > myIntersection xs ys = filter (elemOrd xs) ys+elemOrd :: Ord a => [a] -> a -> Bool+elemOrd list = (`Set.member` set)+  where set = Set.fromList list  inheritAll :: ModuleName -> (ModuleName,MInclude) inheritAll i = (i,MIAll)

src/compiler/GF/Grammar/Lexer.x view

@@ -4,7 +4,7 @@ module GF.Grammar.Lexer          ( Token(..), Posn(..)          , P, runP, runPartial, token, lexer, getPosn, failLoc-         , isReservedWord+         , isReservedWord, invMap          ) where  import Control.Applicative@@ -134,7 +134,7 @@  | T_Double  Double          -- double precision float literals  | T_Ident   Ident  | T_EOF--- deriving Show -- debug+  deriving (Eq, Ord, Show) -- debug  res = eitherResIdent eitherResIdent :: (Ident -> Token) -> Ident -> Token@@ -224,6 +224,13 @@  ]  where b s t = (identS s, t) +invMap :: Map.Map Token String+invMap = res+  where+    lst = Map.toList resWords+    flp = map (\(k,v) -> (v,showIdent k)) lst+    res = Map.fromList flp+ unescapeInitTail :: String -> String unescapeInitTail = unesc . tail where   unesc s = case s of@@ -276,11 +283,11 @@   fmap = liftA  instance Applicative P where-  pure = return+  pure a = a `seq` (P $ \s -> POk s a)   (<*>) = ap  instance Monad P where-  return a    = a `seq` (P $ \s -> POk s a)+  return      = pure   (P m) >>= k = P $ \ s -> case m s of                              POk s a          -> unP (k a) s                              PFailed posn err -> PFailed posn err

src/compiler/GF/Grammar/Parser.y view

@@ -37,6 +37,9 @@ %name pBNFCRules ListCFRule %name pEBNFRules ListEBNFRule +%errorhandlertype explist+%error { happyError }+ -- no lexer declaration %monad { P } { >>= } { return } %lexer { lexer } { T_EOF }@@ -430,6 +433,7 @@                                          RecType xs -> RecType (xs ++ [(tupleLabel (length xs+1),$3)])                                          t          -> RecType [(tupleLabel 1,$1), (tupleLabel 2,$3)]  }   | Exp3 '**' Exp4                   { ExtR $1 $3    }+  | Exp3 '**'  '{' ListCase '}'      { let v = identS "$vvv" in T TRaw ($4 ++ [(PV v, S $1 (Vr v))]) }   | Exp4                             { $1            }  Exp4 :: { Term }@@ -701,8 +705,18 @@  { -happyError :: P a-happyError = fail "syntax error"+happyError :: (Token, [String]) -> P a+happyError (t,strs) = fail $ +  "Syntax error:\n     Unexpected " ++ showToken t ++ ".\n     Expected one of:\n" +    ++ unlines (map (("     - "++).cleanupToken) strs)+  +  where+    cleanupToken "Ident" = "an identifier"+    cleanupToken x = x+    showToken (T_Ident i) = "identifier '" ++ showIdent i ++ "'"+    showToken t = case Map.lookup t invMap of +      Nothing -> show t+      Just s -> "token '" ++ s ++"'"  mkListId,mkConsId,mkBaseId  :: Ident -> Ident mkListId = prefixIdent "List"

src/compiler/GF/Infra/BuildInfo.hs view

@@ -1,13 +1,34 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+ module GF.Infra.BuildInfo where import System.Info import Data.Version(showVersion) +import Language.Haskell.TH.Syntax+import Control.Monad.IO.Class+import Control.Exception+import Data.Time hiding (buildTime)+import System.Process++-- Use Template Haskell to get compile time+buildTime :: String+buildTime = $(do+                 timeZone <- liftIO getCurrentTimeZone+                 time <- liftIO $ utcToLocalTime timeZone <$> getCurrentTime+                 return $ LitE $ StringL $ formatTime defaultTimeLocale "%F %T" time )++-- Use Template Haskell to get current Git information+gitInfo :: String+gitInfo = $(do+               info <- liftIO $ try $ readProcess "git" ["log", "--format=commit %h tag %(describe:tags=true)", "-1"] "" :: Q (Either SomeException String)+               return $ LitE $ StringL $ either (\_ -> "unavailable") id info )+ {-# NOINLINE buildInfo #-} buildInfo =     "Built on "++os++"/"++arch-    ++" with "++compilerName++"-"++showVersion compilerVersion-    ++", flags:"+    ++" with "++compilerName++"-"++showVersion compilerVersion ++ " at " ++ buildTime ++ "\nGit info: " ++ gitInfo+    ++"\nFlags:" #ifdef USE_INTERRUPT     ++" interrupt" #endif

src/compiler/GF/Infra/CheckM.hs view

@@ -48,7 +48,7 @@ instance Functor Check where fmap = liftM  instance Monad Check where-  return x = Check $ \{-ctxt-} ws -> (ws,Success x)+  return   = pure   f >>= g  = Check $ \{-ctxt-} ws ->                case unCheck f {-ctxt-} ws of                  (ws,Success x) -> unCheck (g x) {-ctxt-} ws@@ -58,7 +58,7 @@   fail = raise  instance Applicative Check where-  pure = return+  pure x = Check $ \{-ctxt-} ws -> (ws,Success x)   (<*>) = ap  instance ErrorMonad Check where

src/compiler/GF/Infra/SIO.hs view

@@ -52,11 +52,11 @@ instance Functor SIO where fmap = liftM  instance Applicative SIO where-  pure = return+  pure x = SIO (const (pure x))   (<*>) = ap  instance Monad SIO where-  return x = SIO (const (return x))+  return         = pure   SIO m1 >>= xm2 = SIO $ \ h -> m1 h >>= \ x -> unS (xm2 x) h  instance Fail.MonadFail SIO where

src/compiler/GF/Interactive.hs view

@@ -32,14 +32,17 @@ import System.Directory({-getCurrentDirectory,-}getAppUserDataDirectory) import Control.Exception(SomeException,fromException,evaluate,try) import Control.Monad.State hiding (void)+import Control.Monad (join, when, (<=<)) import qualified GF.System.Signal as IO(runInterruptibly) #ifdef SERVER_MODE import GF.Server(server) #endif  import GF.Command.Messages(welcome)--- Provides an orphan instance of MonadFail for StateT in ghc versions < 8+#if !(MIN_VERSION_base(4,9,0))+-- Needed to make it compile on GHC < 8 import Control.Monad.Trans.Instances ()+#endif  -- | Run the GF Shell in quiet mode (@gf -run@). mainRunGFI :: Options -> [FilePath] -> IO ()

src/compiler/GF/Interactive2.hs view

@@ -12,7 +12,7 @@ import GF.Command.Parse(readCommandLine,pCommand) import GF.Data.Operations (Err(..)) import GF.Data.Utilities(whenM,repeatM)-+import Control.Monad (join, when, (<=<)) import GF.Infra.UseIO(ioErrorText,putStrLnE) import GF.Infra.SIO import GF.Infra.Option

src/compiler/GF/Main.hs view

@@ -16,6 +16,7 @@ import System.Directory import System.Environment (getArgs) import System.Exit+import GHC.IO.Encoding -- import GF.System.Console (setConsoleEncoding)  -- | Run the GF main program, taking arguments from the command line.@@ -23,6 +24,7 @@ -- Run @gf --help@ for usage info. main :: IO () main = do+  setLocaleEncoding utf8   -- setConsoleEncoding   uncurry mainOpts =<< getOptions @@ -46,7 +48,10 @@ mainOpts :: Options -> [FilePath] -> IO () mainOpts opts files =     case flag optMode opts of-      ModeVersion     -> putStrLn $ "Grammatical Framework (GF) version " ++ showVersion version ++ "\n" ++ buildInfo+      ModeVersion     -> do datadir <- getDataDir+                            putStrLn $ "Grammatical Framework (GF) version " ++ showVersion version ++ "\n" ++ +                                       buildInfo ++ "\n" +++                                       "Shared folder: " ++ datadir       ModeHelp        -> putStrLn helpMessage       ModeServer port -> GFI1.mainServerGFI opts port files       ModeCompiler    -> mainGFC opts files

src/compiler/GF/Text/Coding.hs view

@@ -38,7 +38,7 @@ decodeUnicode enc bs = unsafePerformIO $ decodeUnicodeIO enc bs  decodeUnicodeIO enc (PS fptr l len) = do-    let bbuf = Buffer{bufRaw=fptr, bufState=ReadBuffer, bufSize=len, bufL=l, bufR=l+len}+    let bbuf = (emptyBuffer fptr len ReadBuffer) { bufL=l, bufR=l+len }     cbuf <- newCharBuffer 128 WriteBuffer     case enc of       TextEncoding {mkTextDecoder=mk} -> do decoder <- mk

src/runtime/haskell-bind/PGF2.hsc view

@@ -1026,7 +1026,10 @@           touchConcr lang           return []         else do-          tok <- peekUtf8CString =<< (#peek PgfTokenProb, tok) cmpEntry+          p_tok <- (#peek PgfTokenProb, tok) cmpEntry+          tok <- if p_tok == nullPtr+                   then return "&+"+                   else peekUtf8CString p_tok           cat <- peekUtf8CString =<< (#peek PgfTokenProb, cat) cmpEntry           fun <- peekUtf8CString =<< (#peek PgfTokenProb, fun) cmpEntry           prob <- (#peek PgfTokenProb, prob) cmpEntry

src/runtime/haskell/Data/Binary/Builder.hs view

@@ -74,13 +74,19 @@ #endif  #if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)-import GHC.Base(Int(..),uncheckedShiftRL# )+import GHC.Base(Int(..),uncheckedShiftRL#,) import GHC.Word (Word32(..),Word16(..),Word64(..)) -#if WORD_SIZE_IN_BITS < 64 && __GLASGOW_HASKELL__ >= 608+#if MIN_VERSION_base(4,16,0)+import GHC.Exts (wordToWord16#, word16ToWord#, wordToWord32#, word32ToWord#)+#endif+#if WORD_SIZE_IN_BITS < 64 && __GLASGOW_HASKELL__ >= 608  import GHC.Word (uncheckedShiftRL64#) #endif+#if __GLASGOW_HASKELL__ >= 900 +import GHC.Word (uncheckedShiftRL64#) #endif+#endif  ------------------------------------------------------------------------ @@ -108,7 +114,7 @@ instance Monoid Builder where     mempty  = empty     {-# INLINE mempty #-}-    mappend = append+    mappend = (<>)     {-# INLINE mappend #-}  ------------------------------------------------------------------------@@ -411,9 +417,15 @@ shiftr_w64 :: Word64 -> Int -> Word64  #if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+#if MIN_VERSION_base(4,16,0)+shiftr_w16 (W16# w) (I# i) = W16# (wordToWord16# ((word16ToWord# w) `uncheckedShiftRL#`   i))+shiftr_w32 (W32# w) (I# i) = W32# (wordToWord32# ((word32ToWord# w) `uncheckedShiftRL#`   i))+#else shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#`   i) shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#`   i)+#endif + #if WORD_SIZE_IN_BITS < 64 shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i) @@ -424,7 +436,11 @@ #endif  #else+#if __GLASGOW_HASKELL__ <= 810 shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL#` i)+#else+shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i)+#endif #endif  #else

src/runtime/haskell/Data/Binary/Get.hs view

@@ -1,4 +1,6 @@ {-# LANGUAGE CPP, MagicHash #-}+-- This module makes profiling a lot slower, so don't add automatic cost centres +{-# OPTIONS_GHC -fno-prof-auto #-} -- for unboxed shifts  -----------------------------------------------------------------------------@@ -99,7 +101,13 @@ import GHC.Base import GHC.Word --import GHC.Int+#if MIN_VERSION_base(4,16,0)+import GHC.Exts (wordToWord16#, word16ToWord#, wordToWord32#, word32ToWord#) #endif+#if __GLASGOW_HASKELL__ >= 900 +import GHC.Word (uncheckedShiftL64#)+#endif+#endif  -- Control.Monad.Fail import will become redundant in GHC 8.8+ import qualified Control.Monad.Fail as Fail@@ -119,11 +127,11 @@     {-# INLINE fmap #-}  instance Applicative Get where-    pure  = return+    pure a = Get (\s -> (a, s))     (<*>) = ap  instance Monad Get where-    return a  = Get (\s -> (a, s))+    return = pure     {-# INLINE return #-}      m >>= k   = Get (\s -> case unGet m s of@@ -530,8 +538,13 @@ shiftl_w64 :: Word64 -> Int -> Word64  #if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+#if MIN_VERSION_base(4,16,0)+shiftl_w16 (W16# w) (I# i) = W16# (wordToWord16# ((word16ToWord# w) `uncheckedShiftL#`   i))+shiftl_w32 (W32# w) (I# i) = W32# (wordToWord32# ((word32ToWord# w) `uncheckedShiftL#`   i))+#else shiftl_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftL#`   i) shiftl_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftL#`   i)+#endif  #if WORD_SIZE_IN_BITS < 64 shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#` i)@@ -543,7 +556,12 @@ #endif  #else+#if __GLASGOW_HASKELL__ <= 810 shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL#` i)+#else+shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#` i)+#endif+ #endif  #else

src/runtime/haskell/Data/Binary/Put.hs view

@@ -77,15 +77,20 @@         {-# INLINE fmap #-}  instance Applicative PutM where-        pure    = return+        pure a  = Put $ PairS a mempty         m <*> k = Put $             let PairS f w  = unPut m                 PairS x w' = unPut k             in PairS (f x) (w `mappend` w')+        m *> k  = Put $+            let PairS _ w  = unPut m+                PairS b w' = unPut k+            in PairS b (w `mappend` w')+        {-# INLINE (*>) #-}  -- Standard Writer monad, with aggressive inlining instance Monad PutM where-    return a = Put $ PairS a mempty+    return = pure     {-# INLINE return #-}      m >>= k  = Put $@@ -94,10 +99,7 @@         in PairS b (w `mappend` w')     {-# INLINE (>>=) #-} -    m >> k  = Put $-        let PairS _ w  = unPut m-            PairS b w' = unPut k-        in PairS b (w `mappend` w')+    (>>) = (*>)     {-# INLINE (>>) #-}  tell :: Builder -> Put

src/runtime/haskell/PGF.hs view

@@ -31,7 +31,7 @@            languages, abstractName, languageCode,             -- * Types-           Type, Hypo,+           Type, Hypo, BindType(..),            showType, readType,            mkType, mkHypo, mkDepHypo, mkImplHypo,            unType,

src/runtime/haskell/PGF/Expr.hs view

@@ -17,7 +17,8 @@                 MetaId,
 
                 -- helpers
-                pMeta,pArg,pLit,freshName,ppMeta,ppLit,ppParens
+                pMeta,pArg,pLit,freshName,ppMeta,ppLit,ppParens,
+                freshBoundVars
                ) where
 
 import PGF.CId
@@ -235,10 +236,11 @@ 
 ppExpr :: Int -> [CId] -> Expr -> PP.Doc
 ppExpr d scope (EAbs b x e) = let (bs,xs,e1) = getVars [] [] (EAbs b x e)
+                                  xs' = freshBoundVars scope xs
                               in ppParens (d > 1) (PP.char '\\' PP.<>
-                                                   PP.hsep (PP.punctuate PP.comma (reverse (List.zipWith ppBind bs xs))) PP.<+>
+                                                   PP.hsep (PP.punctuate PP.comma (reverse (List.zipWith ppBind bs xs'))) PP.<+>
                                                    PP.text "->" PP.<+>
-                                                   ppExpr 1 (xs++scope) e1)
+                                                   ppExpr 1 (xs' ++ scope) e1)
                               where
                                 getVars bs xs (EAbs b x e) = getVars (b:bs) ((freshName x xs):xs) e
                                 getVars bs xs e            = (bs,xs,e)
@@ -289,6 +291,15 @@       | elem y xs = loop (i+1) (mkCId (show x++show i))
       | otherwise = y
 
+-- refresh new vars xs in scope if needed. AR 2024-03-01
+freshBoundVars :: [CId] -> [CId] -> [CId]
+freshBoundVars scope xs = foldr fresh [] xs
+  where
+    fresh x xs' = mkCId (freshName (showCId x) xs') : xs'
+    freshName s xs' = 
+      if elem (mkCId s) (xs' ++ scope)
+      then freshName (s ++ "'") xs'
+      else s
 
 -----------------------------------------------------
 -- Computation
@@ -397,7 +408,7 @@         tryMatch (p          ) (VMeta i envi vs  ) env            = VSusp i envi vs (\v -> tryMatch p v env)
         tryMatch (p          ) (VGen  i vs       ) env            = VConst f as0
         tryMatch (p          ) (VSusp i envi vs k) env            = VSusp i envi vs (\v -> tryMatch p (k v) env)
-        tryMatch (p          ) v@(VConst _ _     ) env            = VConst f as0
+        tryMatch (p          ) v@(VConst _ _     ) env            = match sig f eqs as0
         tryMatch (PApp f1 ps1) (VApp f2 vs2      ) env | f1 == f2 = tryMatches eqs (ps1++ps) (vs2++as) res env
         tryMatch (PLit l1    ) (VLit l2          ) env | l1 == l2 = tryMatches eqs  ps        as  res env
         tryMatch (PImplArg p ) (VImplArg v       ) env            = tryMatch p v env

src/runtime/haskell/PGF/Linearize.hs view

@@ -81,7 +81,7 @@   where     lp    = lproductions cnc -    lin mb_cty n_fid e0 ys xs (EAbs _ x e) es = lin   mb_cty n_fid e0 ys (x:xs) e      es+    lin mb_cty n_fid e0 ys xs (EAbs _ x e) es = lin   mb_cty n_fid e0 ys (freshBoundVars (xs ++ ys) [x] ++ xs) e      es --fresh: AR 2024     lin mb_cty n_fid e0 ys xs (EApp e1 e2) es = lin   mb_cty n_fid e0 ys    xs  e1 (e2:es)     lin mb_cty n_fid e0 ys xs (EImplArg e) es = lin   mb_cty n_fid e0 ys    xs  e      es     lin mb_cty n_fid e0 ys xs (ETyped e _) es = lin   mb_cty n_fid e0 ys    xs  e      es

src/runtime/haskell/PGF/TypeCheck.hs view

@@ -94,11 +94,11 @@   select        :: CId -> Scope -> Maybe Int -> TcM s (Expr,TType)  instance Applicative (TcM s) where-  pure = return+  pure x = TcM (\abstr k h -> k x)   (<*>) = ap  instance Monad (TcM s) where-  return x = TcM (\abstr k h -> k x)+  return   = pure   f >>= g  = TcM (\abstr k h -> unTcM f abstr (\x -> unTcM (g x) abstr k h) h)  instance Selector s => Alternative (TcM s) where@@ -147,9 +147,9 @@          where            Scope gamma = scope -    y | cat == cidInt    = return [(1.0,ELit (LInt 999),  TTyp [] (DTyp [] cat []))]-      | cat == cidFloat  = return [(1.0,ELit (LFlt 3.14), TTyp [] (DTyp [] cat []))]-      | cat == cidString = return [(1.0,ELit (LStr "Foo"),TTyp [] (DTyp [] cat []))]+    y | cat == cidInt    = return [(0.1, ELit (LInt n),  TTyp [] (DTyp [] cat [])) | n <- ints]+      | cat == cidFloat  = return [(0.1, ELit (LFlt d), TTyp [] (DTyp [] cat [])) | d <- floats]+      | cat == cidString = return [(0.1, ELit (LStr s),TTyp [] (DTyp [] cat [])) | s <- strs]       | otherwise        = TcM (\abstr k h ms ->                                     case Map.lookup cat (cats abstr) of                                       Just (_,fns,_) -> unTcM (mapM helper fns) abstr k h ms@@ -162,6 +162,11 @@     normalize gens = [(p/s,e,tty) | (p,e,tty) <- gens]       where         s = sum [p | (p,_,_) <- gens]++ -- random elements of predefined types: many instead of one AR 2025-01-17+    ints = [1, 2, 3, 14, 42, 123, 999, 2025, 1000000, 1234567890]+    floats = [0.0, 1.0, 3.14, 0.999, 0.5772156649, 2.71828, 6.62607015, 19.3, 0.0001, 1.60934]+    strs = words "A B X Y b c x y foo bar"  emptyMetaStore :: MetaStore s emptyMetaStore = IntMap.empty

src/runtime/haskell/PGF/VisualizeTree.hs view

@@ -651,6 +651,7 @@ latexDoc :: Doc -> Doc latexDoc body =   vcat [text "\\documentclass{article}",+        text "\\usepackage[a4paper,margin=0.5in,landscape]{geometry}",         text "\\usepackage[utf8]{inputenc}",         text "\\begin{document}",         body,

src/server/CGIUtils.hs view

@@ -34,8 +34,13 @@ stderrToFile file =     do let mode = ownerReadMode<>ownerWriteMode<>groupReadMode<>otherReadMode            (<>) = unionFileModes+#if MIN_VERSION_unix(2,8,0)+           flags = defaultFileFlags { append = True, creat = Just mode }+       fileFd <- openFd file WriteOnly flags+#else            flags = defaultFileFlags { append = True }        fileFd <- openFd file WriteOnly (Just mode) flags+#endif        dupTo fileFd stdError        return () #else

src/server/PGFService.hs view

@@ -159,13 +159,13 @@                     -> out t=<< bracketedLin # tree % to     "c-linearizeAll"-> out t=<< linAll # tree % to     "c-translate"   -> withQSem qsem $-                       out t=<<join(trans # input % cat % to % start % limit%treeopts)+                       out t=<<join(trans # input % cat % to % start % limit % treeopts)     "c-lookupmorpho"-> out t=<< morpho # from1 % textInput     "c-lookupcohorts"->out t=<< cohorts # from1 % getInput "filter" % textInput     "c-flush"       -> out t=<< flush     "c-grammar"     -> out t grammar     "c-abstrtree"   -> outputGraphviz=<< C.graphvizAbstractTree pgf C.graphvizDefaults # tree-    "c-parsetree"   -> outputGraphviz=<< (\cnc -> C.graphvizParseTree cnc C.graphvizDefaults) . snd # from1 %tree+    "c-parsetree"   -> outputGraphviz=<< (\cnc -> C.graphvizParseTree cnc C.graphvizDefaults) . snd # from1 % tree     "c-wordforword" -> out t =<< wordforword # input % cat % to     _               -> badRequest "Unknown command" command   where@@ -448,7 +448,7 @@       "linearizeTable" -> o =<< doLinearizeTabular pgf # tree % to       "random"         -> o =<< join (doRandom pgf # cat % depth % limit % to)       "generate"       -> o =<< doGenerate pgf # cat % depth % limit % to-      "translate"      -> o =<< doTranslate pgf # input % cat %to%limit%treeopts+      "translate"      -> o =<< doTranslate pgf # input % cat % to % limit % treeopts       "translategroup" -> o =<< doTranslateGroup pgf # input % cat % to % limit       "lookupmorpho"   -> o =<< doLookupMorpho pgf # from1 % textInput       "grammar"        -> join $ doGrammar tpgf@@ -571,6 +571,8 @@ limit = readInput "limit" depth = readInput "depth" +default_depth_server = 4+ start :: CGI Int start = maybe 0 id # readInput "start" @@ -781,7 +783,7 @@              | tree <- limit trees]   where cat = fromMaybe (PGF.startCat pgf) mcat         limit = take (fromMaybe 1 mlimit)-        depth = fromMaybe 4 mdepth+        depth = fromMaybe default_depth_server mdepth  doGenerate :: PGF -> Maybe PGF.Type -> Maybe Int -> Maybe Int -> To -> JSValue doGenerate pgf mcat mdepth mlimit tos =@@ -794,7 +796,7 @@     trees = PGF.generateAllDepth pgf cat (Just depth)     cat = fromMaybe (PGF.startCat pgf) mcat     limit = take (fromMaybe 1 mlimit)-    depth = fromMaybe 4 mdepth+    depth = fromMaybe default_depth_server mdepth  doGrammar :: (UTCTime,PGF) -> Either IOError (UTCTime,l) -> Maybe (Accept Language) -> CGI CGIResult doGrammar (t1,pgf) elbls macc = out t $ showJSON $ makeObj@@ -1092,7 +1094,7 @@     [(to,lintab to (transfer to tree)) | to <- langs]   where     langs = if null tos then PGF.languages pgf else tos-    lintab to t = [(p,map unlex (nub [t|(p',t)<-vs,p'==p]))|p<-ps]+    lintab to t = [(p,map unlex (nub [t | (p',t)<-vs,p'==p])) | p<-ps]       where         ps = nub (map fst vs)         vs = concat (PGF.tabularLinearizes pgf to t)

src/www/gf-web-api.html view

@@ -22,9 +22,7 @@ <h1 class="title">GF Web Service API</h1> <p class="author">June 2016</p> </header>-<p></p> <hr />-<p></p> <ul> <li><a href="#toc1">Introduction</a></li> <li><a href="#toc2">Commands</a>@@ -43,24 +41,39 @@ </ul></li> <li><a href="#toc14">Commands that use the C run-time system</a></li> </ul>-<p></p> <hr />-<p></p> <div id="toc1">  </div> <h2 id="introduction">Introduction</h2>-<p>The PGF API is available as Web Service through the built-in HTTP server in the main GF executable. It is activated by starting GF with the <code>-server</code> flag:</p>+<p>The PGF API is available as Web Service through the built-in HTTP+server in the main GF executable. It is activated by starting GF with+the <code>-server</code> flag:</p> <pre><code>  $ gf -server   This is GF version 3.8.   Document root = /usr/share/gf-3.8/www   Starting HTTP server, open http://localhost:41296/ in your web browser.</code></pre>-<p>A compiled GF grammar (a <code>.pgf</code> file) can be used in web applications by placing it somewhere under the document root. When there is a request for access to a <code>.pgf</code> file, the GF web server will load and cache the grammar and interpret any parameters included in the URL (in the <em>url-encoded-query</em> format). The response you get back is usually a data structure in <a href="http://www.json.org/">JSON</a> format, but it could also be an image or plain text.</p>-<p>For example, if <code>my_grammar.pgf</code> is a grammar placed directly under the document root, then the grammar could be accessed using this URL:</p>+<p>A compiled GF grammar (a <code>.pgf</code> file) can be used in web+applications by placing it somewhere under the document root. When there+is a request for access to a <code>.pgf</code> file, the GF web server+will load and cache the grammar and interpret any parameters included in+the URL (in the <em>url-encoded-query</em> format). The response you get+back is usually a data structure in <a+href="http://www.json.org/">JSON</a> format, but it could also be an+image or plain text.</p>+<p>For example, if <code>my_grammar.pgf</code> is a grammar placed+directly under the document root, then the grammar could be accessed+using this URL:</p> <pre><code>  http://localhost:41296/my_grammar.pgf</code></pre>-<p>The default when no parameters are included in the URL is a response with some general information about the grammar, encoded in JSON format. To perform specific command you have to tell what command you want to perform. The command is encoded in the parameter <code>command</code>, i.e.:</p>+<p>The default when no parameters are included in the URL is a response+with some general information about the grammar, encoded in JSON format.+To perform specific command you have to tell what command you want to+perform. The command is encoded in the parameter <code>command</code>,+i.e.:</p> <p><code>http://localhost/my_grammar.pgf?command=</code><em>cmd</em></p>-<p>where <em>cmd</em> is the name of the command. Most commands require additional arguments, which are encoded as parameters as well. The supported commands and their arguments are described below.</p>+<p>where <em>cmd</em> is the name of the command. Most commands require+additional arguments, which are encoded as parameters as well. The+supported commands and their arguments are described below.</p> <div id="toc2">  </div>@@ -70,19 +83,20 @@  </div> <h3 id="grammar">Grammar</h3>-<p>This command provides some general information about the grammar. This command is also executed if no `command` parameter is given.</p>+<p>This command provides some general information about the grammar.+This command is also executed if no `command` parameter is given.</p> <h5 id="input">Input</h5>-<table class="table">+<table class="table" data-border="1" data-cellpadding="4"> <thead> <tr class="header">-<th>Parameter</th>+<th style="text-align: center;">Parameter</th> <th>Description</th> <th>Default</th> </tr> </thead> <tbody> <tr class="odd">-<td>command</td>+<td style="text-align: center;">command</td> <td>should be <code>grammar</code></td> <td>-</td> </tr>@@ -90,7 +104,7 @@ </table> <h5 id="output">Output</h5> <p>A JSON object including the following fields:</p>-<table class="table">+<table class="table" data-border="1" data-cellpadding="4"> <thead> <tr class="header"> <th>Field</th>@@ -104,7 +118,8 @@ </tr> <tr class="even"> <td><code>userLanguage</code></td>-<td>the concrete language in the grammar which best matches the default language set in the user's browser</td>+<td>the concrete language in the grammar which best matches the default+language set in the user's browser</td> </tr> <tr class="odd"> <td><code>categories</code></td>@@ -121,7 +136,7 @@ </tbody> </table> <p>Every language is described with object having this two fields:</p>-<table class="table">+<table class="table" data-border="1" data-cellpadding="4"> <thead> <tr class="header"> <th>Field</th>@@ -135,19 +150,28 @@ </tr> <tr class="even"> <td><code>languageCode</code></td>-<td>the two-character language code according to the <a href="http://www.loc.gov/standards/iso639-2/php/code_list.php">ISO standard</a> i.e. <code>en</code> for English, <code>bg</code> for Bulgarian, etc.</td>+<td>the two-character language code according to the <a+href="http://www.loc.gov/standards/iso639-2/php/code_list.php">ISO+standard</a> i.e. <code>en</code> for English, <code>bg</code> for+Bulgarian, etc.</td> </tr> </tbody> </table>-<p>The language codes need to be specified in the grammar with <code>flags language=...</code>. The web service receives the code of the language set in the browser and compares it with the codes defined in the grammar. If there is a match then the service returns the corresponding concrete syntax name. If no match is found then the first language in alphabetical order is returned.</p>+<p>The language codes need to be specified in the grammar with+<code>flags language=...</code>. The web service receives the code of+the language set in the browser and compares it with the codes defined+in the grammar. If there is a match then the service returns the+corresponding concrete syntax name. If no match is found then the first+language in alphabetical order is returned.</p> <hr /> <div id="toc4">  </div> <h3 id="parsing">Parsing</h3>-<p>This command parses a string and returns a list of abstract syntax trees.</p>+<p>This command parses a string and returns a list of abstract syntax+trees.</p> <h4 id="input-1">Input</h4>-<table class="table">+<table class="table" data-border="1" data-cellpadding="4"> <thead> <tr class="header"> <th>Parameter</th>@@ -184,8 +208,9 @@ </tbody> </table> <h4 id="output-1">Output</h4>-<p>List of objects where every object represents the analyzes for every input language. The objects have three fields:</p>-<table class="table">+<p>List of objects where every object represents the analyzes for every+input language. The objects have three fields:</p>+<table class="table" data-border="1" data-cellpadding="4"> <thead> <tr class="header"> <th>Field</th>@@ -211,8 +236,9 @@ </tr> </tbody> </table>-<p>The abstract syntax trees are sent as plain strings. The type errors are objects with two fields:</p>-<table class="table">+<p>The abstract syntax trees are sent as plain strings. The type errors+are objects with two fields:</p>+<table class="table" data-border="1" data-cellpadding="4"> <thead> <tr class="header"> <th>Field</th>@@ -222,7 +248,8 @@ <tbody> <tr class="odd"> <td><code>fid</code></td>-<td>forest id which points to a bracket in the bracketed string where the error occurs</td>+<td>forest id which points to a bracket in the bracketed string where+the error occurs</td> </tr> <tr class="even"> <td><code>msg</code></td>@@ -230,15 +257,18 @@ </tr> </tbody> </table>-<p>The current implementation either returns a list of abstract syntax trees or a list of type errors. By checking whether the field trees is not null we check whether the type checking was successful.</p>+<p>The current implementation either returns a list of abstract syntax+trees or a list of type errors. By checking whether the field trees is+not null we check whether the type checking was successful.</p> <hr /> <div id="toc5">  </div> <h3 id="linearization">Linearization</h3>-<p>The command takes an abstract syntax tree and produces string in the specified language(s).</p>+<p>The command takes an abstract syntax tree and produces string in the+specified language(s).</p> <h4 id="input-2">Input</h4>-<table class="table">+<table class="table" data-border="1" data-cellpadding="4"> <thead> <tr class="header"> <th>Parameter</th>@@ -260,12 +290,13 @@ <tr class="odd"> <td><code>to</code></td> <td>the name of the concrete syntax to use in the linearization</td>-<td>linearizations for all languages in the grammar will be generated</td>+<td>linearizations for all languages in the grammar will be+generated</td> </tr> </tbody> </table> <h4 id="output-2">Output</h4>-<table class="table">+<table class="table" data-border="1" data-cellpadding="4"> <thead> <tr class="header"> <th>Field</th>@@ -288,9 +319,14 @@  </div> <h3 id="translation">Translation</h3>-<p>The translation is a two step process. First the input sentence is parsed with the source language and after that the output sentence(s) are produced via linearization with the target language(s). For that reason the input and the output for this command is the union of the input/output of the commands for parsing and the one for linearization.</p>+<p>The translation is a two step process. First the input sentence is+parsed with the source language and after that the output sentence(s)+are produced via linearization with the target language(s). For that+reason the input and the output for this command is the union of the+input/output of the commands for parsing and the one for+linearization.</p> <h4 id="input-3">Input</h4>-<table class="table">+<table class="table" data-border="1" data-cellpadding="4"> <thead> <tr class="header"> <th>Parameter</th>@@ -322,7 +358,8 @@ <tr class="odd"> <td><code>to</code></td> <td>the target language</td>-<td>linearizations for all languages in the grammar will be generated</td>+<td>linearizations for all languages in the grammar will be+generated</td> </tr> <tr class="even"> <td><code>limit</code></td>@@ -333,7 +370,7 @@ </table> <h4 id="output-3">Output</h4> <p>The output is a list of objects with these fields:</p>-<table class="table">+<table class="table" data-border="1" data-cellpadding="4"> <thead> <tr class="header"> <th>Field</th>@@ -360,7 +397,7 @@ </tbody> </table> <p>Every translation is an object with two fields:</p>-<table class="table">+<table class="table" data-border="1" data-cellpadding="4"> <tbody> <tr class="odd"> <td><code>tree</code></td>@@ -373,7 +410,7 @@ </tbody> </table> <p>Every linearization is an object with two fields:</p>-<table class="table">+<table class="table" data-border="1" data-cellpadding="4"> <tbody> <tr class="odd"> <td>Field</td>@@ -390,7 +427,7 @@ </tbody> </table> <p>The type errors are objects with two fields:</p>-<table class="table">+<table class="table" data-border="1" data-cellpadding="4"> <thead> <tr class="header"> <th>Field</th>@@ -400,7 +437,8 @@ <tbody> <tr class="odd"> <td><code>fid</code></td>-<td>forest id which points to a bracket in the bracketed string where the error occurs</td>+<td>forest id which points to a bracket in the bracketed string where+the error occurs</td> </tr> <tr class="even"> <td><code>msg</code></td>@@ -408,15 +446,20 @@ </tr> </tbody> </table>-<p>The current implementation either returns a list of translations or a list of type errors. By checking whether the field translations is not null we check whether the type checking was successful.</p>+<p>The current implementation either returns a list of translations or a+list of type errors. By checking whether the field translations is not+null we check whether the type checking was successful.</p> <hr /> <div id="toc7">  </div> <h3 id="random-generation">Random Generation</h3>-<p>This command generates random abstract syntax tree where the top-level function will be of the specified category. The categories for the sub-trees will be determined by the type signatures of the parent function.</p>+<p>This command generates random abstract syntax tree where the+top-level function will be of the specified category. The categories for+the sub-trees will be determined by the type signatures of the parent+function.</p> <h4 id="input-4">Input</h4>-<table class="table">+<table class="table" data-border="1" data-cellpadding="4"> <thead> <tr class="header"> <th>Parameter</th>@@ -444,7 +487,7 @@ </table> <h4 id="output-4">Output</h4> <p>The output is a list of objects with only one field:</p>-<table class="table">+<table class="table" data-border="1" data-cellpadding="4"> <thead> <tr class="header"> <th>Field</th>@@ -464,9 +507,12 @@  </div> <h3 id="word-completion">Word Completion</h3>-<p>Word completion is a special case of parsing. If there is an incomplete sentence then it is first parsed and after that the state of the parse chart is used to predict the set of words that could follow in a grammatically correct sentence.</p>+<p>Word completion is a special case of parsing. If there is an+incomplete sentence then it is first parsed and after that the state of+the parse chart is used to predict the set of words that could follow in+a grammatically correct sentence.</p> <h4 id="input-5">Input</h4>-<table class="table">+<table class="table" data-border="1" data-cellpadding="4"> <thead> <tr class="header"> <th>Parameter</th>@@ -503,8 +549,9 @@ </tbody> </table> <h4 id="output-5">Output</h4>-<p>The output is a list of objects with two fields which describe the completions.</p>-<table class="table">+<p>The output is a list of objects with two fields which describe the+completions.</p>+<table class="table" data-border="1" data-cellpadding="4"> <thead> <tr class="header"> <th>Field</th>@@ -526,10 +573,12 @@ <div id="toc9">  </div>-<h3 id="abstract-syntax-tree-visualization">Abstract Syntax Tree Visualization</h3>-<p>This command renders an abstract syntax tree into an image. Several image formats are supported.</p>+<h3 id="abstract-syntax-tree-visualization">Abstract Syntax Tree+Visualization</h3>+<p>This command renders an abstract syntax tree into an image. Several+image formats are supported.</p> <h4 id="input-6">Input</h4>-<table class="table">+<table class="table" data-border="1" data-cellpadding="4"> <thead> <tr class="header"> <th>Parameter</th>@@ -556,17 +605,24 @@ </tbody> </table> <h4 id="output-6">Output</h4>-<p>By default, the output is an image in PNG format. The Content-Type is set to <code>image/png</code>, so the easiest way to visualize the generated image is to add HTML element <code>&lt;img/&gt;</code> which points to URL for the visualization command i.e.:</p>+<p>By default, the output is an image in PNG format. The Content-Type is+set to <code>image/png</code>, so the easiest way to visualize the+generated image is to add HTML element <code>&lt;img/&gt;</code> which+points to URL for the visualization command i.e.:</p> <pre><code>  &lt;img src=&quot;http://localhost/my_grammar.pgf?command=abstrtree&amp;tree=...&quot;/&gt;</code></pre>-<p>The <code>format</code> parameter can also be <code>gif</code>, <code>svg</code> or <code>gv</code>, for GIF (<code>image/gif</code>), SVG (<code>image/svg+xml</code>) or graphviz (<code>text/plain</code>) format, respectively.</p>+<p>The <code>format</code> parameter can also be <code>gif</code>,+<code>svg</code> or <code>gv</code>, for GIF (<code>image/gif</code>),+SVG (<code>image/svg+xml</code>) or graphviz (<code>text/plain</code>)+format, respectively.</p> <hr /> <div id="toc10">  </div> <h3 id="parse-tree-visualization">Parse Tree Visualization</h3>-<p>This command renders the parse tree that corresponds to a specific abstract syntax tree. The generated image is in PNG format.</p>+<p>This command renders the parse tree that corresponds to a specific+abstract syntax tree. The generated image is in PNG format.</p> <h4 id="input-7">Input</h4>-<table class="table">+<table class="table" data-border="1" data-cellpadding="4"> <thead> <tr class="header"> <th>Parameter</th>@@ -602,19 +658,31 @@ </tr> </tbody> </table>-<p>The additioal rendering options are: <code>noleaves</code>, <code>nofun</code> and <code>nocat</code> (booleans, false by default); <code>nodefont</code>, <code>leaffont</code>, <code>nodecolor</code>, <code>leafcolor</code>, <code>nodeedgestyle</code> and <code>leafedgestyle</code> (strings, have builtin defaults).</p>+<p>The additioal rendering options are: <code>noleaves</code>,+<code>nofun</code> and <code>nocat</code> (booleans, false by default);+<code>nodefont</code>, <code>leaffont</code>, <code>nodecolor</code>,+<code>leafcolor</code>, <code>nodeedgestyle</code> and+<code>leafedgestyle</code> (strings, have builtin defaults).</p> <h4 id="output-7">Output</h4>-<p>By default, the output is an image in PNG format. The Content-Type is set to <code>image/png</code>, so the easiest way to visualize the generated image is to add HTML element <code>&lt;img/&gt;</code> which points to URL for the visualization command i.e.:</p>+<p>By default, the output is an image in PNG format. The Content-Type is+set to <code>image/png</code>, so the easiest way to visualize the+generated image is to add HTML element <code>&lt;img/&gt;</code> which+points to URL for the visualization command i.e.:</p> <pre><code>  &lt;img src=&quot;http://localhost/my_grammar.pgf?command=parsetree&amp;tree=...&quot;/&gt;</code></pre>-<p>The <code>format</code> parameter can also be <code>gif</code>, <code>svg</code> or <code>gv</code>, for GIF (<code>image/gif</code>), SVG (<code>image/svg+xml</code>) or graphviz (<code>text/plain</code>) format, respectively.</p>+<p>The <code>format</code> parameter can also be <code>gif</code>,+<code>svg</code> or <code>gv</code>, for GIF (<code>image/gif</code>),+SVG (<code>image/svg+xml</code>) or graphviz (<code>text/plain</code>)+format, respectively.</p> <hr /> <div id="toc11">  </div> <h3 id="word-alignment-diagrams">Word Alignment Diagrams</h3>-<p>This command renders the word alignment diagram for some sentence and all languages in the grammar. The sentence is generated from a given abstract syntax tree.</p>+<p>This command renders the word alignment diagram for some sentence and+all languages in the grammar. The sentence is generated from a given+abstract syntax tree.</p> <h4 id="input-8">Input</h4>-<table class="table">+<table class="table" data-border="1" data-cellpadding="4"> <thead> <tr class="header"> <th>Parameter</th>@@ -646,17 +714,24 @@ </tbody> </table> <h4 id="output-8">Output</h4>-<p>By default, the output is an image in PNG format. The Content-Ttype is set to <code>image/png</code>, so the easiest way to visualize the generated image is to add HTML element <code>&lt;img/&gt;</code> which points to URL for the visualization command i.e.:</p>+<p>By default, the output is an image in PNG format. The Content-Ttype+is set to <code>image/png</code>, so the easiest way to visualize the+generated image is to add HTML element <code>&lt;img/&gt;</code> which+points to URL for the visualization command i.e.:</p> <pre><code>  &lt;img src=&quot;http://localhost/my_grammar.pgf?command=alignment&amp;tree=...&quot;/&gt;</code></pre>-<p>The <code>format</code> parameter can also be <code>gif</code>, <code>svg</code> or <code>gv</code>, for GIF (<code>image/gif</code>), SVG (<code>image/svg+xml</code>) or graphviz (<code>text/plain</code>) format, respectively.</p>+<p>The <code>format</code> parameter can also be <code>gif</code>,+<code>svg</code> or <code>gv</code>, for GIF (<code>image/gif</code>),+SVG (<code>image/svg+xml</code>) or graphviz (<code>text/plain</code>)+format, respectively.</p> <hr /> <div id="toc12">  </div> <h3 id="word-dependency-diagrams">Word Dependency Diagrams</h3>-<p>This command (available in GF&gt;=3.8) outputs word dependency diagrams in various format.</p>+<p>This command (available in GF&gt;=3.8) outputs word dependency+diagrams in various format.</p> <h4 id="input-9">Input</h4>-<table class="table">+<table class="table" data-border="1" data-cellpadding="4"> <thead> <tr class="header"> <th>Parameter</th>@@ -689,10 +764,14 @@ </table> <p>The <code>format</code> is one of the following:</p> <ul>-<li><code>png</code>, <code>gif</code>, <code>gv</code>: rendered with graphviz,</li>-<li><code>svg</code>, <code>latex</code>: <a href="http://universaldependencies.org/">universal dependency</a> diagrams, in SVG format for use in web pages or as LaTeX Picture code for use in LaTeX documents,</li>-<li><p><code>conll</code>, <code>malt_tab</code> and <code>malt_input</code>: text formats</p>-<p></p></li>+<li><code>png</code>, <code>gif</code>, <code>gv</code>: rendered with+graphviz,</li>+<li><code>svg</code>, <code>latex</code>: <a+href="http://universaldependencies.org/">universal dependency</a>+diagrams, in SVG format for use in web pages or as LaTeX Picture code+for use in LaTeX documents,</li>+<li><code>conll</code>, <code>malt_tab</code> and+<code>malt_input</code>: text formats</li> </ul> <hr /> <div id="toc13">@@ -701,22 +780,40 @@ <h3 id="undocumented-commands">Undocumented commands</h3> <p>There a few additional commands that lack proper documentation:</p> <ul>-<li><code>abstrjson</code>, <code>browse</code>, <code>download</code>, <code>generate</code>, <code>linearizeAll</code>, <code>linearizeTable</code>, <code>lookupmorpho</code>, <code>translategroup</code>.</li>+<li><code>abstrjson</code>, <code>browse</code>, <code>download</code>,+<code>generate</code>, <code>linearizeAll</code>,+<code>linearizeTable</code>, <code>lookupmorpho</code>,+<code>translategroup</code>.</li> </ul> <p>See the source code for details.</p> <hr /> <div id="toc14">  </div>-<h2 id="commands-that-use-the-c-run-time-system">Commands that use the C run-time system</h2>-<p>GF includes two implementations of the PGF API: the traditional Haskell implementation and the newer C implementation. The commands documented above all use the Haskell implementation. The following commands use the C implementation instead:</p>+<h2 id="commands-that-use-the-c-run-time-system">Commands that use the C+run-time system</h2>+<p>GF includes two implementations of the PGF API: the traditional+Haskell implementation and the newer C implementation. The commands+documented above all use the Haskell implementation. The following+commands use the C implementation instead:</p> <ul>-<li><code>c-parse</code>, <code>c-linearize</code>, <code>c-linearizeAll</code>, <code>c-translate</code>, <code>c-lookupmorpho</code>, <code>c-flush</code>, <code>c-grammar</code>, <code>c-abstrtree</code>, <code>c-parsetree</code>, <code>c-wordforword</code>.</li>+<li><code>c-parse</code>, <code>c-linearize</code>,+<code>c-linearizeAll</code>, <code>c-translate</code>,+<code>c-lookupmorpho</code>, <code>c-flush</code>,+<code>c-grammar</code>, <code>c-abstrtree</code>,+<code>c-parsetree</code>, <code>c-wordforword</code>.</li> </ul>-<p>They implement the same functionality as the corresponding commands without the <code>c-</code> prefix, although there are some restrictions in what parameters they support, and some differences in the JSON data structures they output.</p>-<p>When using these commands, the grammar will be loaded and cached by the C run-time system. If you use commands from both the Haskell and C implementations with the same grammar, the grammar will be loaded twice.</p>+<p>They implement the same functionality as the corresponding commands+without the <code>c-</code> prefix, although there are some restrictions+in what parameters they support, and some differences in the JSON data+structures they output.</p>+<p>When using these commands, the grammar will be loaded and cached by+the C run-time system. If you use commands from both the Haskell and C+implementations with the same grammar, the grammar will be loaded+twice.</p> <hr />-<p><a href="http://www.grammaticalframework.org">www.grammaticalframework.org</a></p>+<p><a+href="http://www.grammaticalframework.org">www.grammaticalframework.org</a></p> </div><!-- .container --> </div><!-- .bg-white -->

src/www/index.html view

@@ -22,7 +22,7 @@       (bilingual document editor)   <!--<li><a href="wc.html">Wide Coverage Translation Demo</a>-->   <li><a href="gfmorpho/">Word inflection with smart paradigms</a>-  <li><a href="https://cloud.grammaticalframework.org/wordnet">GF WordNet</a> (an online browser and editor for the WordNet lexicon)</li>+  <li><a href="wordnet/">GF WordNet</a> (an online browser and editor for the WordNet lexicon)</li> </ul>  <h2>Documentation</h2>

testsuite/run.hs view

@@ -66,6 +66,7 @@   [ "testsuite/runtime/parser/parser.gfs" -- Only parses `z` as `zero` and not also as e.g. `succ zero` as expected   , "testsuite/runtime/linearize/brackets.gfs" -- Missing "cannot linearize in the end"   , "testsuite/compiler/typecheck/abstract/non-abstract-terms.gfs" -- Gives a different error than expected+  , "testsuite/runtime/eval/eval.gfs"   ]  -- | Produce HTML document with test results