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

first draft of a working "create lin" command

Browse Source
This commit is contained in:
Krasimir Angelov
2021-12-28 13:36:53 +01:00
parent 1959dd4499
commit c9b90a509c
2 changed files with 29 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
src/compiler/GF/Compile/GeneratePMCFG.hs
View File

@@ -10,7 +10,7 @@
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module GF.Compile.GeneratePMCFG module GF.Compile.GeneratePMCFG
(generatePMCFG, type2fields (generatePMCFG, pmcfgForm, type2fields
) where ) where
import GF.Grammar hiding (VApp,VRecType) import GF.Grammar hiding (VApp,VRecType)

32
src/compiler/GF/Interactive.hs
View File

@@ -12,12 +12,17 @@ import GF.Command.CommandInfo
import GF.Command.Help(helpCommand) import GF.Command.Help(helpCommand)
import GF.Command.Abstract import GF.Command.Abstract
import GF.Command.Parse(readCommandLine,pCommand,readTransactionCommand) import GF.Command.Parse(readCommandLine,pCommand,readTransactionCommand)
import GF.Compile.Rename(renameSourceTerm)
import GF.Compile.CheckGrammar(linTypeOfType)
import GF.Compile.TypeCheck.Concrete(inferLType)
import GF.Compile.GeneratePMCFG(pmcfgForm)
import GF.Data.Operations (Err(..)) import GF.Data.Operations (Err(..))
import GF.Data.Utilities(whenM,repeatM) import GF.Data.Utilities(whenM,repeatM)
import GF.Grammar hiding (Ident,isPrefixOf) import GF.Grammar hiding (Ident,isPrefixOf)
import GF.Infra.UseIO(ioErrorText,putStrLnE) import GF.Infra.UseIO(ioErrorText,putStrLnE)
import GF.Infra.SIO import GF.Infra.SIO
import GF.Infra.Option import GF.Infra.Option
import GF.Infra.CheckM
import qualified System.Console.Haskeline as Haskeline import qualified System.Console.Haskeline as Haskeline
import PGF2 import PGF2
@@ -34,7 +39,6 @@ import qualified GF.System.Signal as IO(runInterruptibly)
#ifdef SERVER_MODE #ifdef SERVER_MODE
import GF.Server(server) import GF.Server(server)
#endif #endif
import GF.Command.Messages(welcome) import GF.Command.Messages(welcome)
-- | Run the GF Shell in quiet mode (@gf -run@). -- | Run the GF Shell in quiet mode (@gf -run@).
@@ -241,9 +245,29 @@ transactionCommand (CreateConcrete opts name) pgf = do
lift $ modifyPGF pgf (createConcrete name (return ())) lift $ modifyPGF pgf (createConcrete name (return ()))
return () return ()
transactionCommand (CreateLin opts f t) pgf = do transactionCommand (CreateLin opts f t) pgf = do
lang <- optLang pgf opts sgr <- getGrammar
lift $ modifyPGF pgf (alterConcrete lang (createLin f [])) mo <- maybe (fail "no source grammar in scope") return $
return () greatestResource sgr
ty <- case functionType pgf f of
Just ty -> return $ type2term mo ty
Nothing -> fail ("Function "++f++" is not in the abstract syntax")
case runCheck (compileLinTerm sgr mo t ty) of
Ok (prods,_) -> do lang <- optLang pgf opts
lift $ modifyPGF pgf (alterConcrete lang (createLin f prods))
return ()
Bad msg -> fail msg
where
type2term mo (DTyp hypos cat _) =
foldr (\(b,x,ty1) ty2 -> Prod b (identS x) (type2term mo ty1) ty2)
(Vr (identS cat))
hypos
compileLinTerm sgr mo t ty = do
t <- renameSourceTerm sgr mo (Typed t ty)
(t,ty) <- inferLType sgr [] t
let (ctxt,res_ty) = typeFormCnc ty
pmcfgForm sgr t ctxt res_ty
transactionCommand (CreateLincat opts c t) pgf = do transactionCommand (CreateLincat opts c t) pgf = do
lang <- optLang pgf opts lang <- optLang pgf opts
lift $ modifyPGF pgf (alterConcrete lang (createLincat c [] [] [])) lift $ modifyPGF pgf (alterConcrete lang (createLincat c [] [] []))