GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-21 00:52:51 -06:00
Code Issues Packages Projects Releases Wiki Activity

Add support for CAPIT and ALL_CAPIT

Browse Source
This commit is contained in:
John J. Camilleri
2021-02-16 15:17:54 +01:00
parent 21f14c2aa1
commit d394cacddf
6 changed files with 15 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/compiler/GF/Compile/GrammarToLPGF.hs
View File

@@ -95,8 +95,8 @@ mkCanon2lpgf opts gr am = do
"BIND" -> return L.LFBind "BIND" -> return L.LFBind
"SOFT_BIND" -> return L.LFBind "SOFT_BIND" -> return L.LFBind
"SOFT_SPACE" -> return L.LFSpace "SOFT_SPACE" -> return L.LFSpace
-- "CAPIT" -> "CAPIT" -> return L.LFCapit
-- "ALL_CAPIT" -> "ALL_CAPIT" -> return L.LFAllCapit
_ -> Left $ printf "Unknown predef function: %s" pid _ -> Left $ printf "Unknown predef function: %s" pid
C.RecordValue rrvs -> do C.RecordValue rrvs -> do

5
src/runtime/haskell/LPGF.hs
View File

@@ -9,6 +9,7 @@ import PGF.Expr (Expr)
import PGF.Tree (Tree (..), expr2tree, prTree) import PGF.Tree (Tree (..), expr2tree, prTree)
import Data.Binary (Binary, get, put, encodeFile, decodeFile) import Data.Binary (Binary, get, put, encodeFile, decodeFile)
import Data.Char (toUpper)
import Data.List (isPrefixOf) import Data.List (isPrefixOf)
import qualified Data.Map as Map import qualified Data.Map as Map
import Text.Printf (printf) import Text.Printf (printf)
@@ -50,6 +51,8 @@ data LinFun =
LFError String -- ^ a runtime error, should probably not be supported at all LFError String -- ^ a runtime error, should probably not be supported at all
| LFBind | LFBind
| LFSpace | LFSpace
| LFCapit
| LFAllCapit
| LFPre [([String], LinFun)] LinFun | LFPre [([String], LinFun)] LinFun
-- From original definition in paper -- From original definition in paper
@@ -161,6 +164,8 @@ lin2string l = case l of
l1 = if null matches then df else head matches l1 = if null matches then df else head matches
LFConcat l1 (LFConcat LFBind l2) -> lin2string l1 ++ lin2string l2 LFConcat l1 (LFConcat LFBind l2) -> lin2string l1 ++ lin2string l2
LFConcat l1 (LFConcat LFSpace l2) -> lin2string $ LFConcat l1 l2 LFConcat l1 (LFConcat LFSpace l2) -> lin2string $ LFConcat l1 l2
LFConcat LFCapit l2 -> let l = lin2string l2 in toUpper (head l) : tail l
LFConcat LFAllCapit l2 -> let tks = words (lin2string l2) in unwords $ map toUpper (head tks) : tail tks
LFConcat l1 l2 -> unwords $ filter (not.null) [lin2string l1, lin2string l2] LFConcat l1 l2 -> unwords $ filter (not.null) [lin2string l1, lin2string l2]
x -> printf "[%s]" (show x) x -> printf "[%s]" (show x)

2
testsuite/lpgf/Bind.gf
View File

@@ -7,4 +7,6 @@ abstract Bind = {
bind : S -> S -> S ; bind : S -> S -> S ;
softbind : S -> S -> S ; softbind : S -> S -> S ;
softspace : S -> S -> S ; softspace : S -> S -> S ;
capit : S -> S ;
allcapit : S -> S ;
} }

3
testsuite/lpgf/Bind.treebank
View File

@@ -15,3 +15,6 @@ BindCnc: hello theregoodbye
Bind: softspace f1 f2 Bind: softspace f1 f2
BindCnc: hello there goodbye BindCnc: hello there goodbye
Bind: concat (capit f1) (allcapit f2)
BindCnc: Hello there GOODBYE

1
testsuite/lpgf/Bind.trees
View File

@@ -4,3 +4,4 @@ concat f1 f2
bind f1 f2 bind f1 f2
softbind f1 f2 softbind f1 f2
softspace f1 f2 softspace f1 f2
concat (capit f1) (allcapit f2)

2
testsuite/lpgf/BindCnc.gf
View File

@@ -8,4 +8,6 @@ concrete BindCnc of Bind = open Prelude in {
bind a b = ss (a.s ++ BIND ++ b.s) ; bind a b = ss (a.s ++ BIND ++ b.s) ;
softbind a b = ss (a.s ++ SOFT_BIND ++ b.s) ; softbind a b = ss (a.s ++ SOFT_BIND ++ b.s) ;
softspace a b = ss (a.s ++ SOFT_SPACE ++ b.s) ; softspace a b = ss (a.s ++ SOFT_SPACE ++ b.s) ;
capit a = ss (CAPIT ++ a.s) ;
allcapit a = ss (ALL_CAPIT ++ a.s) ;
} }