diff --git a/src/GF/Canon/CanonToGrammar.hs b/src/GF/Canon/CanonToGrammar.hs index da40425f0..078c3cc03 100644 --- a/src/GF/Canon/CanonToGrammar.hs +++ b/src/GF/Canon/CanonToGrammar.hs @@ -73,6 +73,11 @@ redInfo (c,info) = errIn ("decompiling abstract" +++ show c) $ do par' <- mapM redParam par return $ G.ResParam (Yes (par',Nothing)) ---- list of values + ResOper pty ptr -> do + ty' <- redCType pty + trm' <- redCTerm ptr + return $ G.ResOper (Yes ty') (Yes trm') + CncCat pty ptr ppr -> do ty' <- redCType pty trm' <- redCTerm ptr @@ -145,13 +150,13 @@ redCTerm x = case x of P term label -> liftM2 G.P (redCTerm term) (return $ redLabel label) T ctype cases -> do ctype' <- redCType ctype - let (ps,ts) = unzip [(ps,t) | Cas ps t <- cases] - ps' <- mapM (mapM redPatt) ps + let (ps,ts) = unzip [(p,t) | Cas [p] t <- cases] + ps' <- mapM redPatt ps ts' <- mapM redCTerm ts let tinfo = case ps' of - [[G.PV _]] -> G.TTyped ctype' + [G.PV _] -> G.TTyped ctype' _ -> G.TComp ctype' - return $ G.TSh tinfo $ zip ps' ts' + return $ G.T tinfo $ zip ps' ts' V ctype ts -> do ctype' <- redCType ctype ts' <- mapM redCTerm ts diff --git a/src/GF/Devel/GrammarToGFCC.hs b/src/GF/Devel/GrammarToGFCC.hs index 8d7bd4960..887e689e4 100644 --- a/src/GF/Devel/GrammarToGFCC.hs +++ b/src/GF/Devel/GrammarToGFCC.hs @@ -129,6 +129,7 @@ mkTerm tr = case tr of EInt i -> C.C $ fromInteger i R rs -> C.R [mkTerm t | (_, (_,t)) <- rs] P t l -> C.P (mkTerm t) (C.C (mkLab l)) + TSh _ _ -> error $ show tr T _ cs -> C.R [mkTerm t | (_,t) <- cs] ------ V _ cs -> C.R [mkTerm t | t <- cs] S t p -> C.P (mkTerm t) (mkTerm p) @@ -378,6 +379,9 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of (i,(l,(_,t))) <- zip [0..] (sort (unlock rs))] P t l -> r2r tr PI t l i -> EInt $ toInteger i + + T _ [_] -> error $ "single" +++ prt tr + T (TWild _) _ -> error $ "wild" +++ prt tr T (TComp ty) cs -> t2t $ V ty $ map snd cs ---- should be elim'ed in tc T (TTyped ty) cs -> t2t $ V ty $ map snd cs ---- should be elim'ed in tc V ty ts -> mkCurry $ V ty [t2t t | t <- ts] @@ -457,7 +461,7 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of (FV ts,_) -> ts _ -> [tr] valNumFV ts = case ts of - [tr] -> trace (unwords (map prt (Map.keys typs))) $ + [tr] -> trace (unwords (map prt (Map.keys untyps))) $ prtTrace tr $ K "66667" _ -> FV $ map valNum ts