HsParrot 0.0.1 → 0.0.2
raw patch · 2 files changed
+291/−4 lines, 2 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- HsParrot.cabal +4/−4
- src/Language/PIR.hs +287/−0
HsParrot.cabal view
@@ -1,5 +1,5 @@ Name: HsParrot-Version: 0.0.1+Version: 0.0.2 Category: Language, Pugs Synopsis: Haskell integration with Parrot virtual machine Description: Haskell integration with Parrot virtual machine@@ -14,8 +14,8 @@ Exposed-modules: Language.PIR Other-modules: Language.PIR.Emit -Build-Depends: pugs-DrIFT,- base, haskell98, bytestring>=0.9.0.1, pretty, HsSyck+Build-Depends: base, haskell98, bytestring>=0.9.0.1, pretty, HsSyck,+ pugs-DrIFT Build-Type: Simple Tested-With: GHC==6.8.2, GHC==6.8.3 @@ -24,7 +24,7 @@ DeriveDataTypeable, FlexibleInstances, Rank2Types, PatternGuards -ghc-options: -F -pgmF pugs-DrIFT -optF-pgmF+-- ghc-options: -F -pgmF pugs-DrIFT -optF-pgmF data-files: Changes hs-source-dirs: src
src/Language/PIR.hs view
@@ -1,3 +1,5 @@+{- Generated by pugs-DrIFT (Automatic class derivations for Haskell) -}+{-# LINE 1 "PIR.hs" #-} {-| Parrot PIR syntax tree. @@ -981,3 +983,288 @@ typeOf _ = typeOf () ------------------------------------------------------------------------+{-* Generated by DrIFT : Look, but Don't Touch. *-}+instance YAML Decl where+ fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of+ "DeclSub" -> do+ let EMap assocs = e+ let [aa, ab, ac] = map snd assocs+ liftM3 DeclSub (fromYAML aa) (fromYAML ab) (fromYAML ac)+ "DeclNS" -> do+ let EMap assocs = e+ let [aa, ab] = map snd assocs+ liftM2 DeclNS (fromYAML aa) (fromYAML ab)+ "DeclInc" -> do+ let EMap assocs = e+ let [aa] = map snd assocs+ liftM DeclInc (fromYAML aa)+ "DeclHLL" -> do+ let EMap assocs = e+ let [aa, ab] = map snd assocs+ liftM2 DeclHLL (fromYAML aa) (fromYAML ab)+ _ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["DeclSub","DeclNS","DeclInc","DeclHLL"] ++ " in node " ++ show e+ fromYAML e = fail $ "no tag found: expecting " ++ show ["DeclSub","DeclNS","DeclInc","DeclHLL"] ++ " in node " ++ show e+ asYAML (DeclSub aa ab ac) = asYAMLmap "DeclSub"+ [("dsName", asYAML aa), ("dsFlags", asYAML ab),+ ("dsBody", asYAML ac)]+ asYAML (DeclNS aa ab) = asYAMLmap "DeclNS"+ [("dnPackage", asYAML aa), ("dnBody", asYAML ab)]+ asYAML (DeclInc aa) = asYAMLmap "DeclInc" [("diFile", asYAML aa)]+ asYAML (DeclHLL aa ab) = asYAMLmap "DeclHLL"+ [("dhLang", asYAML aa), ("dhGroup", asYAML ab)]++instance YAML Stmt where+ fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of+ "StmtComment" -> do+ let ESeq [aa] = e+ liftM StmtComment (fromYAML aa)+ "StmtLine" -> do+ let ESeq [aa, ab] = e+ liftM2 StmtLine (fromYAML aa) (fromYAML ab)+ "StmtPad" -> do+ let ESeq [aa, ab] = e+ liftM2 StmtPad (fromYAML aa) (fromYAML ab)+ "StmtRaw" -> do+ let ESeq [aa] = e+ liftM StmtRaw (fromYAML aa)+ "StmtIns" -> do+ let ESeq [aa] = e+ liftM StmtIns (fromYAML aa)+ "StmtSub" -> do+ let ESeq [aa, ab] = e+ liftM2 StmtSub (fromYAML aa) (fromYAML ab)+ _ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["StmtComment","StmtLine","StmtPad","StmtRaw","StmtIns","StmtSub"] ++ " in node " ++ show e+ fromYAML e = fail $ "no tag found: expecting " ++ show ["StmtComment","StmtLine","StmtPad","StmtRaw","StmtIns","StmtSub"] ++ " in node " ++ show e+ asYAML (StmtComment aa) = asYAMLseq "StmtComment" [asYAML aa]+ asYAML (StmtLine aa ab) = asYAMLseq "StmtLine"+ [asYAML aa, asYAML ab]+ asYAML (StmtPad aa ab) = asYAMLseq "StmtPad" [asYAML aa, asYAML ab]+ asYAML (StmtRaw aa) = asYAMLseq "StmtRaw" [asYAML aa]+ asYAML (StmtIns aa) = asYAMLseq "StmtIns" [asYAML aa]+ asYAML (StmtSub aa ab) = asYAMLseq "StmtSub" [asYAML aa, asYAML ab]++instance YAML Ins where+ fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of+ "InsLocal" -> do+ let ESeq [aa, ab] = e+ liftM2 InsLocal (fromYAML aa) (fromYAML ab)+ "InsNew" -> do+ let ESeq [aa, ab] = e+ liftM2 InsNew (fromYAML aa) (fromYAML ab)+ "InsBind" -> do+ let ESeq [aa, ab] = e+ liftM2 InsBind (fromYAML aa) (fromYAML ab)+ "InsAssign" -> do+ let ESeq [aa, ab] = e+ liftM2 InsAssign (fromYAML aa) (fromYAML ab)+ "InsPrim" -> do+ let ESeq [aa, ab, ac] = e+ liftM3 InsPrim (fromYAML aa) (fromYAML ab) (fromYAML ac)+ "InsFun" -> do+ let ESeq [aa, ab, ac] = e+ liftM3 InsFun (fromYAML aa) (fromYAML ab) (fromYAML ac)+ "InsTailFun" -> do+ let ESeq [aa, ab] = e+ liftM2 InsTailFun (fromYAML aa) (fromYAML ab)+ "InsLabel" -> do+ let ESeq [aa] = e+ liftM InsLabel (fromYAML aa)+ "InsComment" -> do+ let ESeq [aa, ab] = e+ liftM2 InsComment (fromYAML aa) (fromYAML ab)+ "InsExp" -> do+ let ESeq [aa] = e+ liftM InsExp (fromYAML aa)+ "InsConst" -> do+ let ESeq [aa, ab, ac] = e+ liftM3 InsConst (fromYAML aa) (fromYAML ab) (fromYAML ac)+ _ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["InsLocal","InsNew","InsBind","InsAssign","InsPrim","InsFun","InsTailFun","InsLabel","InsComment","InsExp","InsConst"] ++ " in node " ++ show e+ fromYAML e = fail $ "no tag found: expecting " ++ show ["InsLocal","InsNew","InsBind","InsAssign","InsPrim","InsFun","InsTailFun","InsLabel","InsComment","InsExp","InsConst"] ++ " in node " ++ show e+ asYAML (InsLocal aa ab) = asYAMLseq "InsLocal"+ [asYAML aa, asYAML ab]+ asYAML (InsNew aa ab) = asYAMLseq "InsNew" [asYAML aa, asYAML ab]+ asYAML (InsBind aa ab) = asYAMLseq "InsBind" [asYAML aa, asYAML ab]+ asYAML (InsAssign aa ab) = asYAMLseq "InsAssign"+ [asYAML aa, asYAML ab]+ asYAML (InsPrim aa ab ac) = asYAMLseq "InsPrim"+ [asYAML aa, asYAML ab, asYAML ac]+ asYAML (InsFun aa ab ac) = asYAMLseq "InsFun"+ [asYAML aa, asYAML ab, asYAML ac]+ asYAML (InsTailFun aa ab) = asYAMLseq "InsTailFun"+ [asYAML aa, asYAML ab]+ asYAML (InsLabel aa) = asYAMLseq "InsLabel" [asYAML aa]+ asYAML (InsComment aa ab) = asYAMLseq "InsComment"+ [asYAML aa, asYAML ab]+ asYAML (InsExp aa) = asYAMLseq "InsExp" [asYAML aa]+ asYAML (InsConst aa ab ac) = asYAMLseq "InsConst"+ [asYAML aa, asYAML ab, asYAML ac]++instance YAML Expression where+ fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of+ "ExpLV" -> do+ let ESeq [aa] = e+ liftM ExpLV (fromYAML aa)+ "ExpLit" -> do+ let ESeq [aa] = e+ liftM ExpLit (fromYAML aa)+ _ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["ExpLV","ExpLit"] ++ " in node " ++ show e+ fromYAML e = fail $ "no tag found: expecting " ++ show ["ExpLV","ExpLit"] ++ " in node " ++ show e+ asYAML (ExpLV aa) = asYAMLseq "ExpLV" [asYAML aa]+ asYAML (ExpLit aa) = asYAMLseq "ExpLit" [asYAML aa]++instance YAML LValue where+ fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of+ "VAR" -> do+ let ESeq [aa] = e+ liftM VAR (fromYAML aa)+ "PMC" -> do+ let ESeq [aa] = e+ liftM PMC (fromYAML aa)+ "STR" -> do+ let ESeq [aa] = e+ liftM STR (fromYAML aa)+ "INT" -> do+ let ESeq [aa] = e+ liftM INT (fromYAML aa)+ "NUM" -> do+ let ESeq [aa] = e+ liftM NUM (fromYAML aa)+ "KEYED" -> do+ let ESeq [aa, ab] = e+ liftM2 KEYED (fromYAML aa) (fromYAML ab)+ _ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["VAR","PMC","STR","INT","NUM","KEYED"] ++ " in node " ++ show e+ fromYAML e = fail $ "no tag found: expecting " ++ show ["VAR","PMC","STR","INT","NUM","KEYED"] ++ " in node " ++ show e+ asYAML (VAR aa) = asYAMLseq "VAR" [asYAML aa]+ asYAML (PMC aa) = asYAMLseq "PMC" [asYAML aa]+ asYAML (STR aa) = asYAMLseq "STR" [asYAML aa]+ asYAML (INT aa) = asYAMLseq "INT" [asYAML aa]+ asYAML (NUM aa) = asYAMLseq "NUM" [asYAML aa]+ asYAML (KEYED aa ab) = asYAMLseq "KEYED" [asYAML aa, asYAML ab]++instance YAML Literal where+ fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of+ "LitStr" -> do+ let ESeq [aa] = e+ liftM LitStr (fromYAML aa)+ "LitInt" -> do+ let ESeq [aa] = e+ liftM LitInt (fromYAML aa)+ "LitNum" -> do+ let ESeq [aa] = e+ liftM LitNum (fromYAML aa)+ _ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["LitStr","LitInt","LitNum"] ++ " in node " ++ show e+ fromYAML e = fail $ "no tag found: expecting " ++ show ["LitStr","LitInt","LitNum"] ++ " in node " ++ show e+ asYAML (LitStr aa) = asYAMLseq "LitStr" [asYAML aa]+ asYAML (LitInt aa) = asYAMLseq "LitInt" [asYAML aa]+ asYAML (LitNum aa) = asYAMLseq "LitNum" [asYAML aa]++instance YAML SubFlag where+ fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of+ "SubMAIN" -> do+ return SubMAIN+ "SubLOAD" -> do+ return SubLOAD+ "SubANON" -> do+ return SubANON+ "SubMETHOD" -> do+ return SubMETHOD+ "SubMULTI" -> do+ let ESeq [aa] = e+ liftM SubMULTI (fromYAML aa)+ "SubOUTER" -> do+ let ESeq [aa] = e+ liftM SubOUTER (fromYAML aa)+ _ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["SubMAIN","SubLOAD","SubANON","SubMETHOD","SubMULTI","SubOUTER"] ++ " in node " ++ show e+ fromYAML e = fail $ "no tag found: expecting " ++ show ["SubMAIN","SubLOAD","SubANON","SubMETHOD","SubMULTI","SubOUTER"] ++ " in node " ++ show e+ asYAML (SubMAIN) = asYAMLcls "SubMAIN"+ asYAML (SubLOAD) = asYAMLcls "SubLOAD"+ asYAML (SubANON) = asYAMLcls "SubANON"+ asYAML (SubMETHOD) = asYAMLcls "SubMETHOD"+ asYAML (SubMULTI aa) = asYAMLseq "SubMULTI" [asYAML aa]+ asYAML (SubOUTER aa) = asYAMLseq "SubOUTER" [asYAML aa]++instance YAML RegType where+ fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of+ "RegInt" -> do+ return RegInt+ "RegNum" -> do+ return RegNum+ "RegStr" -> do+ return RegStr+ "RegPMC" -> do+ return RegPMC+ _ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["RegInt","RegNum","RegStr","RegPMC"] ++ " in node " ++ show e+ fromYAML e = fail $ "no tag found: expecting " ++ show ["RegInt","RegNum","RegStr","RegPMC"] ++ " in node " ++ show e+ asYAML (RegInt) = asYAMLcls "RegInt"+ asYAML (RegNum) = asYAMLcls "RegNum"+ asYAML (RegStr) = asYAMLcls "RegStr"+ asYAML (RegPMC) = asYAMLcls "RegPMC"++instance YAML ObjType where+ fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of+ "PerlScalar" -> do+ return PerlScalar+ "PerlArray" -> do+ return PerlArray+ "PerlHash" -> do+ return PerlHash+ "PerlInt" -> do+ return PerlInt+ "PerlPair" -> do+ return PerlPair+ "PerlRef" -> do+ return PerlRef+ "PerlEnv" -> do+ return PerlEnv+ "Sub" -> do+ return Sub+ "Closure" -> do+ return Closure+ "Continuation" -> do+ return Continuation+ "BareType" -> do+ let ESeq [aa] = e+ liftM BareType (fromYAML aa)+ _ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["PerlScalar","PerlArray","PerlHash","PerlInt","PerlPair","PerlRef","PerlEnv","Sub","Closure","Continuation","BareType"] ++ " in node " ++ show e+ fromYAML e = fail $ "no tag found: expecting " ++ show ["PerlScalar","PerlArray","PerlHash","PerlInt","PerlPair","PerlRef","PerlEnv","Sub","Closure","Continuation","BareType"] ++ " in node " ++ show e+ asYAML (PerlScalar) = asYAMLcls "PerlScalar"+ asYAML (PerlArray) = asYAMLcls "PerlArray"+ asYAML (PerlHash) = asYAMLcls "PerlHash"+ asYAML (PerlInt) = asYAMLcls "PerlInt"+ asYAML (PerlPair) = asYAMLcls "PerlPair"+ asYAML (PerlRef) = asYAMLcls "PerlRef"+ asYAML (PerlEnv) = asYAMLcls "PerlEnv"+ asYAML (Sub) = asYAMLcls "Sub"+ asYAML (Closure) = asYAMLcls "Closure"+ asYAML (Continuation) = asYAMLcls "Continuation"+ asYAML (BareType aa) = asYAMLseq "BareType" [asYAML aa]++instance YAML Sig where+ fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of+ "MkSig" -> do+ let EMap assocs = e+ let [aa, ab] = map snd assocs+ liftM2 MkSig (fromYAML aa) (fromYAML ab)+ _ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkSig"] ++ " in node " ++ show e+ fromYAML e = fail $ "no tag found: expecting " ++ show ["MkSig"] ++ " in node " ++ show e+ asYAML (MkSig aa ab) = asYAMLmap "MkSig"+ [("sigFlags", asYAML aa), ("sigIdent", asYAML ab)]++instance YAML ArgFlag where+ fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of+ "MkArgFlatten" -> do+ return MkArgFlatten+ "MkArgSlurpyArray" -> do+ return MkArgSlurpyArray+ "MkArgMaybeFlatten" -> do+ return MkArgMaybeFlatten+ "MkArgOptional" -> do+ return MkArgOptional+ _ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkArgFlatten","MkArgSlurpyArray","MkArgMaybeFlatten","MkArgOptional"] ++ " in node " ++ show e+ fromYAML e = fail $ "no tag found: expecting " ++ show ["MkArgFlatten","MkArgSlurpyArray","MkArgMaybeFlatten","MkArgOptional"] ++ " in node " ++ show e+ asYAML (MkArgFlatten) = asYAMLcls "MkArgFlatten"+ asYAML (MkArgSlurpyArray) = asYAMLcls "MkArgSlurpyArray"+ asYAML (MkArgMaybeFlatten) = asYAMLcls "MkArgMaybeFlatten"+ asYAML (MkArgOptional) = asYAMLcls "MkArgOptional"++-- Imported from other files :-