From f118e644d9f27b3e26f5a2fa45178f0f653b3041 Mon Sep 17 00:00:00 2001 From: Krasimir Angelov Date: Wed, 29 Dec 2021 14:06:24 +0100 Subject: [PATCH] finished 'create lincat' --- src/compiler/GF/Interactive.hs | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/src/compiler/GF/Interactive.hs b/src/compiler/GF/Interactive.hs index 0ed600f21..993f6b755 100644 --- a/src/compiler/GF/Interactive.hs +++ b/src/compiler/GF/Interactive.hs @@ -276,9 +276,19 @@ transactionCommand (CreateLin opts f t) pgf = do return (prods,type2fields sgr res_ty) transactionCommand (CreateLincat opts c t) pgf = do + sgr <- getGrammar lang <- optLang pgf opts - lift $ modifyPGF pgf (alterConcrete lang (createLincat c [] [] [])) - return () + mo <- maybe (fail "no source grammar in scope") return $ + greatestResource sgr + case runCheck (compileLincatTerm sgr mo t) of + Ok (fields,_)-> do lift $ modifyPGF pgf (alterConcrete lang (createLincat c fields [] [])) + return () + Bad msg -> fail msg + where + compileLincatTerm sgr mo t = do + t <- renameSourceTerm sgr mo t + (t,_) <- inferLType sgr [] t + return (type2fields sgr t) transactionCommand (DropFun opts f) pgf = do lift $ modifyPGF pgf (dropFunction f) return ()