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

polish the PGF API and make Expr and Type abstract types. Tree is a type synonym of Expr

Browse Source
This commit is contained in:
krasimir
2009-09-11 13:45:34 +00:00
parent 7a13751a10
commit d294b70395
31 changed files with 205 additions and 159 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
src/GF/Command/Commands.hs
View File

@@ -615,18 +615,18 @@ allCommands cod env@(pgf, mos) = Map.fromList [
case arg of
[EFun id] -> case Map.lookup id (funs (abstract pgf)) of
Just (ty,_,eqs) -> return $ fromString $
render (text "fun" <+> text (prCId id) <+> colon <+> ppType 0 [] ty $$
render (text "fun" <+> ppCId id <+> colon <+> ppType 0 [] ty $$
if null eqs
then empty
else text "def" <+> vcat [let (scope,ds) = mapAccumL (ppPatt 9) [] patts
in text (prCId id) <+> hsep ds <+> char '=' <+> ppExpr 0 scope res | Equ patts res <- eqs])
in ppCId id <+> hsep ds <+> char '=' <+> ppExpr 0 scope res | Equ patts res <- eqs])
Nothing -> case Map.lookup id (cats (abstract pgf)) of
Just hyps -> do return $ fromString $
render (text "cat" <+> text (prCId id) <+> hsep (snd (mapAccumL ppHypo [] hyps)) $$
render (text "cat" <+> ppCId id <+> hsep (snd (mapAccumL ppHypo [] hyps)) $$
if null (functionsToCat pgf id)
then empty
else space $$
text "fun" <+> vcat [text (prCId fid) <+> colon <+> ppType 0 [] ty
text "fun" <+> vcat [ppCId fid <+> colon <+> ppType 0 [] ty
| (fid,ty) <- functionsToCat pgf id])
Nothing -> do putStrLn "unknown identifier"
return void
@@ -647,8 +647,8 @@ allCommands cod env@(pgf, mos) = Map.fromList [
optLin opts t = unlines $
case opts of
_ | isOpt "treebank" opts -> (prCId (abstractName pgf) ++ ": " ++ showExpr [] t) :
[prCId lang ++ ": " ++ linear opts lang t | lang <- optLangs opts]
_ | isOpt "treebank" opts -> (showCId (abstractName pgf) ++ ": " ++ showExpr [] t) :
[showCId lang ++ ": " ++ linear opts lang t | lang <- optLangs opts]
_ -> [linear opts lang t | lang <- optLangs opts]
linear :: [Option] -> CId -> Expr -> String
@@ -689,7 +689,7 @@ allCommands cod env@(pgf, mos) = Map.fromList [
lang -> map mkCId (chunks ',' lang)
optLang opts = head $ optLangs opts ++ [wildCId]
optType opts =
let str = valStrOpts "cat" (prCId $ lookStartCat pgf) opts
let str = valStrOpts "cat" (showCId $ lookStartCat pgf) opts
in case readType str of
Just ty -> case checkType pgf ty of
Left tcErr -> error $ render (ppTcError tcErr)
@@ -714,7 +714,7 @@ allCommands cod env@(pgf, mos) = Map.fromList [
prGrammar opts
| isOpt "cats" opts = return $ fromString $ unwords $ map (showType []) $ categories pgf
| isOpt "fullform" opts = return $ fromString $ concatMap (prFullFormLexicon . morpho) $ optLangs opts
| isOpt "missing" opts = return $ fromString $ unlines $ [unwords (prCId la:":": map prCId cs) |
| isOpt "missing" opts = return $ fromString $ unlines $ [unwords (showCId la:":": map showCId cs) |
la <- optLangs opts, let cs = missingLins pgf la]
| otherwise = do fmt <- readOutputFormat (valStrOpts "printer" "pgf_pretty" opts)
return $ fromString $ concatMap snd $ exportPGF noOptions fmt pgf

1
src/GF/Command/TreeOperations.hs
View File

@@ -5,6 +5,7 @@ module GF.Command.TreeOperations (
import GF.Compile.TypeCheck
import PGF
import PGF.Data
import Data.List