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

Merge branch 'master' of https://github.com/GrammaticalFramework/gf-core

Browse Source
This commit is contained in:
krangelov
2019-05-27 09:06:11 +02:00
parent 8b9719bd2d b7249adf63
commit 8df2121650
14 changed files with 600 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
src/compiler/GF/Compile/CheckGrammar.hs
View File

@@ -147,11 +147,17 @@ checkCompleteGrammar opts cwd gr (am,abs) (cm,cnc) = checkInModule cwd cnc NoLoc
return $ updateTree (c,CncFun (Just linty) d mn mf) js
_ -> do checkWarn ("function" <+> c <+> "is not in abstract")
return js
CncCat _ _ _ _ _ -> case lookupOrigInfo gr (am,c) of
Ok _ -> return $ updateTree i js
_ -> do checkWarn ("category" <+> c <+> "is not in abstract")
return js
_ -> return $ updateTree i js
CncCat {} ->
case lookupOrigInfo gr (am,c) of
Ok (_,AbsCat _) -> return $ updateTree i js
{- -- This might be too pedantic:
Ok (_,AbsFun {}) ->
checkError ("lincat:"<+>c<+>"is a fun, not a cat")
-}
_ -> do checkWarn ("category" <+> c <+> "is not in abstract")
return js
_ -> return $ updateTree i js
-- | General Principle: only Just-values are checked.

11
src/compiler/GF/Compile/TypeCheck/RConcrete.hs
View File

@@ -360,12 +360,13 @@ getOverload gr g mt ot = case appForm ot of
nest 2 (showTypes pre)
return (mkApp fun tts, val)
([],[]) -> do
checkError $ "no overload instance of" <+> ppTerm Unqualified 0 f $$
"for" $$
checkError $ "no overload instance of" <+> ppTerm Qualified 0 f $$
maybe empty (\x -> "with value type" <+> ppType x) mt $$
"for argument list" $$
nest 2 stysError $$
"among" $$
nest 2 (vcat stypsError) $$
maybe empty (\x -> "with value type" <+> ppType x) mt
"among alternatives" $$
nest 2 (vcat stypsError)
(vfs1,vfs2) -> case (noProds vfs1,noProds vfs2) of
([(val,fun)],_) -> do

4
src/compiler/GF/System/Directory.hs
View File

@@ -8,13 +8,13 @@ import System.Directory as D
doesDirectoryExist,doesFileExist,getModificationTime,
getCurrentDirectory,getDirectoryContents,getPermissions,
removeFile,renameFile)
import Data.Time.Compat
--import Data.Time.Compat
canonicalizePath path = liftIO $ D.canonicalizePath path
createDirectoryIfMissing b = liftIO . D.createDirectoryIfMissing b
doesDirectoryExist path = liftIO $ D.doesDirectoryExist path
doesFileExist path = liftIO $ D.doesFileExist path
getModificationTime path = liftIO $ fmap toUTCTime (D.getModificationTime path)
getModificationTime path = liftIO $ {-fmap toUTCTime-} (D.getModificationTime path)
getDirectoryContents path = liftIO $ D.getDirectoryContents path
getCurrentDirectory :: MonadIO io => io FilePath

2
src/runtime/javascript/grammar.js
View File

File diff suppressed because one or more lines are too long

2
src/runtime/javascript/translator.html
View File

@@ -32,7 +32,7 @@
</script>
<title>Web-based GF Translator</title>
</head>
<body onload="populateLangs(Food, 'fromLang', 'toLang')">
<body onload="populateLangs(grammar, 'fromLang', 'toLang')">
<form id="translate">
<p>
<input type="text" name="inputText" id="inputText" value="this cheese is warm" size="50" />

4
src/server/Cache.hs
View File

@@ -9,7 +9,7 @@ import Data.Maybe(mapMaybe)
import System.Directory (getModificationTime)
import System.Mem(performGC)
import Data.Time (UTCTime,getCurrentTime,diffUTCTime)
import Data.Time.Compat (toUTCTime)
--import Data.Time.Compat (toUTCTime)
data Cache a = Cache {
cacheLoad :: FilePath -> IO a,
@@ -63,7 +63,7 @@ readCache' c file =
Nothing -> do v <- newMVar Nothing
return (Map.insert file v objs, v)
-- Check time stamp, and reload if different than the cache entry
readObject m = do t' <- toUTCTime `fmap` getModificationTime file
readObject m = do t' <- {-toUTCTime `fmap`-} getModificationTime file
now <- getCurrentTime
x' <- case m of
Just (t,_,x) | t' == t -> return x