From 584d589041f63fdd3ea777019679275657902c2d Mon Sep 17 00:00:00 2001 From: "kr.angelov" Date: Mon, 11 Aug 2014 10:59:10 +0000 Subject: a partial support for def rules in the C runtime The def rules are now compiled to byte code by the compiler and then to native code by the JIT compiler in the runtime. Not all constructions are implemented yet. The partial implementation is now in the repository but it is not activated by default since this requires changes in the PGF format. I will enable it only after it is complete. --- src/compiler/GF/Compile/PGFtoLProlog.hs | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) (limited to 'src/compiler/GF/Compile/PGFtoLProlog.hs') diff --git a/src/compiler/GF/Compile/PGFtoLProlog.hs b/src/compiler/GF/Compile/PGFtoLProlog.hs index 9f990d4f9..28ee6afaf 100644 --- a/src/compiler/GF/Compile/PGFtoLProlog.hs +++ b/src/compiler/GF/Compile/PGFtoLProlog.hs @@ -12,25 +12,25 @@ import qualified Data.Map as Map grammar2lambdaprolog_mod pgf = render $ "module" <+> ppCId (absname pgf) <> '.' $$ ' ' $$ - vcat [ppClauses cat fns | (cat,(_,fs,_,_)) <- Map.toList (cats (abstract pgf)), + vcat [ppClauses cat fns | (cat,(_,fs,_)) <- Map.toList (cats (abstract pgf)), let fns = [(f,fromJust (Map.lookup f (funs (abstract pgf)))) | (_,f) <- fs]] where ppClauses cat fns = "/*" <+> ppCId cat <+> "*/" $$ - vcat [snd (ppClause (abstract pgf) 0 1 [] f ty) <> dot | (f,(ty,_,Nothing,_,_)) <- fns] $$ + vcat [snd (ppClause (abstract pgf) 0 1 [] f ty) <> dot | (f,(ty,_,Nothing,_)) <- fns] $$ ' ' $$ - vcat [vcat (map (\eq -> equation2clause (abstract pgf) f eq <> dot) eqs) | (f,(_,_,Just eqs,_,_)) <- fns] $$ + vcat [vcat (map (\eq -> equation2clause (abstract pgf) f eq <> dot) eqs) | (f,(_,_,Just (eqs,_),_)) <- fns] $$ ' ' grammar2lambdaprolog_sig pgf = render $ "sig" <+> ppCId (absname pgf) <> '.' $$ ' ' $$ - vcat [ppCat c hyps <> dot | (c,(hyps,_,_,_)) <- Map.toList (cats (abstract pgf))] $$ + vcat [ppCat c hyps <> dot | (c,(hyps,_,_)) <- Map.toList (cats (abstract pgf))] $$ ' ' $$ - vcat [ppFun f ty <> dot | (f,(ty,_,Nothing,_,_)) <- Map.toList (funs (abstract pgf))] $$ + vcat [ppFun f ty <> dot | (f,(ty,_,Nothing,_)) <- Map.toList (funs (abstract pgf))] $$ ' ' $$ - vcat [ppExport c hyps <> dot | (c,(hyps,_,_,_)) <- Map.toList (cats (abstract pgf))] $$ - vcat [ppFunPred f (hyps ++ [(Explicit,wildCId,DTyp [] c es)]) <> dot | (f,(DTyp hyps c es,_,Just _,_,_)) <- Map.toList (funs (abstract pgf))] + vcat [ppExport c hyps <> dot | (c,(hyps,_,_)) <- Map.toList (cats (abstract pgf))] $$ + vcat [ppFunPred f (hyps ++ [(Explicit,wildCId,DTyp [] c es)]) <> dot | (f,(DTyp hyps c es,_,Just _,_)) <- Map.toList (funs (abstract pgf))] ppCat :: CId -> [Hypo] -> Doc ppCat c hyps = "kind" <+> ppKind c <+> "type" @@ -157,8 +157,8 @@ expr2goal abstr scope goals i (EApp e1 e2) args = in expr2goal abstr scope goals' i' e1 (e2':args) expr2goal abstr scope goals i (EFun f) args = case Map.lookup f (funs abstr) of - Just (_,_,Just _,_,_) -> let e = EFun (mkVar i) - in (foldl EApp (EFun f) (args++[e]) : goals, i+1, e) - _ -> (goals,i,foldl EApp (EFun f) args) + Just (_,_,Just _,_) -> let e = EFun (mkVar i) + in (foldl EApp (EFun f) (args++[e]) : goals, i+1, e) + _ -> (goals,i,foldl EApp (EFun f) args) expr2goal abstr scope goals i (EVar j) args = (goals,i,foldl EApp (EVar j) args) -- cgit v1.2.3