GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-23 11:42:49 -06:00
Code Issues Packages Projects Releases Wiki Activity

update

Browse Source
This commit is contained in:
Krasimir Angelov
2024-01-17 14:45:46 +01:00
parent 413e92e7c3
commit 5e664b6f69
1 changed files with 10 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
src/compiler/gf-scribe.hs
View File

@@ -11,6 +11,7 @@ import GF.Grammar.Macros
import qualified GF.Data.Operations as O import qualified GF.Data.Operations as O
import GF.Compile.Rename import GF.Compile.Rename
import GF.Compile.Compute.Concrete import GF.Compile.Compute.Concrete
import GF.Compile.TypeCheck.ConcreteNew
import GF.Compile import GF.Compile
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Char8 as BS
@@ -124,16 +125,20 @@ interactive entity db mo sgr gr cnc qid = runInputT defaultSettings loop
Nothing -> return () Nothing -> return ()
Just input -> case runP pTerm (BS.pack input) of Just input -> case runP pTerm (BS.pack input) of
Right term -> do case runCheck (checkComputeTerm term) of Right term -> do case runCheck (checkComputeTerm term) of
O.Ok (terms,msg) -> do outputStr msg O.Ok (res,msg) -> do outputStr msg
mapM_ (\term -> outputStrLn (render (ppTerm Unqualified 0 term))) terms mapM_ (\(term,typ) -> outputStrLn (render (ppTerm Unqualified 0 term)) >> outputStrLn (render (ppTerm Unqualified 0 typ))) res
O.Bad msg -> do outputStrLn msg O.Bad msg -> do outputStrLn msg
loop loop
Left (pos,msg) -> do outputStrLn (show pos ++ msg) Left (pos,msg) -> do outputStrLn (show pos ++ msg)
loop loop
checkComputeTerm term = do checkComputeTerm term = do
term <- renameSourceTerm sgr mo term let term' = Abs Explicit (identS "entity") term
term' <- renameSourceTerm sgr mo term'
(term',typ) <- inferLType sgr term'
runEvalM sgr $ do runEvalM sgr $ do
tnk <- newThunk [] entity tnk <- newThunk [] entity
val <- eval [(identS "entity",tnk)] term [] -- val <- eval [(identS "entity",tnk)] term []
value2term [] val --res <- value2term [] val
let res = term
return (res, typ)