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

Many fixes to JSGF format (never tested before). Implemented JSGF+SISR. Left recursion removal destroys SISR, must be fixed.

Browse Source
This commit is contained in:
bringert
2006-12-17 13:17:17 +00:00
parent bd4dbfb26b
commit 44af93a9c9
5 changed files with 98 additions and 51 deletions
Download Patch File Download Diff File Expand all files Collapse all files

28
src/GF/Speech/SISR.hs
View File

@@ -10,10 +10,19 @@
--
-----------------------------------------------------------------------------
module GF.Speech.SISR (SISRFormat(..), SISRExpr(..), prSISR) where
module GF.Speech.SISR (SISRFormat(..), SISRExpr(..), prSISR,
profileInitSISR, catSISR) where
import Data.List
import GF.Conversion.Types
import GF.Data.Utilities
import GF.Formalism.CFG
import GF.Formalism.Utilities (Symbol(..), NameProfile(..), Profile(..), forestName)
import GF.Infra.Ident
import GF.Speech.SRG
infixl 8 :.
infixr 1 :=
@@ -32,8 +41,8 @@ data SISRExpr = SISRExpr := SISRExpr
| ENew String [SISRExpr]
deriving Show
prSISR :: SISRFormat -> SISRExpr -> String
prSISR fmt = f
prSISR :: SISRFormat -> [SISRExpr] -> String
prSISR fmt = join "; " . map f
where
f e =
case e of
@@ -43,4 +52,15 @@ prSISR fmt = f
ERef y -> "$" ++ y
EStr s -> show s
EApp x ys -> f x ++ "(" ++ concat (intersperse "," (map f ys)) ++ ")"
ENew n ys -> "new " ++ n ++ "(" ++ concat (intersperse "," (map f ys)) ++ ")"
ENew n ys -> "new " ++ n ++ "(" ++ concat (intersperse "," (map f ys)) ++ ")"
profileInitSISR :: Name -> [SISRExpr]
profileInitSISR (Name f prs) =
[(EThis :. "name") := (EStr (prIdent f))] ++
[(EThis :. ("arg" ++ show n)) := (EStr (argInit (prs!!n)))
| n <- [0..length prs-1]]
where argInit (Unify _) = "?"
argInit (Constant f) = maybe "?" prIdent (forestName f)
catSISR :: SRGNT -> [SISRExpr]
catSISR (c,slots) = [(EThis :. ("arg" ++ show s)) := (ERef c) | s <- slots]