summaryrefslogtreecommitdiff
path: root/src/runtime/haskell/PGF/Printer.hs
diff options
context:
space:
mode:
authorkr.angelov <kr.angelov@gmail.com>2014-08-11 10:59:10 +0000
committerkr.angelov <kr.angelov@gmail.com>2014-08-11 10:59:10 +0000
commit584d589041f63fdd3ea777019679275657902c2d (patch)
tree6150ef1da26bc76e0c3e14954e080f9a801b45f4 /src/runtime/haskell/PGF/Printer.hs
parent02dda1e66f80047f0a8718557a8bf7cc84c16625 (diff)
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.
Diffstat (limited to 'src/runtime/haskell/PGF/Printer.hs')
-rw-r--r--src/runtime/haskell/PGF/Printer.hs25
1 files changed, 13 insertions, 12 deletions
diff --git a/src/runtime/haskell/PGF/Printer.hs b/src/runtime/haskell/PGF/Printer.hs
index 4945667f4..1aabce09d 100644
--- a/src/runtime/haskell/PGF/Printer.hs
+++ b/src/runtime/haskell/PGF/Printer.hs
@@ -2,7 +2,7 @@ module PGF.Printer (ppPGF,ppCat,ppFId,ppFunId,ppSeqId,ppSeq,ppFun) where
import PGF.CId
import PGF.Data
---import PGF.Macros
+import PGF.ByteCode
import qualified Data.Map as Map
import qualified Data.Set as Set
@@ -26,17 +26,18 @@ ppAbs name a = text "abstract" <+> ppCId name <+> char '{' $$
ppFlag :: CId -> Literal -> Doc
ppFlag flag value = text "flag" <+> ppCId flag <+> char '=' <+> ppLit value <+> char ';'
-ppCat :: CId -> ([Hypo],[(Double,CId)],Double,BCAddr) -> Doc
-ppCat c (hyps,_,_,_) = text "cat" <+> ppCId c <+> hsep (snd (mapAccumL (ppHypo 4) [] hyps)) <+> char ';'
-
-ppFun :: CId -> (Type,Int,Maybe [Equation],Double,BCAddr) -> Doc
-ppFun f (t,_,Just eqs,_,_) = text "fun" <+> ppCId f <+> colon <+> ppType 0 [] t <+> char ';' $$
- if null eqs
- then empty
- else text "def" <+> vcat [let scope = foldl pattScope [] patts
- ds = map (ppPatt 9 scope) patts
- in ppCId f <+> hsep ds <+> char '=' <+> ppExpr 0 scope res <+> char ';' | Equ patts res <- eqs]
-ppFun f (t,_,Nothing,_,_) = text "data" <+> ppCId f <+> colon <+> ppType 0 [] t <+> char ';'
+ppCat :: CId -> ([Hypo],[(Double,CId)],Double) -> Doc
+ppCat c (hyps,_,_) = text "cat" <+> ppCId c <+> hsep (snd (mapAccumL (ppHypo 4) [] hyps)) <+> char ';'
+
+ppFun :: CId -> (Type,Int,Maybe ([Equation],[Instr]),Double) -> Doc
+ppFun f (t,_,Just (eqs,code),_) = text "fun" <+> ppCId f <+> colon <+> ppType 0 [] t <+> char ';' $$
+ if null eqs
+ then empty
+ else text "def" <+> vcat [let scope = foldl pattScope [] patts
+ ds = map (ppPatt 9 scope) patts
+ in ppCId f <+> hsep ds <+> char '=' <+> ppExpr 0 scope res <+> char ';' | Equ patts res <- eqs] $$
+ ppCode 0 code
+ppFun f (t,_,Nothing,_) = text "data" <+> ppCId f <+> colon <+> ppType 0 [] t <+> char ';'
ppCnc :: Language -> Concr -> Doc
ppCnc name cnc =