1
0
forked from GitHub/gf-core
This commit is contained in:
aarne
2004-09-23 14:41:42 +00:00
parent 6c3c14dfcf
commit 22c849351f
31 changed files with 434 additions and 211 deletions

View File

@@ -15,16 +15,18 @@ isInPredefined = err (const True) (const False) . typPredefined
typPredefined :: Ident -> Err Type
typPredefined c@(IC f) = case f of
"Int" -> return typePType
"Ints" -> return $ mkFunType [cnPredef "Int"] typePType
"PBool" -> return typePType
"PFalse" -> return $ cnPredef "PBool"
"PTrue" -> return $ cnPredef "PBool"
"dp" -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
"drop" -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
"eqInt" -> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "PBool")
"lessInt"-> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "PBool")
"eqStr" -> return $ mkFunType [typeTok,typeTok] (cnPredef "PBool")
"length" -> return $ mkFunType [typeTok] (cnPredef "Int")
"occur" -> return $ mkFunType [typeTok,typeTok] (cnPredef "PBool")
"plus" -> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "PInt")
"plus" -> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "Int")
---- "read" -> (P : Type) -> Tok -> P
---- "show" -> (P : Type) -> P -> Tok
"take" -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
@@ -51,6 +53,7 @@ appPredefined t = case t of
("eqStr",K s, K t) -> if s == t then predefTrue else predefFalse
("occur",K s, K t) -> if substring s t then predefTrue else predefFalse
("eqInt",EInt i, EInt j) -> if i==j then predefTrue else predefFalse
("lessInt",EInt i, EInt j) -> if i<j then predefTrue else predefFalse
("plus", EInt i, EInt j) -> EInt $ i+j
("show", _, t) -> K $ prt t
("read", _, K s) -> str2tag s --- because of K, only works for atomic tags

View File

@@ -78,6 +78,8 @@ lookupFirstTag gr m c = do
allParamValues :: SourceGrammar -> Type -> Err [Term]
allParamValues cnc ptyp = case ptyp of
App (Q (IC "Predef") (IC "Ints")) (EInt n) ->
return [EInt i | i <- [0..n]]
QC p c -> lookupParamValues cnc p c
RecType r -> do
let (ls,tys) = unzip r

View File

@@ -272,3 +272,15 @@ string2var :: String -> Ident
string2var s = case s of
c:'_':i -> identV (readIntArg i,[c]) ---
_ -> zIdent s
-- reindex variables so that they tell nesting depth level
reindexTerm :: Term -> Term
reindexTerm = qualif (0,[]) where
qualif dg@(d,g) t = case t of
Abs x b -> let x' = ind x d in Abs x' $ qualif (d+1, (x,x'):g) b
Prod x a b -> let x' = ind x d in Prod x' (qualif dg a) $ qualif (d+1, (x,x'):g) b
Vr x -> Vr $ look x g
_ -> composSafeOp (qualif dg) t
look x = maybe x id . lookup x --- if x is not in scope it is unchanged
ind x d = identC $ prIdent x ++ "_" ++ show d

View File

@@ -271,6 +271,7 @@ typeStrs = srt "Strs"
typeString = constPredefRes "String"
typeInt = constPredefRes "Int"
typeInts i = App (constPredefRes "Ints") (EInt i)
constPredefRes s = Q (IC "Predef") (zIdent s)

View File

@@ -79,6 +79,7 @@ isInConstantForm trm = case trm of
R r -> all (isInConstantForm . snd . snd) r
K _ -> True
Alias _ _ t -> isInConstantForm t
EInt _ -> True
_ -> False ---- isInArgVarForm trm
varsOfPatt :: Patt -> [Ident]