mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
lincat can now be just Str
This commit is contained in:
@@ -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 ?
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user