bugfix in the linearization algorithm

1 files changed, 21 insertions, 21 deletions

diff --git a/src/runtime/haskell/PGF/Linearize.hs b/src/runtime/haskell/PGF/Linearize.hs
index cf70c1efb..79da0e823 100644
--- a/src/runtime/haskell/PGF/Linearize.hs
+++ b/src/runtime/haskell/PGF/Linearize.hs
@@ -63,38 +63,38 @@ type CncType = (CId, FId)    -- concrete type is the abstract type (the category
 
 linTree :: PGF -> Language -> Expr -> [Array LIndex BracketedTokn]
 linTree pgf lang e = 
-  [amapWithIndex (\label -> Bracket_ cat fid label [e]) lin | (_,((cat,fid),e,lin)) <- lin0 [] [] Nothing 0 e]
+  [amapWithIndex (\label -> Bracket_ cat fid label [e]) lin | (_,((cat,fid),e,lin)) <- lin0 [] [] Nothing 0 e e]
   where
     cnc   = lookMap (error "no lang") lang (concretes pgf)
     lp    = lproductions cnc
   
-    lin0 xs ys mb_cty n_fid (EAbs _ x e)  = lin0 (showCId x:xs) ys mb_cty n_fid e
-    lin0 xs ys mb_cty n_fid (ETyped e _)  = lin0 xs ys mb_cty n_fid e
-    lin0 xs ys mb_cty n_fid e | null xs   = lin ys mb_cty n_fid e []
-                              | otherwise = apply (xs ++ ys) mb_cty n_fid _B (e:[ELit (LStr x) | x <- xs])
-
-    lin xs mb_cty n_fid (EApp e1 e2) es = lin xs mb_cty n_fid e1 (e2:es)
-    lin xs mb_cty n_fid e@(ELit l)   [] = case l of
-                                              LStr s -> return (n_fid+1,((cidString,n_fid),e,ss s))
-                                              LInt n -> return (n_fid+1,((cidInt,   n_fid),e,ss (show n)))
-                                              LFlt f -> return (n_fid+1,((cidFloat, n_fid),e,ss (show f)))
-    lin xs mb_cty n_fid (EMeta i)    es = apply xs mb_cty n_fid _V (ELit (LStr ('?':show i)):es)
-    lin xs mb_cty n_fid (EFun f)     es = apply xs mb_cty n_fid f  es
-    lin xs mb_cty n_fid (EVar  i)    es = apply xs mb_cty n_fid _V (ELit (LStr (xs !! i))   :es)
-    lin xs mb_cty n_fid   (ETyped e _) es = lin xs mb_cty n_fid e es
-    lin xs mb_cty n_fid   (EImplArg e) es = lin xs mb_cty n_fid e es
+    lin0 xs ys mb_cty n_fid e0 (EAbs _ x e)  = lin0 (showCId x:xs) ys mb_cty n_fid e0 e
+    lin0 xs ys mb_cty n_fid e0 (ETyped e _)  = lin0 xs ys mb_cty n_fid e0 e
+    lin0 xs ys mb_cty n_fid e0 e | null xs   = lin ys mb_cty n_fid e0 e []
+                                 | otherwise = apply (xs ++ ys) mb_cty n_fid e0 _B (e:[ELit (LStr x) | x <- xs])
+
+    lin xs mb_cty n_fid e0 (EApp e1 e2) es = lin xs mb_cty n_fid e0 e1 (e2:es)
+    lin xs mb_cty n_fid e0 (ELit l)     [] = case l of
+                                               LStr s -> return (n_fid+1,((cidString,n_fid),e0,ss s))
+                                               LInt n -> return (n_fid+1,((cidInt,   n_fid),e0,ss (show n)))
+                                               LFlt f -> return (n_fid+1,((cidFloat, n_fid),e0,ss (show f)))
+    lin xs mb_cty n_fid e0 (EMeta i)    es = apply xs mb_cty n_fid e0 _V (ELit (LStr ('?':show i)):es)
+    lin xs mb_cty n_fid e0 (EFun f)     es = apply xs mb_cty n_fid e0 f  es
+    lin xs mb_cty n_fid e0 (EVar  i)    es = apply xs mb_cty n_fid e0 _V (ELit (LStr (xs !! i))   :es)
+    lin xs mb_cty n_fid e0 (ETyped e _) es = lin xs mb_cty n_fid e0 e es
+    lin xs mb_cty n_fid e0 (EImplArg e) es = lin xs mb_cty n_fid e0 e es
 
     ss s = listArray (0,0) [[LeafKS [s]]]
 
-    apply :: [String] -> Maybe CncType -> FId -> CId -> [Expr] -> [(FId,(CncType, Expr, LinTable))]
-    apply xs mb_cty n_fid f es =
+    apply :: [String] -> Maybe CncType -> FId -> Expr -> CId -> [Expr] -> [(FId,(CncType, Expr, LinTable))]
+    apply xs mb_cty n_fid e0 f es =
       case Map.lookup f lp of
         Just prods -> do (funid,(cat,fid),ctys) <- getApps prods
                          guard (length ctys == length es)
                          (n_fid,args) <- descend n_fid (zip ctys es)
                          let (CncFun _ lins) = cncfuns cnc ! funid
-                         return (n_fid+1,((cat,n_fid),undefined,listArray (bounds lins) [computeSeq seqid args | seqid <- elems lins]))
-        Nothing    -> apply xs mb_cty n_fid _V [ELit (LStr ("[" ++ showCId f ++ "]"))]  -- fun without lin
+                         return (n_fid+1,((cat,n_fid),e0,listArray (bounds lins) [computeSeq seqid args | seqid <- elems lins]))
+        Nothing    -> apply xs mb_cty n_fid e0 _V [ELit (LStr ("[" ++ showCId f ++ "]"))]  -- fun without lin
       where
         getApps prods =
           case mb_cty of
@@ -112,7 +112,7 @@ linTree pgf lang e =
             toApp cty (PCoerce fid) = concatMap (toApp cty) (maybe [] Set.toList (IntMap.lookup fid prods))
 
         descend n_fid []                  = return (n_fid,[])
-        descend n_fid (((cat,fid),e):fes) = do (n_fid,arg)  <- lin0 [] xs (Just (cat,fid)) n_fid e
+        descend n_fid (((cat,fid),e):fes) = do (n_fid,arg)  <- lin0 [] xs (Just (cat,fid)) n_fid e e
                                                (n_fid,args) <- descend n_fid fes
                                                return (n_fid,arg:args)