Add support for SOFT_SPACE

src/compiler/GF/Compile/GrammarToLPGF.hs

@@ -90,10 +90,11 @@ mkCanon2lpgf opts gr am = do
                   term = foldl L.LFProjection tuple (L.LFInt (pidIx+1):pids')
                 return term
 
+              -- https://www.aclweb.org/anthology/W15-3305.pdf
               C.PredefValue (C.PredefId pid) -> case pid of
                 "BIND" -> return L.LFBind
                 "SOFT_BIND" -> return L.LFBind
-                -- "SOFT_SPACE" ->
+                "SOFT_SPACE" -> return L.LFSpace
                 -- "CAPIT" ->
                 -- "ALL_CAPIT" ->
                 _ -> Left $ printf "Unknown predef function: %s" pid

src/runtime/haskell/LPGF.hs

@@ -48,7 +48,8 @@ data Concr = Concr {
 data LinFun =
   -- Additions
     LFError String -- ^ a runtime error, should probably not be supported at all
-  | LFBind -- ^ bind token
+  | LFBind
+  | LFSpace
   | LFPre [([String], LinFun)] LinFun
 
   -- From original definition in paper
@@ -127,19 +128,14 @@ type Context = [LinFun]
 eval :: Context -> LinFun -> LinFun
 eval cxt t = case t of
   LFError err -> error err
-  LFBind -> LFBind
   LFPre pts df -> LFPre pts' df'
     where
       pts' = [ (strs, eval cxt t) | (strs,t) <- pts]
       df' = eval cxt df
-
-  LFEmpty -> LFEmpty
-  LFToken tok -> LFToken tok
   LFConcat s t -> LFConcat v w
     where
       v = eval cxt s
       w = eval cxt t
-  LFInt i -> LFInt i
   LFTuple ts -> LFTuple vs
     where vs = map (eval cxt) ts
   LFProjection t u ->
@@ -148,12 +144,14 @@ eval cxt t = case t of
       (tp@(LFTuple _), LFTuple is) | all isInt is -> foldl (\(LFTuple vs) (LFInt i) -> vs !! (i-1)) tp is
       (t',u') -> error $ printf "Incompatible projection:\n%s\n%s" (show t) (show u)
   LFArgument i -> cxt !! (i-1)
+  _ -> t
 
 -- | Turn concrete syntax terms into an actual string
 lin2string :: LinFun -> String
 lin2string l = case l of
   LFEmpty -> ""
   LFBind -> "" -- when encountered at beginning/end
+  LFSpace -> "" -- when encountered at beginning/end
   LFToken tok -> tok
   LFTuple [l] -> lin2string l
   LFConcat (LFPre pts df) l2 -> lin2string $ LFConcat l1 l2
@@ -162,6 +160,7 @@ lin2string l = case l of
       matches = [ l | (pfxs, l) <- pts, any (`isPrefixOf` l2') pfxs ]
       l1 = if null matches then df else head matches
   LFConcat l1 (LFConcat LFBind l2) -> lin2string l1 ++ lin2string l2
+  LFConcat l1 (LFConcat LFSpace l2) -> lin2string $ LFConcat l1 l2
   LFConcat l1 l2 -> unwords $ filter (not.null) [lin2string l1, lin2string l2]
   x -> printf "[%s]" (show x)
 

testsuite/lpgf/Bind.gf

@@ -6,4 +6,5 @@ abstract Bind = {
     concat : S -> S -> S ;
     bind : S -> S -> S ;
     softbind : S -> S -> S ;
+    softspace : S -> S -> S ;
 }

testsuite/lpgf/Bind.treebank

@@ -12,3 +12,6 @@ BindCnc: hello theregoodbye
 
 Bind: softbind f1 f2
 BindCnc: hello theregoodbye
+
+Bind: softspace f1 f2
+BindCnc: hello there goodbye

testsuite/lpgf/Bind.trees

@@ -3,3 +3,4 @@ f2
 concat f1 f2
 bind f1 f2
 softbind f1 f2
+softspace f1 f2

testsuite/lpgf/BindCnc.gf

@@ -7,4 +7,5 @@ concrete BindCnc of Bind = open Prelude in {
     concat a b = ss (a.s ++ b.s) ;
     bind a b = ss (a.s ++ BIND ++ b.s) ;
     softbind a b = ss (a.s ++ SOFT_BIND ++ b.s) ;
+    softspace a b = ss (a.s ++ SOFT_SPACE ++ b.s) ;
 }