Changeset 8675

Show
Ignore:
Timestamp:
01/15/06 08:26:19 (3 years ago)
Author:
audreyt
Message:

* DriFT.YAML: Dumping Haskell structures as YAML.
* ./pugs -CPIL1-YAML etc works.

Files:
3 added
10 modified

Legend:

Unmodified
Added
Removed

  • Pugs.cabal.in

    r8653 r8675  
    1212author: Audrey Tang <autrijus@autrijus.org> 
    1313tested-with: GHC -any 
    14 exposed-modules: Pugs Pugs.AST Pugs.AST.Internals Pugs.AST.Pad Pugs.AST.Pos Pugs.AST.Prag Pugs.AST.SIO Pugs.AST.Scope Pugs.Bind Pugs.CodeGen Pugs.CodeGen.Binary Pugs.CodeGen.JSON Pugs.CodeGen.PIL1 Pugs.CodeGen.PIL2 Pugs.CodeGen.PIR Pugs.CodeGen.PIR.Prelude Pugs.CodeGen.Perl5 Pugs.Compat Pugs.Compile Pugs.Compile.PIL2 Pugs.Compile.Haskell Pugs.Compile.Pugs Pugs.Config Pugs.Cont Pugs.DeepSeq Pugs.Embed Pugs.Embed.Haskell Pugs.Embed.Parrot Pugs.Embed.Perl5 Pugs.Embed.Pugs Pugs.Eval Pugs.Eval.Var Pugs.External Pugs.External.Haskell Pugs.Help Pugs.Internals Pugs.Junc Pugs.Lexer Pugs.Monads Pugs.PIL1 Pugs.PIL2 Pugs.Parser Pugs.Parser.Number Pugs.Parser.Program Pugs.Parser.Types Pugs.Parser.Unsafe Pugs.Parser.Export Pugs.Pretty Pugs.Prim Pugs.Prim.Code Pugs.Prim.Eval Pugs.Prim.FileTest Pugs.Prim.Keyed Pugs.Prim.Lifts Pugs.Prim.List Pugs.Prim.Match Pugs.Prim.Numeric Pugs.Prim.Param Pugs.Prim.Yaml Pugs.Rule Pugs.Rule.Char Pugs.Rule.Combinator Pugs.Rule.Error Pugs.Rule.Expr Pugs.Rule.Language Pugs.Rule.Pos Pugs.Rule.Prim Pugs.Rule.Token Pugs.Run Pugs.Run.Args Pugs.Run.Perl5 Pugs.Shell Pugs.Types Pugs.Version Emit.Common Emit.PIR  
     14exposed-modules: Pugs Pugs.AST Pugs.AST.Internals Pugs.AST.Pad Pugs.AST.Pos Pugs.AST.Prag Pugs.AST.SIO Pugs.AST.Scope Pugs.Bind Pugs.CodeGen Pugs.CodeGen.Binary Pugs.CodeGen.JSON Pugs.CodeGen.PIL1 Pugs.CodeGen.PIL2 Pugs.CodeGen.PIR Pugs.CodeGen.PIR.Prelude Pugs.CodeGen.Perl5 Pugs.CodeGen.YAML Pugs.Compat Pugs.Compile Pugs.Compile.PIL2 Pugs.Compile.Haskell Pugs.Compile.Pugs Pugs.Config Pugs.Cont Pugs.DeepSeq Pugs.Embed Pugs.Embed.Haskell Pugs.Embed.Parrot Pugs.Embed.Perl5 Pugs.Embed.Pugs Pugs.Eval Pugs.Eval.Var Pugs.External Pugs.External.Haskell Pugs.Help Pugs.Internals Pugs.Junc Pugs.Lexer Pugs.Monads Pugs.PIL1 Pugs.PIL2 Pugs.Parser Pugs.Parser.Number Pugs.Parser.Program Pugs.Parser.Types Pugs.Parser.Unsafe Pugs.Parser.Export Pugs.Pretty Pugs.Prim Pugs.Prim.Code Pugs.Prim.Eval Pugs.Prim.FileTest Pugs.Prim.Keyed Pugs.Prim.Lifts Pugs.Prim.List Pugs.Prim.Match Pugs.Prim.Numeric Pugs.Prim.Param Pugs.Prim.Yaml Pugs.Rule Pugs.Rule.Char Pugs.Rule.Combinator Pugs.Rule.Error Pugs.Rule.Expr Pugs.Rule.Language Pugs.Rule.Pos Pugs.Rule.Prim Pugs.Rule.Token Pugs.Run Pugs.Run.Args Pugs.Run.Perl5 Pugs.Shell Pugs.Types Pugs.Version Emit.Common Emit.PIR  
    1515buildable: True 
    1616c-sources: src/cbits/fpstring.c src/pcre/pcre.c __UNICODE_C__ 
    … …  
    2323include-dirs: __INCLUDE_DIRS__ 
    2424hs-source-dir: src 
    25 other-modules: Data.FastPackedString Data.DeepSeq Data.Yaml.Syck DrIFT.Binary DrIFT.JSON DrIFT.Perl5 RRegex RRegex.PCRE RRegex.Syntax System.FilePath UTF8 Unicode 
     25other-modules: Data.FastPackedString Data.DeepSeq Data.Yaml.Syck DrIFT.Binary DrIFT.JSON DrIFT.Perl5 DrIFT.YAML RRegex RRegex.PCRE RRegex.Syntax System.FilePath UTF8 Unicode 
    2626ghc-options: __OPTIONS__ 

  • src/Data/Yaml/Syck.hsc

    r8608 r8675  
    55module Data.Yaml.Syck ( 
    66    parseYaml, emitYaml, 
    7     YamlNode(..), YamlElem(..), emptyYamlNode, tagNode 
     7    YamlNode(..), YamlElem(..), tagNode, nilNode, mkNode, mkTagNode, 
    88) where 
    99 
    … …  
    5858    deriving (Show, Ord, Eq, Enum) 
    5959 
    60 emptyYamlNode :: YamlNode 
    61 emptyYamlNode = MkYamlNode 0 YamlNil Nothing Nothing Nothing 
     60nilNode :: YamlNode 
     61nilNode = MkYamlNode 0 YamlNil Nothing Nothing Nothing 
    6262 
    6363tagNode :: YamlTag -> YamlNode -> YamlNode 
    6464tagNode _   MkYamlNode{tag=Just x} = error ("can't add tag: already tagged with" ++ x) 
    6565tagNode tag node                   = node{tag = tag} 
     66 
     67mkNode :: YamlElem -> YamlNode 
     68mkNode x = MkYamlNode 0 x Nothing Nothing Nothing 
     69 
     70mkTagNode :: String -> YamlElem -> YamlNode 
     71mkTagNode s x = MkYamlNode 0 x (Just s) Nothing Nothing 
    6672 
    6773-- the extra commas here are not a bug 
    … …  
    217223        val     <- readNode parser valId 
    218224        return (key, val) 
    219     return $ emptyYamlNode{ el = YamlMap pairs, tag = tag} 
     225    return $ nilNode{ el = YamlMap pairs, tag = tag} 
    220226 
    221227parseNode SyckSeq parser syckNode len = do 
    … …  
    224230        symId   <- syck_seq_read syckNode idx 
    225231        readNode parser symId 
    226     return $ emptyYamlNode{ el = YamlSeq nodes, tag = tag } 
     232    return $ nilNode{ el = YamlSeq nodes, tag = tag } 
    227233 
    228234parseNode SyckStr _ syckNode len = do 
    … …  
    230236    cstr  <- syck_str_read syckNode 
    231237    str   <- peekCStringLen (cstr, fromEnum len) 
    232     return $ emptyYamlNode{ el = YamlStr str, tag = tag } 
     238    return $ nilNode{ el = YamlStr str, tag = tag } 
    233239 
    234240foreign import ccall "wrapper"   

  • src/DrIFT/UserRules.hs

    r6257 r8675  
    99import UserRuleGhcBinary 
    1010import qualified RulePerl5 
     11import qualified RuleYAML 
    1112import qualified RuleJSON 
    1213import qualified RuleUtility  
    … …  
    1718-- add your rules to this list 
    1819userRules :: [RuleDef] 
    19 userRules = userRulesXml ++ userRulesBinary ++ userRulesGeneric ++ userRulesGhcBinary  ++ RuleUtility.rules ++ RuleFunctorM.rules ++ RuleMonoid.rules ++ RulePerl5.rules ++ RuleJSON.rules 
     20userRules = userRulesXml ++ userRulesBinary ++ userRulesGeneric ++ userRulesGhcBinary  ++ RuleUtility.rules ++ RuleFunctorM.rules ++ RuleMonoid.rules ++ RulePerl5.rules ++ RuleJSON.rules ++ RuleYAML.rules 
    2021 

  • src/Pugs/CodeGen.hs

    r7867 r8675  
    1414import Pugs.Internals 
    1515import Pugs.CodeGen.PIL1 (genPIL1) 
    16 import Pugs.CodeGen.PIL2 (genPIL2, genPIL2Perl5, genPIL2Binary, genPIL2JSON) 
     16import Pugs.CodeGen.PIL2 (genPIL2, genPIL2Perl5, genPIL2Binary, genPIL2JSON, genPIL2YAML) 
    1717import Pugs.CodeGen.PIR (genPIR) 
    1818import Pugs.CodeGen.Perl5 (genPerl5) 
     19import Pugs.CodeGen.YAML (genYAML) 
    1920import Pugs.CodeGen.JSON (genJSON) 
    2021import Pugs.CodeGen.Binary (genBinary) 
    … …  
    3435    , ("PIL1-Binary", genBinary) 
    3536    , ("PIL1-JSON",   genJSON) 
     37    , ("PIL1-YAML",   genYAML) 
    3638    , ("PIL2",        genPIL2) 
    3739    , ("PIL2-Perl5",  genPIL2Perl5) 
    3840    , ("PIL2-JSON",   genPIL2JSON) 
     41    , ("PIL2-YAML",   genPIL2YAML) 
    3942    , ("PIL2-Binary", genPIL2Binary) 
    4043    , ("Pugs",        genPugs) 
    … …  
    5760    norm' "binary" = "!PIL1-Binary" 
    5861    norm' "json"   = "!PIL1-JSON" 
     62    norm' "yaml"   = "!PIL1-YAML" 
    5963    norm' "pil1perl5"  = "PIL1-Perl5" 
    6064    norm' "pil1json"   = "PIL1-JSON" 
     65    norm' "pil1yaml"   = "PIL1-YAML" 
    6166    norm' "pil1binary" = "PIL1-Binary" 
    6267    norm' "pil2perl5"  = "PIL2-Perl5" 
    6368    norm' "pil2json"   = "PIL2-JSON" 
     69    norm' "pil2yaml"   = "PIL2-YAML" 
    6470    norm' "pil2binary" = "PIL2-Binary" 
    6571    norm' "pugs"   = "Pugs" 

  • src/Pugs/CodeGen/PIL2.hs

    r7866 r8675  
    44module Pugs.CodeGen.PIL2 ( 
    55    genPIL2, 
    6     genPIL2Perl5, genPIL2Binary, genPIL2JSON 
     6    genPIL2Perl5, genPIL2Binary, genPIL2JSON, genPIL2YAML 
    77) where 
    88import Pugs.Internals 
    … …  
    1515import DrIFT.Binary 
    1616import DrIFT.JSON 
     17import DrIFT.YAML 
    1718 
    1819genPIL2 :: Eval Val 
    … …  
    4647    penv <- compile () :: Eval PIL_Environment 
    4748    return . VStr . unlines $ [showJSON penv] 
     49 
     50genPIL2YAML :: Eval Val 
     51genPIL2YAML = do 
     52    penv <- compile () :: Eval PIL_Environment 
     53    yaml <- liftIO (showYaml penv) 
     54    return . VStr . unlines $ [yaml] 

  • src/Pugs/PIL1.hs

    r7862 r8675  
    2525import Emit.PIR 
    2626import DrIFT.Perl5 
     27import DrIFT.YAML 
    2728import DrIFT.Binary 
    2829import DrIFT.JSON 
    … …  
    3132-- {-! global : Haskell2Xml !-} 
    3233 
    33 {-! global : GhcBinary, Perl5, JSON !-} 
     34{-! global : GhcBinary, Perl5, JSON, YAML !-} 
    3435 
    3536{-| 
    … …  
    133134    put_ _ _ = return () 
    134135    get  _   = return Noop 
     136instance YAML Exp where 
     137    asYAML _ = asYAML () 
    135138instance Perl5 Exp where 
    136139    showPerl5 _ = "(undef)" 
    … …  
    139142 
    140143-- Non-canonical serialization... needs work 
     144instance (Show (TVar a)) => YAML (TVar a) where 
     145    asYAML _ = asYAML () 
    141146instance (Show (TVar a)) => Perl5 (TVar a) where 
    142147    showPerl5 _ = "(warn '<ref>')" 
    … …  
    162167    showJSON (PIL_Environment aa ab) = showJSHashObj "PIL_Environment" 
    163168             [("pilGlob", showJSON aa) , ("pilMain", showJSON ab)] 
     169 
     170instance YAML PIL_Environment where 
     171    asYAML (PIL_Environment aa ab) = asYAMLmap "PIL_Environment" 
     172           [("pilGlob", asYAML aa) , ("pilMain", asYAML ab)] 
    164173 
    165174instance Binary PIL_Stmts where 
    … …  
    207216              ("pStmts", showJSON ac)] 
    208217 
     218instance YAML PIL_Stmts where 
     219    asYAML (PNil) = asYAMLcls "PNil" 
     220    asYAML (PStmts aa ab) = asYAMLmap "PStmts" 
     221           [("pStmt", asYAML aa) , ("pStmts", asYAML ab)] 
     222    asYAML (PPad aa ab ac) = asYAMLmap "PPad" 
     223           [("pScope", asYAML aa) , ("pSyms", asYAML ab) , 
     224            ("pStmts", asYAML ac)] 
     225 
    209226instance Binary PIL_Stmt where 
    210227    put_ bh PNoop = do 
    … …  
    248265             [("pPos", showJSON aa) , ("pExp", showJSON ab) , 
    249266              ("pNode", showJSON ac)] 
     267 
     268instance YAML PIL_Stmt where 
     269    asYAML (PNoop) = asYAMLcls "PNoop" 
     270    asYAML (PStmt aa) = asYAMLmap "PStmt" [("pExpr", asYAML aa)] 
     271    asYAML (PPos aa ab ac) = asYAMLmap "PPos" 
     272           [("pPos", asYAML aa) , ("pExp", asYAML ab) , ("pNode", asYAML ac)] 
    250273 
    251274instance Binary PIL_Expr where 
    … …  
    317340              ("pBody", showJSON ae)] 
    318341 
     342instance YAML PIL_Expr where 
     343    asYAML (PRawName aa) = asYAMLmap "PRawName" 
     344           [("pRawName", asYAML aa)] 
     345    asYAML (PExp aa) = asYAMLmap "PExp" [("pLV", asYAML aa)] 
     346    asYAML (PLit aa) = asYAMLmap "PLit" [("pLit", asYAML aa)] 
     347    asYAML (PThunk aa) = asYAMLmap "PThunk" [("pThunk", asYAML aa)] 
     348    asYAML (PCode aa ab ac ad ae) = asYAMLmap "PCode" 
     349           [("pType", asYAML aa) , ("pParams", asYAML ab) , 
     350            ("pLValue", asYAML ac) , ("pIsMulti", asYAML ad) , 
     351            ("pBody", asYAML ae)] 
     352 
    319353instance Binary PIL_Decl where 
    320354    put_ bh (PSub aa ab ac ad ae af) = do 
    … …  
    346380              ("pSubIsMulti", showJSON ae) , ("pSubBody", showJSON af)] 
    347381 
     382instance YAML PIL_Decl where 
     383    asYAML (PSub aa ab ac ad ae af) = asYAMLmap "PSub" 
     384           [("pSubName", asYAML aa) , ("pSubType", asYAML ab) , 
     385            ("pSubParams", asYAML ac) , ("pSubLValue", asYAML ad) , 
     386            ("pSubIsMulti", asYAML ae) , ("pSubBody", asYAML af)] 
     387 
    348388instance Binary PIL_Literal where 
    349389    put_ bh (PVal aa) = do 
    … …  
    358398instance JSON PIL_Literal where 
    359399    showJSON (PVal aa) = showJSHashObj "PVal" [("pVal", showJSON aa)] 
     400 
     401instance YAML PIL_Literal where 
     402    asYAML (PVal aa) = asYAMLmap "PVal" [("pVal", asYAML aa)] 
    360403 
    361404instance Binary PIL_LValue where 
    … …  
    421464             [("pLHS", showJSON aa) , ("pRHS", showJSON ab)] 
    422465 
     466instance YAML PIL_LValue where 
     467    asYAML (PVar aa) = asYAMLmap "PVar" [("pVarName", asYAML aa)] 
     468    asYAML (PApp aa ab ac ad) = asYAMLmap "PApp" 
     469           [("pCxt", asYAML aa) , ("pFun", asYAML ab) , ("pInv", asYAML ac) , 
     470            ("pArgs", asYAML ad)] 
     471    asYAML (PAssign aa ab) = asYAMLmap "PAssign" 
     472           [("pLHS", asYAML aa) , ("pRHS", asYAML ab)] 
     473    asYAML (PBind aa ab) = asYAMLmap "PBind" 
     474           [("pLHS", asYAML aa) , ("pRHS", asYAML ab)] 
     475 
    423476instance Binary TParam where 
    424477    put_ bh (MkTParam aa ab) = do 
    … …  
    437490    showJSON (MkTParam aa ab) = showJSHashObj "MkTParam" 
    438491             [("tpParam", showJSON aa) , ("tpDefault", showJSON ab)] 
     492 
     493instance YAML TParam where 
     494    asYAML (MkTParam aa ab) = asYAMLmap "MkTParam" 
     495           [("tpParam", asYAML aa) , ("tpDefault", asYAML ab)] 
    439496 
    440497instance Binary TCxt where 
    … …  
    491548    showJSON (TTailCall aa) = showJSArrayObj "TTailCall" [showJSON aa] 
    492549 
     550instance YAML TCxt where 
     551    asYAML (TCxtVoid) = asYAMLcls "TCxtVoid" 
     552    asYAML (TCxtLValue aa) = asYAMLseq "TCxtLValue" [asYAML aa] 
     553    asYAML (TCxtItem aa) = asYAMLseq "TCxtItem" [asYAML aa] 
     554    asYAML (TCxtSlurpy aa) = asYAMLseq "TCxtSlurpy" [asYAML aa] 
     555    asYAML (TTailCall aa) = asYAMLseq "TTailCall" [asYAML aa] 
     556 
    493557instance Binary TEnv where 
    494558    put_ bh (MkTEnv aa ab ac ad ae) = do 
    … …  
    517581              ("tCxt", showJSON ac) , ("tReg", showJSON ad) , 
    518582              ("tLabel", showJSON ae)] 
     583 
     584instance YAML TEnv where 
     585    asYAML (MkTEnv aa ab ac ad ae) = asYAMLmap "MkTEnv" 
     586           [("tLexDepth", asYAML aa) , ("tTokDepth", asYAML ab) , 
     587            ("tCxt", asYAML ac) , ("tReg", asYAML ad) , ("tLabel", asYAML ae)] 
    519588 
    520589instance Binary Scope where 
    … …  
    563632    showJSON (STemp) = showJSScalar "STemp" 
    564633    showJSON (SGlobal) = showJSScalar "SGlobal" 
     634 
     635instance YAML Scope where 
     636    asYAML (SState) = asYAMLcls "SState" 
     637    asYAML (SMy) = asYAMLcls "SMy" 
     638    asYAML (SOur) = asYAMLcls "SOur" 
     639    asYAML (SLet) = asYAMLcls "SLet" 
     640    asYAML (STemp) = asYAMLcls "STemp" 
     641    asYAML (SGlobal) = asYAMLcls "SGlobal" 
    565642 
    566643instance Binary SubType where 
    … …  
    615692    showJSON (SubPointy) = showJSScalar "SubPointy" 
    616693    showJSON (SubPrim) = showJSScalar "SubPrim" 
     694 
     695instance YAML SubType where 
     696    asYAML (SubMethod) = asYAMLcls "SubMethod" 
     697    asYAML (SubCoroutine) = asYAMLcls "SubCoroutine" 
     698    asYAML (SubMacro) = asYAMLcls "SubMacro" 
     699    asYAML (SubRoutine) = asYAMLcls "SubRoutine" 
     700    asYAML (SubBlock) = asYAMLcls "SubBlock" 
     701    asYAML (SubPointy) = asYAMLcls "SubPointy" 
     702    asYAML (SubPrim) = asYAMLcls "SubPrim" 
    617703 
    618704instance Binary Val where 
    … …  
    688774    showJSON (VType aa) = showJSArrayObj "VType" [showJSON aa] 
    689775 
     776instance YAML Val where 
     777    asYAML (VUndef) = asYAMLcls "VUndef" 
     778    asYAML (VBool aa) = asYAMLseq "VBool" [asYAML aa] 
     779    asYAML (VInt aa) = asYAMLseq "VInt" [asYAML aa] 
     780    asYAML (VRat aa) = asYAMLseq "VRat" [asYAML aa] 
     781    asYAML (VNum aa) = asYAMLseq "VNum" [asYAML aa] 
     782    asYAML (VStr aa) = asYAMLseq "VStr" [asYAML aa] 
     783    asYAML (VList aa) = asYAMLseq "VList" [asYAML aa] 
     784    asYAML (VType aa) = asYAMLseq "VType" [asYAML aa] 
     785 
    690786instance Binary Cxt where 
    691787    put_ bh CxtVoid = do 
    … …  
    720816    showJSON (CxtItem aa) = showJSArrayObj "CxtItem" [showJSON aa] 
    721817    showJSON (CxtSlurpy aa) = showJSArrayObj "CxtSlurpy" [showJSON aa] 
     818 
     819instance YAML Cxt where 
     820    asYAML (CxtVoid) = asYAMLcls "CxtVoid" 
     821    asYAML (CxtItem aa) = asYAMLseq "CxtItem" [asYAML aa] 
     822    asYAML (CxtSlurpy aa) = asYAMLseq "CxtSlurpy" [asYAML aa] 
    722823 
    723824instance Binary Type where 
    … …  
    763864             [showJSON aa , showJSON ab] 
    764865 
     866instance YAML Type where 
     867    asYAML (MkType aa) = asYAMLseq "MkType" [asYAML aa] 
     868    asYAML (TypeOr aa ab) = asYAMLseq "TypeOr" [asYAML aa , asYAML ab] 
     869    asYAML (TypeAnd aa ab) = asYAMLseq "TypeAnd" 
     870           [asYAML aa , asYAML ab] 
     871 
    765872instance Binary Param where 
    766873    put_ bh (MkParam aa ab ac ad ae af ag ah ai) = do 
    … …  
    804911              ("paramDefault", showJSON ai)] 
    805912 
     913instance YAML Param where 
     914    asYAML (MkParam aa ab ac ad ae af ag ah ai) = asYAMLmap "MkParam" 
     915           [("isInvocant", asYAML aa) , ("isOptional", asYAML ab) , 
     916            ("isNamed", asYAML ac) , ("isLValue", asYAML ad) , 
     917            ("isWritable", asYAML ae) , ("isLazy", asYAML af) , 
     918            ("paramName", asYAML ag) , ("paramContext", asYAML ah) , 
     919            ("paramDefault", asYAML ai)] 
     920 
    806921instance Binary Pos where 
    807922    put_ bh (MkPos aa ab ac ad ae) = do 
    … …  
    831946              ("posEndColumn", showJSON ae)] 
    832947 
     948instance YAML Pos where 
     949    asYAML (MkPos aa ab ac ad ae) = asYAMLmap "MkPos" 
     950           [("posName", asYAML aa) , ("posBeginLine", asYAML ab) , 
     951            ("posBeginColumn", asYAML ac) , ("posEndLine", asYAML ad) , 
     952            ("posEndColumn", asYAML ae)] 
     953 
    833954--  Imported from other files :- 

  • src/Pugs/PIL1.hs-drift

    r6801 r8675  
    2323import Emit.PIR 
    2424import DrIFT.Perl5 
     25import DrIFT.YAML 
    2526import DrIFT.Binary 
    2627import DrIFT.JSON 
    … …  
    2930-- {-! global : Haskell2Xml !-} 
    3031 
    31 {-! global : GhcBinary, Perl5, JSON !-} 
     32{-! global : GhcBinary, Perl5, JSON, YAML !-} 
    3233 
    3334{-| 
    … …  
    131132    put_ _ _ = return () 
    132133    get  _   = return Noop 
     134instance YAML Exp where 
     135    asYAML _ = asYAML () 
    133136instance Perl5 Exp where 
    134137    showPerl5 _ = "(undef)" 
    … …  
    137140 
    138141-- Non-canonical serialization... needs work 
     142instance (Show (TVar a)) => YAML (TVar a) where 
     143    asYAML _ = asYAML () 
    139144instance (Show (TVar a)) => Perl5 (TVar a) where 
    140145    showPerl5 _ = "(warn '<ref>')" 

  • src/Pugs/PIL2.hs

    r8161 r8675  
    1 {-# OPTIONS_GHC -cpp -fglasgow-exts -funbox-strict-fields -fallow-overlapping-instances -fno-warn-orphans -fno-warn-incomplete-patterns -fallow-undecidable-instances #-} 
     1{-# OPTIONS_GHC -fglasgow-exts -funbox-strict-fields -fallow-overlapping-instances -fno-warn-orphans -fno-warn-incomplete-patterns -fallow-undecidable-instances #-} 
    22{- Generated by DrIFT (Automatic class derivations for Haskell) -} 
    33{-# LINE 1 "src/Pugs/PIL2.hs-drift" #-} 
    … …  
    2525import Emit.PIR 
    2626import DrIFT.Perl5 
     27import DrIFT.YAML 
    2728import DrIFT.Binary 
    2829import DrIFT.JSON 
    … …  
    3132-- {-! global : Haskell2Xml !-} 
    3233 
    33 {-! global : GhcBinary, Perl5, JSON !-} 
    34  
    35 #ifndef HADDOCK 
    36 -- the @s etc. here confuse Haddock. 
     34{-! global : GhcBinary, Perl5, JSON, YAML !-} 
     35 
    3736{-| 
    3837    The plan here is to first compile the environment (subroutines, 
    … …  
    111110 
    112111-} 
    113 #endif 
    114112 
    115113data PIL_Environment = PIL_Environment 
    … …  
    207205    put_ _ _ = return () 
    208206    get  _   = return Noop 
     207instance YAML Exp where 
     208    asYAML _ = asYAML () 
    209209instance Perl5 Exp where 
    210210    showPerl5 _ = "(undef)" 
    … …  
    213213 
    214214-- Non-canonical serialization... needs work 
     215instance (Show (TVar a)) => YAML (TVar a) where 
     216    asYAML _ = asYAML () 
    215217instance (Show (TVar a)) => Perl5 (TVar a) where 
    216218    showPerl5 _ = "(warn '<ref>')" 
    … …  
    236238    showJSON (PIL_Environment aa ab) = showJSHashObj "PIL_Environment" 
    237239             [("pilGlob", showJSON aa) , ("pilMain", showJSON ab)] 
     240 
     241instance YAML PIL_Environment where 
     242    asYAML (PIL_Environment aa ab) = asYAMLmap "PIL_Environment" 
     243           [("pilGlob", asYAML aa) , ("pilMain", asYAML ab)] 
    238244 
    239245instance Binary PIL_Stmts where 
    … …  
    281287              ("pStmts", showJSON ac)] 
    282288 
     289instance YAML PIL_Stmts where 
     290    asYAML (PNil) = asYAMLcls "PNil" 
     291    asYAML (PStmts aa ab) = asYAMLmap "PStmts" 
     292           [("pStmt", asYAML aa) , ("pStmts", asYAML ab)] 
     293    asYAML (PPad aa ab ac) = asYAMLmap "PPad" 
     294           [("pScope", asYAML aa) , ("pSyms", asYAML ab) , 
     295            ("pStmts", asYAML ac)] 
     296 
    283297instance Binary PIL_Stmt where 
    284298    put_ bh PNoop = do 
    … …  
    322336             [("pPos", showJSON aa) , ("pExp", showJSON ab) , 
    323337              ("pNode", showJSON ac)] 
     338 
     339instance YAML PIL_Stmt where 
     340    asYAML (PNoop) = asYAMLcls "PNoop" 
     341    asYAML (PStmt aa) = asYAMLmap "PStmt" [("pExpr", asYAML aa)] 
     342    asYAML (PPos aa ab ac) = asYAMLmap "PPos" 
     343           [("pPos", asYAML aa) , ("pExp", asYAML ab) , ("pNode", asYAML ac)] 
    324344 
    325345instance Binary PIL_Expr where 
    … …  
    391411              ("pBody", showJSON ae)] 
    392412 
     413instance YAML PIL_Expr where 
     414    asYAML (PRawName aa) = asYAMLmap "PRawName" 
     415           [("pRawName", asYAML aa)] 
     416    asYAML (PExp aa) = asYAMLmap "PExp" [("pLV", asYAML aa)] 
     417    asYAML (PLit aa) = asYAMLmap "PLit" [("pLit", asYAML aa)] 
     418    asYAML (PThunk aa) = asYAMLmap "PThunk" [("pThunk", asYAML aa)] 
     419    asYAML (PCode aa ab ac ad ae) = asYAMLmap "PCode" 
     420           [("pType", asYAML aa) , ("pParams", asYAML ab) , 
     421            ("pLValue", asYAML ac) , ("pIsMulti", asYAML ad) , 
     422            ("pBody", asYAML ae)] 
     423 
    393424instance Binary PIL_Decl where 
    394425    put_ bh (PSub aa ab ac ad ae af) = do 
    … …  
    420451              ("pSubIsMulti", showJSON ae) , ("pSubBody", showJSON af)] 
    421452 
     453instance YAML PIL_Decl where 
     454    asYAML (PSub aa ab ac ad ae af) = asYAMLmap "PSub" 
     455           [("pSubName", asYAML aa) , ("pSubType", asYAML ab) , 
     456            ("pSubParams", asYAML ac) , ("pSubLValue", asYAML ad) , 
     457            ("pSubIsMulti", asYAML ae) , ("pSubBody", asYAML af)] 
     458 
    422459instance Binary PIL_Literal where 
    423460    put_ bh (PVal aa) = do 
    … …  
    432469instance JSON PIL_Literal where 
    433470    showJSON (PVal aa) = showJSHashObj "PVal" [("pVal", showJSON aa)] 
     471 
     472instance YAML PIL_Literal where 
     473    asYAML (PVal aa) = asYAMLmap "PVal" [("pVal", asYAML aa)] 
    434474 
    435475instance Binary PIL_LValue where 
    … …  
    495535             [("pLHS", showJSON aa) , ("pRHS", showJSON ab)] 
    496536 
     537instance YAML PIL_LValue where 
     538    asYAML (PVar aa) = asYAMLmap "PVar" [("pVarName", asYAML aa)] 
     539    asYAML (PApp aa ab ac ad) = asYAMLmap "PApp" 
     540           [("pCxt", asYAML aa) , ("pFun", asYAML ab) , ("pInv", asYAML ac) , 
     541            ("pArgs", asYAML ad)] 
     542    asYAML (PAssign aa ab) = asYAMLmap "PAssign" 
     543           [("pLHS", asYAML aa) , ("pRHS", asYAML ab)] 
     544    asYAML (PBind aa ab) = asYAMLmap "PBind" 
     545           [("pLHS", asYAML aa) , ("pRHS", asYAML ab)] 
     546 
    497547instance Binary TParam where 
    498548    put_ bh (MkTParam aa ab) = do 
    … …  
    511561    showJSON (MkTParam aa ab) = showJSHashObj "MkTParam" 
    512562             [("tpParam", showJSON aa) , ("tpDefault", showJSON ab)] 
     563 
     564instance YAML TParam where 
     565    asYAML (MkTParam aa ab) = asYAMLmap "MkTParam" 
     566           [("tpParam", asYAML aa) , ("tpDefault", asYAML ab)] 
    513567 
    514568instance Binary TCxt where 
    … …  
    565619    showJSON (TTailCall aa) = showJSArrayObj "TTailCall" [showJSON aa] 
    566620 
     621instance YAML TCxt where 
     622    asYAML (TCxtVoid) = asYAMLcls "TCxtVoid" 
     623    asYAML (TCxtLValue aa) = asYAMLseq "TCxtLValue" [asYAML aa] 
     624    asYAML (TCxtItem aa) = asYAMLseq "TCxtItem" [asYAML aa] 
     625    asYAML (TCxtSlurpy aa) = asYAMLseq "TCxtSlurpy" [asYAML aa] 
     626    asYAML (TTailCall aa) = asYAMLseq "TTailCall" [asYAML aa] 
     627 
    567628instance Binary TEnv where 
    568629    put_ bh (MkTEnv aa ab ac ad ae) = do 
    … …  
    591652              ("tCxt", showJSON ac) , ("tReg", showJSON ad) , 
    592653              ("tLabel", showJSON ae)] 
     654 
     655instance YAML TEnv where 
     656    asYAML (MkTEnv aa ab ac ad ae) = asYAMLmap "MkTEnv" 
     657           [("tLexDepth", asYAML aa) , ("tTokDepth", asYAML ab) , 
     658            ("tCxt", asYAML ac) , ("tReg", asYAML ad) , ("tLabel", asYAML ae)] 
    593659 
    594660instance Binary Scope where 
    … …  
    637703    showJSON (STemp) = showJSScalar "STemp" 
    638704    showJSON (SGlobal) = showJSScalar "SGlobal" 
     705 
     706instance YAML Scope where 
     707    asYAML (SState) = asYAMLcls "SState" 
     708    asYAML (SMy) = asYAMLcls "SMy" 
     709    asYAML (SOur) = asYAMLcls "SOur" 
     710    asYAML (SLet) = asYAMLcls "SLet" 
     711    asYAML (STemp) = asYAMLcls "STemp" 
     712    asYAML (SGlobal) = asYAMLcls "SGlobal" 
    639713 
    640714instance Binary SubType where 
    … …  
    689763    showJSON (SubPointy) = showJSScalar "SubPointy" 
    690764    showJSON (SubPrim) = showJSScalar "SubPrim" 
     765 
     766instance YAML SubType where 
     767    asYAML (SubMethod) = asYAMLcls "SubMethod" 
     768    asYAML (SubCoroutine) = asYAMLcls "SubCoroutine" 
     769    asYAML (SubMacro) = asYAMLcls "SubMacro" 
     770    asYAML (SubRoutine) = asYAMLcls "SubRoutine" 
     771    asYAML (SubBlock) = asYAMLcls "SubBlock" 
     772    asYAML (SubPointy) = asYAMLcls "SubPointy" 
     773    asYAML (SubPrim) = asYAMLcls "SubPrim" 
    691774 
    692775instance Binary Val where 
    … …  
    762845    showJSON (VType aa) = showJSArrayObj "VType" [showJSON aa] 
    763846 
     847instance YAML Val where 
     848    asYAML (VUndef) = asYAMLcls "VUndef" 
     849    asYAML (VBool aa) = asYAMLseq "VBool" [asYAML aa] 
     850    asYAML (VInt aa) = asYAMLseq "VInt" [asYAML aa] 
     851    asYAML (VRat aa) = asYAMLseq "VRat" [asYAML aa] 
     852    asYAML (VNum aa) = asYAMLseq "VNum" [asYAML aa] 
     853    asYAML (VStr aa) = asYAMLseq "VStr" [asYAML aa] 
     854    asYAML (VList aa) = asYAMLseq "VList" [asYAML aa] 
     855    asYAML (VType aa) = asYAMLseq "VType" [asYAML aa] 
     856