lincat can now be just Str

This commit is contained in:
aarne
2008-03-09 12:17:42 +00:00
parent aa94e34098
commit a34eed5189
3 changed files with 9 additions and 5 deletions

View File

@@ -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 ?

View File

@@ -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

View File

@@ -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