forked from GitHub/gf-core
Fixed treatment of predefined types (Int, String).
Fixed treatment of predefined types (Int, String). Added treatment of new reserved words to reading old grammars.
This commit is contained in:
@@ -75,13 +75,20 @@ isPrimitiveFun gr (m,c) = case lookupAbsDef gr m c of
|
||||
|
||||
lookupRef :: GFCGrammar -> Binds -> Term -> Err Val
|
||||
lookupRef gr binds at = case at of
|
||||
Q m f -> lookupFunType gr m f >>= return . vClos
|
||||
Vr i -> maybeErr ("unknown variable" +++ prt at) $ lookup i binds
|
||||
_ -> prtBad "cannot refine with complex term" at ---
|
||||
Q m f -> lookupFunType gr m f >>= return . vClos
|
||||
Vr i -> maybeErr ("unknown variable" +++ prt at) $ lookup i binds
|
||||
EInt _ -> return valAbsInt
|
||||
K _ -> return valAbsString
|
||||
_ -> prtBad "cannot refine with complex term" at ---
|
||||
|
||||
refsForType :: (Val -> Type -> Bool) -> GFCGrammar -> Binds -> Val -> [(Term,Val)]
|
||||
refsForType compat gr binds val =
|
||||
-- bound variables
|
||||
[(vr i, t) | (i,t) <- binds, Ok ty <- [val2exp t], compat val ty] ++
|
||||
-- integer and string literals
|
||||
[(EInt i, val) | val == valAbsInt, i <- [0,1,2,5,11,1978]] ++
|
||||
[(K s, val) | val == valAbsString, s <- ["foo", "NN", "x"]] ++
|
||||
-- functions defined in the current abstract syntax
|
||||
[(qq f, vClos t) | (f,t) <- funsForType compat gr val]
|
||||
|
||||
|
||||
|
||||
@@ -119,6 +119,8 @@ inferExp th tenv@(k,rho,gamma) e = case e of
|
||||
Vr x -> mkAnnot (AVr x) $ noConstr $ lookupVar gamma x
|
||||
Q m c -> mkAnnot (ACn (m,c)) $ noConstr $ lookupConst th (m,c)
|
||||
QC m c -> mkAnnot (ACn (m,c)) $ noConstr $ lookupConst th (m,c) ----
|
||||
EInt i -> return (AInt i, valAbsInt, [])
|
||||
K i -> return (AStr i, valAbsString, [])
|
||||
Sort _ -> return (AType, vType, [])
|
||||
App f t -> do
|
||||
(f',w,csf) <- inferExp th tenv f
|
||||
|
||||
@@ -162,6 +162,10 @@ aexp2tree (aexp,cs) = do
|
||||
ACn c v -> do
|
||||
v' <- whnf v ----
|
||||
return ([],AtC c,v',[])
|
||||
AInt i -> do
|
||||
return ([],AtI i,valAbsInt,[])
|
||||
AStr s -> do
|
||||
return ([],AtL s,valAbsString,[])
|
||||
AMeta m v -> do
|
||||
v' <- whnf v ----
|
||||
return ([],AtM m,v',[])
|
||||
|
||||
@@ -31,11 +31,18 @@ type MetaSubst = [(MetaSymb,Val)]
|
||||
|
||||
-- for TC
|
||||
|
||||
valAbsInt, valAbsString :: Val
|
||||
valAbsInt = VCn (cPredefAbs, cInt)
|
||||
valAbsString = VCn (cPredefAbs, cString)
|
||||
|
||||
vType :: Val
|
||||
vType = VType
|
||||
|
||||
cType :: Ident
|
||||
cType,cPredefAbs,cInt,cString :: Ident
|
||||
cType = identC "Type" --- #0
|
||||
cPredefAbs = identC "PredefAbs"
|
||||
cInt = identC "Int"
|
||||
cString = identC "String"
|
||||
|
||||
eType :: Exp
|
||||
eType = Sort "Type"
|
||||
|
||||
Reference in New Issue
Block a user