msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

the elimination of empty tokens is moved to the typechecker

Browse Source
This commit is contained in:
krangelov
2021-12-14 15:59:13 +01:00
parent 7556662344
commit e2b6774bd3
2 changed files with 7 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/compiler/GF/Compile/Compute/Concrete.hs
View File

@@ -120,9 +120,7 @@ eval env (Vr x) vs = case lookup x env of
eval env (Sort s) [] = return (VSort s) eval env (Sort s) [] = return (VSort s)
eval env (EInt n) [] = return (VInt n) eval env (EInt n) [] = return (VInt n)
eval env (EFloat d) [] = return (VFlt d) eval env (EFloat d) [] = return (VFlt d)
eval env (K t) [] eval env (K t) [] = return (VStr t)
| null t = return (VC [])
| otherwise = return (VStr t)
eval env Empty [] = return (VC []) eval env Empty [] = return (VC [])
eval env (App t1 t2) vs = do tnk <- newThunk env t2 eval env (App t1 t2) vs = do tnk <- newThunk env t2
eval env t1 (tnk : vs) eval env t1 (tnk : vs)

15
src/compiler/GF/Compile/TypeCheck/Concrete.hs
View File

@@ -180,15 +180,12 @@ inferLType gr g trm = case trm of
-- return (trm, Table arg val) -- old, caused issue 68 -- return (trm, Table arg val) -- old, caused issue 68
checkLType gr g trm (Table arg val) checkLType gr g trm (Table arg val)
K s -> do K s ->
if elem ' ' s let trm' = case words s of
then do [] -> Empty
let ss = foldr C Empty (map K (words s)) [w] -> K w
----- removed irritating warning AR 24/5/2008 ws -> foldr C Empty (map K ws)
----- checkWarn ("token \"" ++ s ++ in return (trm', typeStr)
----- "\" converted to token list" ++ prt ss)
return (ss, typeStr)
else return (trm, typeStr)
EInt i -> return (trm, typeInt) EInt i -> return (trm, typeInt)