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

change the PGF.Data.Exp type

Browse Source
This commit is contained in:
krasimir
2008-05-30 09:10:28 +00:00
parent 3d2ce9216d
commit 587eed4eaa
11 changed files with 118 additions and 145 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
src-3.0/GF/Command/Commands.hs
View File

@@ -149,10 +149,9 @@ allCommands mgr = Map.fromAscList [
gr = gfcc mgr
fromTrees ts = (ts,unlines (map showTree ts))
fromStrings ss = (map tStr ss, unlines ss)
fromString s = ([tStr s], s)
toStrings ts = [s | DTr [] (AS s) [] <- ts]
tStr s = DTr [] (AS s) []
fromStrings ss = (map EStr ss, unlines ss)
fromString s = ([EStr s], s)
toStrings ts = [s | EStr s <- ts]
prGrammar opts = case valIdOpts "printer" "" opts of
"cats" -> unwords $ categories mgr

43
src-3.0/GF/Command/PPrTree.hs
View File

@@ -1,39 +1,26 @@
module GF.Command.PPrTree (pTree, prExp, tree2exp) where
module GF.Command.PPrTree (tree2exp, exp2tree) where
import PGF.CId
import PGF.Data
import PGF.Macros
import qualified GF.Command.ParGFShell as P
import GF.Command.PrintGFShell
import GF.Command.AbsGFShell
import GF.Data.ErrM
pTree :: String -> Exp
pTree s = case P.pTree (P.myLexer s) of
Ok t -> tree2exp t
Bad s -> error s
tree2exp t = case t of
TApp f ts -> tree (AC (i2i f)) (map tree2exp ts)
TAbs xs t -> DTr (map i2i xs ++ ys) f ts where DTr ys f ts = tree2exp t
TId c -> tree (AC (i2i c)) []
TInt i -> tree (AI i) []
TStr s -> tree (AS s) []
TFloat d -> tree (AF d) []
TApp f ts -> EApp (i2i f) (map tree2exp ts)
TAbs xs t -> EAbs (map i2i xs) (tree2exp t)
TId c -> EApp (i2i c) []
TInt i -> EInt i
TStr s -> EStr s
TFloat d -> EFloat d
where
i2i (Ident s) = mkCId s
prExp :: Exp -> String
prExp = printTree . exp2tree
exp2tree (DTr xs at ts) = tabs (map i4i xs) (tapp at (map exp2tree ts))
exp2tree t = case t of
(EAbs xs e) -> TAbs (map i4i xs) (exp2tree e)
(EApp f []) -> TId (i4i f)
(EApp f es) -> TApp (i4i f) (map exp2tree es)
(EInt i) -> TInt i
(EStr i) -> TStr i
(EFloat i) -> TFloat i
(EMeta i) -> TId (Ident "?") ----
where
tabs [] t = t
tabs ys t = TAbs ys t
tapp (AC f) [] = TId (i4i f)
tapp (AC f) vs = TApp (i4i f) vs
tapp (AI i) [] = TInt i
tapp (AS i) [] = TStr i
tapp (AF i) [] = TFloat i
tapp (AM i) [] = TId (Ident "?") ----
i4i s = Ident (prCId s)

34
src-3.0/GF/Compile/GrammarToGFCC.hs
View File

@@ -117,22 +117,24 @@ mkExp :: A.Term -> C.Exp
mkExp t = case t of
A.Eqs eqs -> C.EEq [C.Equ (map mkPatt ps) (mkExp e) | (ps,e) <- eqs]
_ -> case GM.termForm t of
Ok (xx,c,args) -> C.DTr [i2i x | x <- xx] (mkAt c) (map mkExp args)
where
mkAt c = case c of
Q _ c -> C.AC $ i2i c
QC _ c -> C.AC $ i2i c
Vr x -> C.AV $ i2i x
EInt i -> C.AI i
EFloat f -> C.AF f
K s -> C.AS s
Meta (MetaSymb i) -> C.AM $ toInteger i
_ -> C.AM 0
mkPatt p = uncurry CM.tree $ case p of
A.PP _ c ps -> (C.AC (i2i c), map mkPatt ps)
A.PV x -> (C.AV (i2i x), [])
A.PW -> (C.AV wildCId, [])
A.PInt i -> (C.AI i, [])
Ok (xs,c,args) -> mkAbs xs (mkApp c (map mkExp args))
where
mkAbs [] t = t
mkAbs xs t = C.EAbs [i2i x | x <- xs] t
mkApp c args = case c of
Q _ c -> C.EApp (i2i c) args
QC _ c -> C.EApp (i2i c) args
Vr x -> C.EVar (i2i x)
EInt i -> C.EInt i
EFloat f -> C.EFloat f
K s -> C.EStr s
Meta (MetaSymb i) -> C.EMeta (toInteger i)
_ -> C.EMeta 0
mkPatt p = case p of
A.PP _ c ps -> C.EApp (i2i c) (map mkPatt ps)
A.PV x -> C.EVar (i2i x)
A.PW -> C.EVar wildCId
A.PInt i -> C.EInt i
mkContext :: A.Context -> [C.Hypo]
mkContext hyps = [C.Hyp (i2i x) (mkType ty) | (x,ty) <- hyps]