1
0
forked from GitHub/gf-core

small things

This commit is contained in:
aarne
2004-06-18 13:14:50 +00:00
parent 29b9dcaf82
commit 22613ceb37
4 changed files with 116 additions and 46 deletions

View File

@@ -6,6 +6,7 @@ import Modules
import Refresh ----
import TypeCheck
import Values (cPredefAbs) ---
import PrGrammar
import Lookup
@@ -208,9 +209,9 @@ computeLType gr t = do
where
comp ty = case ty of
Q m _ | m == cPredef -> return ty
Q m c | elem c [cPredef,cPredefAbs] -> return ty
Q m ident -> do
Q m ident -> checkIn ("Q" +++ show m) $ do
ty' <- checkErr (lookupResDef gr m ident)
if ty' == ty then return ty else comp ty' --- is this necessary to test?
@@ -259,7 +260,7 @@ checkReservedId x = let c = prt x in
inferLType :: SourceGrammar -> Term -> Check (Term, Type)
inferLType gr trm = case trm of
Q m ident | m==cPredef -> termWith trm $ checkErr (typPredefined ident)
Q m ident | isPredef m -> termWith trm $ checkErr (typPredefined ident)
Q m ident -> checks [
termWith trm $ checkErr (lookupResType gr m ident)
@@ -269,7 +270,7 @@ inferLType gr trm = case trm of
prtFail "cannot infer type of constant" trm
]
QC m ident | m==cPredef -> termWith trm $ checkErr (typPredefined ident)
QC m ident | isPredef m -> termWith trm $ checkErr (typPredefined ident)
QC m ident -> checks [
termWith trm $ checkErr (lookupResType gr m ident)
@@ -402,6 +403,8 @@ inferLType gr trm = case trm of
check = checkLType env
isPredef m = elem m [cPredef,cPredefAbs]
justCheck ty te = check ty te >>= return . fst
-- for record fields, which may be typed

View File

@@ -272,6 +272,7 @@ constPredefRes s = Q (IC "Predef") (zIdent s)
isPredefConstant t = case t of
Q (IC "Predef") _ -> True
Q (IC "PredefAbs") _ -> True
_ -> False
mkSelects :: Term -> [Term] -> Term

View File

@@ -128,7 +128,12 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = checkOptions st co >> case comm of
ASTrm _ -> s2t a
_ -> a
case a' of
ATrms (trm:_) -> do
ATrms (trm:_) -> case tree2exp trm of
G.EInt _ -> do
putStrLn "Warning: Number argument deprecated, use gr -number=n instead"
ts <- randomTreesIO opts gro (optIntOrN opts flagNumber 1)
returnArg (ATrms ts) sa
_ -> do
g <- newStdGen
case (goFirstMeta (tree2loc trm) >>= refineRandom g 41 cgr) of
Ok trm' -> returnArg (ATrms [loc2tree trm']) sa