now the datatype Tree is only internal. All API functions are working with Expr directly. Commands gt, gr, p and rf filter out the output via the typechecker

3 files changed, 45 insertions, 28 deletions

diff --git a/src/PGF/Parsing/FCFG/Active.hs b/src/PGF/Parsing/FCFG/Active.hs
index 07fa1ba4f..e88926f6e 100644
--- a/src/PGF/Parsing/FCFG/Active.hs
+++ b/src/PGF/Parsing/FCFG/Active.hs
@@ -16,6 +16,7 @@ import qualified GF.Data.MultiMap as MM
 
 import PGF.CId
 import PGF.Data
+import PGF.Tree
 import PGF.Parsing.FCFG.Utilities
 import PGF.BuildParser
 
@@ -37,8 +38,8 @@ makeFinalEdge cat 0 0 = (cat, [EmptyRange])
 makeFinalEdge cat i j = (cat, [makeRange i j])
 
 -- | the list of categories = possible starting categories
-parse :: String -> ParserInfo -> Type -> [FToken] -> [Tree]
-parse strategy pinfo (DTyp _ start _) toks = nubsort $ filteredForests >>= forest2trees
+parse :: String -> ParserInfo -> Type -> [FToken] -> [Expr]
+parse strategy pinfo (DTyp _ start _) toks = map (tree2expr) . nubsort $ filteredForests >>= forest2trees
   where
     inTokens = input toks
     starts = Map.findWithDefault [] start (startCats pinfo)
diff --git a/src/PGF/Parsing/FCFG/Incremental.hs b/src/PGF/Parsing/FCFG/Incremental.hs
index 0aedd6d30..dbc738a05 100644
--- a/src/PGF/Parsing/FCFG/Incremental.hs
+++ b/src/PGF/Parsing/FCFG/Incremental.hs
@@ -21,13 +21,17 @@ import Control.Monad
 import GF.Data.SortedList

 import PGF.CId

 import PGF.Data

+import PGF.Macros

+import PGF.TypeCheck

 import Debug.Trace

 

-parse :: ParserInfo -> Type -> [String] -> [Tree]

-parse pinfo typ toks = maybe [] (\ps -> extractExps ps typ) (foldM nextState (initState pinfo typ) toks)

+parse :: PGF -> Language -> Type -> [String] -> [Expr]

+parse pgf lang typ toks = maybe [] (\ps -> extractExps ps typ) (foldM nextState (initState pgf lang typ) toks)

 

-initState :: ParserInfo -> Type -> ParseState

-initState pinfo (DTyp _ start _) = 

+-- | Creates an initial parsing state for a given language and

+-- startup category.

+initState :: PGF -> Language -> Type -> ParseState

+initState pgf lang (DTyp _ start _) = 

   let items = do

         cat <- fromMaybe [] (Map.lookup start (startCats pinfo))

         (funid,args) <- foldForest (\funid args -> (:) (funid,args)) (\_ _ args -> args)

@@ -35,8 +39,14 @@ initState pinfo (DTyp _ start _) =
         let FFun fn _ lins = functions pinfo ! funid

         (lbl,seqid) <- assocs lins

         return (Active 0 0 funid seqid args (AK cat lbl))

-        

-  in State pinfo

+     

+      pinfo =

+        case lookParser pgf lang of

+          Just pinfo -> pinfo

+          _          -> error ("Unknown language: " ++ prCId lang)

+

+  in State pgf

+           pinfo

            (Chart emptyAC [] emptyPC (productions pinfo) (totalCats pinfo) 0)

            (TMap.singleton [] (Set.fromList items))

 

@@ -44,7 +54,7 @@ initState pinfo (DTyp _ start _) =
 -- 'nextState' computes a new state where the token

 -- is consumed and the current position shifted by one.

 nextState :: ParseState -> String -> Maybe ParseState

-nextState (State pinfo chart items) t =

+nextState (State pgf pinfo chart items) t =

   let (mb_agenda,map_items) = TMap.decompose items

       agenda = maybe [] Set.toList mb_agenda

       acc    = fromMaybe TMap.empty (Map.lookup t map_items)

@@ -56,7 +66,7 @@ nextState (State pinfo chart items) t =
                      }

   in if TMap.null acc1

        then Nothing

-       else Just (State pinfo chart2 acc1)

+       else Just (State pgf pinfo chart2 acc1)

   where

     add (tok:toks) item acc

       | tok == t            = TMap.insertWith Set.union toks (Set.singleton item) acc

@@ -67,7 +77,7 @@ nextState (State pinfo chart items) t =
 -- next words and the consequent states. This is used for word completions in

 -- the GF interpreter.

 getCompletions :: ParseState -> String -> Map.Map String ParseState

-getCompletions (State pinfo chart items) w =

+getCompletions (State pgf pinfo chart items) w =

   let (mb_agenda,map_items) = TMap.decompose items

       agenda = maybe [] Set.toList mb_agenda

       acc    = Map.filterWithKey (\tok _ -> isPrefixOf w tok) map_items

@@ -77,20 +87,25 @@ getCompletions (State pinfo chart items) w =
                      , passive=emptyPC

                      , offset =offset chart1+1

                      }

-  in fmap (State pinfo chart2) acc'

+  in fmap (State pgf pinfo chart2) acc'

   where

     add (tok:toks) item acc

       | isPrefixOf w tok    = Map.insertWith (TMap.unionWith Set.union) tok (TMap.singleton toks (Set.singleton item)) acc

     add _          item acc = acc

 

-extractExps :: ParseState -> Type -> [Tree]

-extractExps (State pinfo chart items) (DTyp _ start _) = exps

+-- | This function extracts the list of all completed parse trees

+-- that spans the whole input consumed so far. The trees are also

+-- limited by the category specified, which is usually

+-- the same as the startup category.

+extractExps :: ParseState -> Type -> [Expr]

+extractExps (State pgf pinfo chart items) ty@(DTyp _ start _) = 

+  nubsort [e1 | e <- exps, Right e1 <- [checkExpr pgf e ty]]

   where

     (mb_agenda,acc) = TMap.decompose items

     agenda = maybe [] Set.toList mb_agenda

     (_,st) = process Nothing (\_ _ -> id) (sequences pinfo) (functions pinfo) agenda () chart

 

-    exps = nubsort $ do

+    exps = do

       cat <- fromMaybe [] (Map.lookup start (startCats pinfo))

       (funid,args) <- foldForest (\funid args -> (:) (funid,args)) (\_ _ args -> args)

                                  [] cat (productions pinfo)

@@ -102,7 +117,7 @@ extractExps (State pinfo chart items) (DTyp _ start _) = exps
       return tree

 

     go rec fcat' (d,fcat)

-      | fcat < totalCats pinfo = return (Set.empty,Meta (fcat'*10+d))   -- FIXME: here we assume that every rule has at most 10 arguments

+      | fcat < totalCats pinfo = return (Set.empty,EMeta (fcat'*10+d))   -- FIXME: here we assume that every rule has at most 10 arguments

       | Set.member fcat rec    = mzero

       | otherwise              = foldForest (\funid args trees -> 

                                                   do let FFun fn _ lins = functions pinfo ! funid

@@ -118,14 +133,14 @@ extractExps (State pinfo chart items) (DTyp _ start _) = exps
 

     check_ho_fun fun args

       | fun == _V = return (head args)

-      | fun == _B = return (foldl1 Set.difference (map fst args),Abs [mkVar (snd e) | e <- tail args] (snd (head args)))

-      | otherwise = return (Set.unions (map fst args),Fun fun (map snd args))

+      | fun == _B = return (foldl1 Set.difference (map fst args), foldr (\x e -> EAbs (mkVar (snd x)) e) (snd (head args)) (tail args))

+      | otherwise = return (Set.unions (map fst args),foldl (\e x -> EApp e (snd x)) (EFun fun) args)

     

-    mkVar (Var  v) = v

-    mkVar (Meta _) = wildCId

+    mkVar (EFun  v) = v

+    mkVar (EMeta _) = wildCId

     

-    freeVar (Var v) = Set.singleton v

-    freeVar _       = Set.empty

+    freeVar (EFun v) = Set.singleton v

+    freeVar _        = Set.empty

 

 _B = mkCId "_B"

 _V = mkCId "_V"

@@ -194,12 +209,12 @@ updateAt :: Int -> a -> [a] -> [a]
 updateAt nr x xs = [if i == nr then x else y | (i,y) <- zip [0..] xs]

 

 litCatMatch fcat (Just t)

-  | fcat == fcatString = Just ([t],Lit (LStr t))

-  | fcat == fcatInt    = case reads t of {[(n,"")] -> Just ([t],Lit (LInt n));

+  | fcat == fcatString = Just ([t],ELit (LStr t))

+  | fcat == fcatInt    = case reads t of {[(n,"")] -> Just ([t],ELit (LInt n));

                                          _         -> Nothing }

-  | fcat == fcatFloat  = case reads t of {[(d,"")] -> Just ([t],Lit (LFlt d));

+  | fcat == fcatFloat  = case reads t of {[(d,"")] -> Just ([t],ELit (LFlt d));

                                          _         -> Nothing }

-  | fcat == fcatVar    = Just ([t],Var (mkCId t))

+  | fcat == fcatVar    = Just ([t],EFun (mkCId t))

 litCatMatch _    _     = Nothing

 

 

@@ -263,7 +278,7 @@ insertPC key fcat chart = Map.insert key fcat chart
 -- Forest

 ----------------------------------------------------------------

 

-foldForest :: (FunId -> [FCat] -> b -> b) -> (Tree -> [String] -> b -> b) -> b -> FCat -> IntMap.IntMap (Set.Set Production) -> b

+foldForest :: (FunId -> [FCat] -> b -> b) -> (Expr -> [String] -> b -> b) -> b -> FCat -> IntMap.IntMap (Set.Set Production) -> b

 foldForest f g b fcat forest =

   case IntMap.lookup fcat forest of

     Nothing  -> b

@@ -280,7 +295,7 @@ foldForest f g b fcat forest =
 

 -- | An abstract data type whose values represent

 -- the current state in an incremental parser.

-data ParseState = State ParserInfo Chart (TMap.TrieMap String (Set.Set Active))

+data ParseState = State PGF ParserInfo Chart (TMap.TrieMap String (Set.Set Active))

 

 data Chart

   = Chart

diff --git a/src/PGF/Parsing/FCFG/Utilities.hs b/src/PGF/Parsing/FCFG/Utilities.hs
index 6a2c13c0a..dc0b2dc4a 100644
--- a/src/PGF/Parsing/FCFG/Utilities.hs
+++ b/src/PGF/Parsing/FCFG/Utilities.hs
@@ -20,6 +20,7 @@ import Data.List (groupBy)
 
 import PGF.CId
 import PGF.Data
+import PGF.Tree
 import GF.Data.Assoc
 import GF.Data.Utilities (sameLength, foldMerge, splitBy)