summaryrefslogtreecommitdiff
path: root/src/GF
diff options
context:
space:
mode:
authorkrasimir <krasimir@chalmers.se>2009-09-20 11:43:41 +0000
committerkrasimir <krasimir@chalmers.se>2009-09-20 11:43:41 +0000
commitb1a51f46f5d137ab4d65a4381b349af3291a944d (patch)
treece1df7a103ba74a9c8a7eedbf2260bde37736166 /src/GF
parentd09371280d5b28d85acce7b7d899c21bc4e11b32 (diff)
change the data types and the syntax in PGF to match the new syntax for implict arguments
Diffstat (limited to 'src/GF')
-rw-r--r--src/GF/Command/Interpreter.hs2
-rw-r--r--src/GF/Command/TreeOperations.hs2
-rw-r--r--src/GF/Compile/GFCCtoProlog.hs31
-rw-r--r--src/GF/Compile/GrammarToGFCC.hs6
4 files changed, 15 insertions, 26 deletions
diff --git a/src/GF/Command/Interpreter.hs b/src/GF/Command/Interpreter.hs
index 17ff6aa29..ff84da8a3 100644
--- a/src/GF/Command/Interpreter.hs
+++ b/src/GF/Command/Interpreter.hs
@@ -74,7 +74,7 @@ appCommand xs c@(Command i os arg) = case arg of
_ -> c
where
app e = case e of
- EAbs x e -> EAbs x (app e)
+ EAbs b x e -> EAbs b x (app e)
EApp e1 e2 -> EApp (app e1) (app e2)
ELit l -> ELit l
EMeta i -> xs !! i
diff --git a/src/GF/Command/TreeOperations.hs b/src/GF/Command/TreeOperations.hs
index 73cef05b2..941f03782 100644
--- a/src/GF/Command/TreeOperations.hs
+++ b/src/GF/Command/TreeOperations.hs
@@ -27,6 +27,6 @@ allTreeOps pgf = [
smallest :: [Expr] -> [Expr]
smallest = sortBy (\t u -> compare (size t) (size u)) where
size t = case t of
- EAbs _ e -> size e + 1
+ EAbs _ _ e -> size e + 1
EApp e1 e2 -> size e1 + size e2 + 1
_ -> 1
diff --git a/src/GF/Compile/GFCCtoProlog.hs b/src/GF/Compile/GFCCtoProlog.hs
index a31fe4b84..702d4afe5 100644
--- a/src/GF/Compile/GFCCtoProlog.hs
+++ b/src/GF/Compile/GFCCtoProlog.hs
@@ -19,7 +19,7 @@ import GF.Text.UTF8
import qualified Data.Map as Map
import Data.Char (isAlphaNum, isAsciiLower, isAsciiUpper, ord)
-import Data.List (isPrefixOf)
+import Data.List (isPrefixOf,mapAccumL)
grammar2prolog, grammar2prolog_abs :: PGF -> String
-- Most prologs have problems with UTF8 encodings, so we skip that:
@@ -67,7 +67,7 @@ plAbstract (name, Abstr aflags funs cats _catfuns) =
plCat :: (CId, [Hypo]) -> String
plCat (cat, hypos) = plFact "cat" (plTypeWithHypos typ)
- where ((_,subst), hypos') = alphaConvert emptyEnv hypos
+ where ((_,subst), hypos') = mapAccumL alphaConvertHypo emptyEnv hypos
args = reverse [EFun x | (_,x) <- subst]
typ = DTyp hypos' cat args
@@ -76,7 +76,7 @@ plFun (fun, (typ,_,_)) = plFact "fun" (plp fun : plTypeWithHypos typ')
where typ' = snd $ alphaConvert emptyEnv typ
plTypeWithHypos :: Type -> [String]
-plTypeWithHypos (DTyp hypos cat args) = [plTerm (plp cat) (map plp args), plp hypos]
+plTypeWithHypos (DTyp hypos cat args) = [plTerm (plp cat) (map plp args), plList (map (\(_,x,ty) -> plOper ":" (plp x) (plp ty)) hypos)]
plFundef :: (CId, (Type,Int,[Equation])) -> [String]
plFundef (fun, (_,_,[])) = []
@@ -110,17 +110,12 @@ plConcrete (cncname, Concr cflags lins opers lincats lindefs
instance PLPrint Type where
plp (DTyp hypos cat args) | null hypos = result
- | otherwise = plOper " -> " (plp hypos) result
+ | otherwise = plOper " -> " (plList (map (\(_,x,ty) -> plOper ":" (plp x) (plp ty)) hypos)) result
where result = plTerm (plp cat) (map plp args)
-instance PLPrint Hypo where
- plp (Hyp typ) = plOper ":" (plp wildCId) (plp typ)
- plp (HypI var typ) = plOper ":" (plp var) (plp typ)
- plp (HypV var typ) = plOper ":" (plp var) (plp typ)
-
instance PLPrint Expr where
plp (EFun x) = plp x
- plp (EAbs x e) = plOper "^" (plp x) (plp e)
+ plp (EAbs _ x e)= plOper "^" (plp x) (plp e)
plp (EApp e e') = plOper " * " (plp e) (plp e')
plp (ELit lit) = plp lit
plp (EMeta n) = "Meta_" ++ show n
@@ -259,21 +254,15 @@ instance AlphaConvert a => AlphaConvert [a] where
instance AlphaConvert Type where
alphaConvert env@(_,subst) (DTyp hypos cat args)
= ((ctr,subst), DTyp hypos' cat args')
- where (env', hypos') = alphaConvert env hypos
+ where (env', hypos') = mapAccumL alphaConvertHypo env hypos
((ctr,_), args') = alphaConvert env' args
-instance AlphaConvert Hypo where
- alphaConvert env (Hyp typ) = ((ctr+1,subst), Hyp typ')
- where ((ctr,subst), typ') = alphaConvert env typ
- alphaConvert env (HypI x typ) = ((ctr+1,(x,x'):subst), HypI x' typ')
- where ((ctr,subst), typ') = alphaConvert env typ
- x' = createLogicalVariable ctr
- alphaConvert env (HypV x typ) = ((ctr+1,(x,x'):subst), HypV x' typ')
- where ((ctr,subst), typ') = alphaConvert env typ
- x' = createLogicalVariable ctr
+alphaConvertHypo env (b,x,typ) = ((ctr+1,(x,x'):subst), (b,x',typ'))
+ where ((ctr,subst), typ') = alphaConvert env typ
+ x' = createLogicalVariable ctr
instance AlphaConvert Expr where
- alphaConvert (ctr,subst) (EAbs x e) = ((ctr',subst), EAbs x' e')
+ alphaConvert (ctr,subst) (EAbs b x e) = ((ctr',subst), EAbs b x' e')
where ((ctr',_), e') = alphaConvert (ctr+1,(x,x'):subst) e
x' = createLogicalVariable ctr
alphaConvert env (EApp e1 e2) = (env'', EApp e1' e2')
diff --git a/src/GF/Compile/GrammarToGFCC.hs b/src/GF/Compile/GrammarToGFCC.hs
index b285faa81..a2b03ab63 100644
--- a/src/GF/Compile/GrammarToGFCC.hs
+++ b/src/GF/Compile/GrammarToGFCC.hs
@@ -129,7 +129,7 @@ mkExp :: [Ident] -> A.Term -> C.Expr
mkExp scope t = case GM.termForm t of
Ok (xs,c,args) -> mkAbs xs (mkApp (reverse xs++scope) c (map (mkExp scope) args))
where
- mkAbs xs t = foldr (C.EAbs . i2i) t xs
+ mkAbs xs t = foldr (C.EAbs C.Explicit . i2i) t xs
mkApp scope c args = case c of
Q _ c -> foldl C.EApp (C.EFun (i2i c)) args
QC _ c -> foldl C.EApp (C.EFun (i2i c)) args
@@ -156,8 +156,8 @@ mkPatt scope p =
mkContext :: [Ident] -> A.Context -> ([Ident],[C.Hypo])
mkContext scope hyps = mapAccumL (\scope (x,ty) -> let ty' = mkType scope ty
in if x == identW
- then ( scope,C.Hyp ty')
- else (x:scope,C.HypV (i2i x) ty')) scope hyps
+ then ( scope,(C.Explicit,i2i x,ty'))
+ else (x:scope,(C.Explicit,i2i x,ty'))) scope hyps
mkTerm :: Term -> C.Term
mkTerm tr = case tr of