diff --git a/src/GF/Devel/CheckGrammar.hs b/src/GF/Devel/CheckGrammar.hs index 4ad308366..f0ec8318c 100644 --- a/src/GF/Devel/CheckGrammar.hs +++ b/src/GF/Devel/CheckGrammar.hs @@ -311,13 +311,15 @@ checkIfStrType st typ = case typ of checkIfLinType :: SourceGrammar -> Type -> Check Type checkIfLinType st typ0 = do typ <- computeLType st typ0 +{- ---- should check that not fun type case typ of RecType r -> do let (lins,ihs) = partition (isLinLabel .fst) r --- checkErr $ checkUnique $ map fst r mapM_ checkInh ihs mapM_ checkLin lins - _ -> prtFail "a linearization type must be a record type instead of" typ + _ -> prtFail "a linearization type cannot be" typ +-} return typ where @@ -1037,7 +1039,8 @@ linTypeOfType cnc m typ = do val <- lookLin mc let vars = mkRecType varLabel $ replicate n typeStr symb = argIdent n cat i - rec <- checkErr $ errIn ("extending" +++ prt vars +++ "with" +++ prt val) $ + rec <- if n==0 then return val else + checkErr $ errIn ("extending" +++ prt vars +++ "with" +++ prt val) $ plusRecType vars val return (symb,rec) lookLin (_,c) = checks [ --- rather: update with defLinType ? diff --git a/src/GF/Devel/GrammarToGFCC.hs b/src/GF/Devel/GrammarToGFCC.hs index 0d24113dd..520b9a3f5 100644 --- a/src/GF/Devel/GrammarToGFCC.hs +++ b/src/GF/Devel/GrammarToGFCC.hs @@ -440,8 +440,8 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of Just vs -> (ty,[t | (t,_) <- sortBy (\x y -> compare (snd x) (snd y)) (Map.assocs vs)]) - _ -> error $ A.prt ty - _ -> error $ A.prt tr + _ -> error $ "doVar1" +++ A.prt ty + _ -> error $ "doVar2" +++ A.prt tr +++ show (cat,lab) ---- debug updateSTM ((tyvs, (tr', tr)):) return tr' _ -> GM.composOp doVar tr diff --git a/src/GF/Devel/Optimize.hs b/src/GF/Devel/Optimize.hs index 4621e8f6c..b44f6a53d 100644 --- a/src/GF/Devel/Optimize.hs +++ b/src/GF/Devel/Optimize.hs @@ -247,7 +247,8 @@ mkLinDefault :: SourceGrammar -> Type -> Err Term mkLinDefault gr typ = do case unComputed typ of RecType lts -> mapPairsM mkDefField lts >>= (return . Abs strVar . R . mkAssign) - _ -> prtBad "linearization type must be a record type, not" typ + _ -> liftM (Abs strVar) $ mkDefField typ +---- _ -> prtBad "linearization type must be a record type, not" typ where mkDefField typ = case unComputed typ of Table p t -> do