change the PGF.Data.Exp type

7 files changed, 54 insertions, 68 deletions

diff --git a/src-3.0/PGF/Data.hs b/src-3.0/PGF/Data.hs
index 34c58e5d6..2750cbdfa 100644
--- a/src-3.0/PGF/Data.hs
+++ b/src-3.0/PGF/Data.hs
@@ -41,19 +41,16 @@ data Type =
   deriving (Eq,Ord,Show)
 
 data Exp =
-   DTr [CId] Atom [Exp]
+   EAbs [CId] Exp
+ | EApp CId [Exp]
+ | EStr   String
+ | EInt   Integer
+ | EFloat Double
+ | EMeta  Integer
+ | EVar   CId
  | EEq [Equation]
   deriving (Eq,Ord,Show)
 
-data Atom =
-   AC CId
- | AS String
- | AI Integer
- | AF Double
- | AM Integer
- | AV CId
-  deriving (Eq,Ord,Show)
-
 data Term =
    R [Term]
  | P Term Term
diff --git a/src-3.0/PGF/Generate.hs b/src-3.0/PGF/Generate.hs
index 72340ffa3..ac5c25b08 100644
--- a/src-3.0/PGF/Generate.hs
+++ b/src-3.0/PGF/Generate.hs
@@ -11,13 +11,13 @@ import System.Random
 generate :: GFCC -> CId -> Maybe Int -> [Exp]
 generate gfcc cat dp = concatMap (\i -> gener i cat) depths
  where
-  gener 0 c = [tree (AC f) [] | (f, ([],_)) <- fns c]
+  gener 0 c = [EApp f [] | (f, ([],_)) <- fns c]
   gener i c = [
     tr | 
       (f, (cs,_)) <- fns c,
       let alts = map (gener (i-1)) cs,
       ts <- combinations alts,
-      let tr = tree (AC f) ts,
+      let tr = EApp f ts,
       depth tr >= i
     ]
   fns c = [(f,catSkeleton ty) | (f,ty) <- functionsToCat gfcc c]
@@ -36,16 +36,16 @@ genRandom gen gfcc cat = genTrees (randomRs (0.0, 1.0 :: Double) gen) cat where
                 (genTrees ds2 cat)          -- else (drop k ds)
 
   genTree rs = gett rs where
-    gett ds cid | cid == mkCId "String" = (tree (AS "foo") [], 1)
-    gett ds cid | cid == mkCId "Int"    = (tree (AI 12345) [], 1)
-    gett [] _ = (tree (AS "TIMEOUT") [], 1) ----
+    gett ds cid | cid == mkCId "String" = (EStr "foo", 1)
+    gett ds cid | cid == mkCId "Int"    = (EInt 12345, 1)
+    gett [] _   = (EStr "TIMEOUT", 1) ----
     gett ds cat = case fns cat of
-      [] -> (tree (AM 0) [],1)
+      [] -> (EMeta 0,1)
       fs -> let 
           d:ds2    = ds
           (f,args) = getf d fs
           (ts,k)   = getts ds2 args
-        in (tree (AC f) ts, k+1)
+        in (EApp f ts, k+1)
     getf d fs = let lg = (length fs) in
       fs !! (floor (d * fromIntegral lg))
     getts ds cats = case cats of
diff --git a/src-3.0/PGF/Linearize.hs b/src-3.0/PGF/Linearize.hs
index 94d8aa216..d84c48f89 100644
--- a/src-3.0/PGF/Linearize.hs
+++ b/src-3.0/PGF/Linearize.hs
@@ -26,25 +26,21 @@ realize trm = case trm of
   _ -> "ERROR " ++ show trm ---- debug
 
 linExp :: GFCC -> CId -> Exp -> Term
-linExp mcfg lang tree@(DTr xs at trees) =
-  addB $ case at of
-    AC fun -> comp (map lin trees) $ look fun
-    AS s   -> R [kks (show s)] -- quoted
-    AI i   -> R [kks (show i)] 
-                --- [C lst, kks (show i), C size] where 
-                --- lst = mod (fromInteger i) 10 ; size = if i < 10 then 0 else 1
-    AF d   -> R [kks (show d)]
-    AV x   -> TM (prCId x)
-    AM i   -> TM (show i)
- where
-   lin  = linExp mcfg lang
-   comp = compute mcfg lang
-   look = lookLin mcfg lang
-   addB t 
-     | Data.List.null xs = t
-     | otherwise = case t of
-         R ts -> R $ ts ++ (Data.List.map (kks . prCId) xs)
-         TM s -> R $ t  :  (Data.List.map (kks . prCId) xs)
+linExp gfcc lang = lin
+  where
+    lin (EAbs   xs  e ) = case lin e of
+                            R ts -> R $ ts     ++ (Data.List.map (kks . prCId) xs)
+                            TM s -> R $ (TM s)  : (Data.List.map (kks . prCId) xs)
+    lin (EApp   fun es) = comp (map lin es) $ look fun
+    lin (EStr   s     ) = R [kks (show s)] -- quoted
+    lin (EInt   i     ) = R [kks (show i)] 
+    lin (EFloat d     ) = R [kks (show d)]
+    lin (EVar   x     ) = TM (prCId x)
+    lin (EMeta  i     ) = TM (show i)
+ 
+    comp = compute gfcc lang
+    look = lookLin gfcc lang
+
 
 compute :: GFCC -> CId -> [Term] -> Term -> Term
 compute mcfg lang args = comp where
diff --git a/src-3.0/PGF/Macros.hs b/src-3.0/PGF/Macros.hs
index 64ddd24e4..6c6fef1e5 100644
--- a/src-3.0/PGF/Macros.hs
+++ b/src-3.0/PGF/Macros.hs
@@ -62,12 +62,9 @@ functionsToCat gfcc cat =
    fs = lookMap [] cat $ catfuns $ abstract gfcc
 
 depth :: Exp -> Int
-depth tr = case tr of
-  DTr _ _ [] -> 1
-  DTr _ _ ts -> maximum (map depth ts) + 1
-
-tree :: Atom -> [Exp] -> Exp
-tree = DTr []
+depth (EAbs _  t) = depth t
+depth (EApp _ ts) = maximum (0:map depth ts) + 1
+depth _           = 1
 
 cftype :: [CId] -> CId -> Type
 cftype args val = DTyp [Hyp wildCId (cftype [] arg) | arg <- args] val []
@@ -88,9 +85,6 @@ contextLength :: Type -> Int
 contextLength ty = case ty of
   DTyp hyps _ _ -> length hyps
 
-exp0 :: Exp
-exp0 = tree (AM 0) []
-
 primNotion :: Exp
 primNotion = EEq []
 
diff --git a/src-3.0/PGF/Parsing/FCFG/Utilities.hs b/src-3.0/PGF/Parsing/FCFG/Utilities.hs
index b33d5ccaa..e435c6154 100644
--- a/src-3.0/PGF/Parsing/FCFG/Utilities.hs
+++ b/src-3.0/PGF/Parsing/FCFG/Utilities.hs
@@ -180,8 +180,8 @@ applyProfileToForest (FMeta)     = [FMeta]
 
 
 forest2exps :: SyntaxForest CId -> [Exp]
-forest2exps (FNode n forests) = map (DTr [] (AC n)) $ forests >>= mapM forest2exps
-forest2exps (FString s) = [DTr [] (AS s) []]
-forest2exps (FInt    n) = [DTr [] (AI n) []]
-forest2exps (FFloat  f) = [DTr [] (AF f) []]
-forest2exps (FMeta)     = [DTr [] (AM 0) []]
+forest2exps (FNode n forests) = map (EApp n) $ forests >>= mapM forest2exps
+forest2exps (FString s) = [EStr   s]
+forest2exps (FInt    n) = [EInt   n]
+forest2exps (FFloat  f) = [EFloat f]
+forest2exps (FMeta)     = [EMeta  0]
diff --git a/src-3.0/PGF/Raw/Convert.hs b/src-3.0/PGF/Raw/Convert.hs
index 3e077cc8d..9954f3eb5 100644
--- a/src-3.0/PGF/Raw/Convert.hs
+++ b/src-3.0/PGF/Raw/Convert.hs
@@ -107,15 +107,14 @@ toHypo e = case e of
 
 toExp :: RExp -> Exp
 toExp e = case e of
-  App "App" [App fun [], App "B" xs, App "X" exps] ->
-    DTr [mkCId x | App x [] <- xs] (AC (mkCId fun)) (map toExp exps)
-  App "Eq" eqs -> 
-    EEq [Equ (map toExp ps) (toExp v) | App "E" (v:ps) <- eqs]
-  App "Var" [App i []] -> DTr [] (AV (mkCId i)) []
-  AMet -> DTr [] (AM 0) []
-  AInt i -> DTr [] (AI i) []
-  AFlt i -> DTr [] (AF i) []
-  AStr i -> DTr [] (AS i) []
+  App "Abs" [App "B" xs, exp]   -> EAbs [mkCId x | App x [] <- xs] (toExp exp)
+  App "App" (App fun [] : exps) -> EApp (mkCId fun) (map toExp exps)
+  App "Eq" eqs -> EEq [Equ (map toExp ps) (toExp v) | App "E" (v:ps) <- eqs]
+  App "Var" [App i []] -> EVar (mkCId i)
+  AMet   -> EMeta  0
+  AInt i -> EInt   i
+  AFlt i -> EFloat i
+  AStr i -> EStr   i
   _ -> error $ "exp " ++ show e
 
 toTerm :: RExp -> Term
@@ -173,14 +172,14 @@ fromHypo e = case e of
 
 fromExp :: Exp -> RExp
 fromExp e = case e of
-  DTr xs (AC fun) exps ->
-    App "App" [App (prCId fun) [], App "B" (map (flip App [] . prCId) xs), App "X" (map fromExp exps)]
-  DTr [] (AV x) [] -> App "Var" [App (prCId x) []]
-  DTr [] (AS s) [] -> AStr s
-  DTr [] (AF d) [] -> AFlt d
-  DTr [] (AI i) [] -> AInt (toInteger i)
-  DTr [] (AM _) [] -> AMet ----
-  EEq eqs -> 
+  EAbs xs exp   -> App "Abs" [App "B" (map (flip App [] . prCId) xs), fromExp exp]
+  EApp fun exps -> App "App" (App (prCId fun) [] : map fromExp exps)
+  EVar   x -> App "Var" [App (prCId x) []]
+  EStr   s -> AStr s
+  EFloat d -> AFlt d
+  EInt   i -> AInt (toInteger i)
+  EMeta _  -> AMet ----
+  EEq eqs  -> 
     App "Eq" [App "E" (map fromExp (v:ps)) | Equ ps v <- eqs]
   _ -> error $ "exp " ++ show e
 
diff --git a/src-3.0/PGF/ShowLinearize.hs b/src-3.0/PGF/ShowLinearize.hs
index 9aa316ba9..2aecbffbd 100644
--- a/src-3.0/PGF/ShowLinearize.hs
+++ b/src-3.0/PGF/ShowLinearize.hs
@@ -77,7 +77,7 @@ recordLinearize gfcc lang = prRecord . recLinearize gfcc lang
 recLinearize :: GFCC -> CId -> Exp -> Record
 recLinearize gfcc lang exp = mkRecord typ $ linExp gfcc lang exp where
   typ = case exp of
-    DTr _ (AC f) _ -> lookParamLincat gfcc lang $ valCat $ lookType gfcc f
+          EApp f _ -> lookParamLincat gfcc lang $ valCat $ lookType gfcc f
 
 -- show GFCC term
 termLinearize :: GFCC -> CId -> Exp -> String