Changeset 8684

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

* Pugs.AST.Internals now adopts DrIFT.

Files:
1 added
7 modified

Legend:

Unmodified
Added
Removed

  • Pugs.cabal.in

    r8675 r8684  
    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.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  
     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.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__ 

  • src/DrIFT/YAML.hs

    r8682 r8684  
    2020        Right s -> return s 
    2121 
    22 class (Show a) => YAML a where 
     22class YAML a where 
    2323    asYAML :: a -> IO YamlNode 
     24    asYAML _ = return $ nilNode 
    2425 
    2526asYAMLseq :: YAMLClass -> [IO YAMLVal] -> IO YamlNode 
    … …  
    4445tagHs = ("tag:hs:" ++) 
    4546 
    46 -- XXX - overlapping instances? 
    47 instance YAML () where 
    48     asYAML _ = return $ nilNode 
     47instance YAML () 
    4948 
    5049instance YAML Int where 

  • src/Pugs/CodeGen.hs

    r8681 r8684  
    1414import Pugs.Internals 
    1515import Pugs.CodeGen.PIL1 (genPIL1) 
    16 import Pugs.CodeGen.PIL2 (genPIL2, genPIL2Perl5, genPIL2Binary, genPIL2JSON, genPIL2YAML) 
     16import Pugs.CodeGen.PIL2 (genPIL2, genPIL2Perl5, genPIL2JSON, genPIL2YAML) 
    1717import Pugs.CodeGen.PIR (genPIR, genPIR_YAML) 
    1818import Pugs.CodeGen.Perl5 (genPerl5) 
    1919import Pugs.CodeGen.YAML (genYAML) 
    2020import Pugs.CodeGen.JSON (genJSON) 
    21 import Pugs.CodeGen.Binary (genBinary) 
    2221import Pugs.Compile.Pugs (genPugs) 
    2322import Pugs.Compile.Haskell (genGHC) 
    … …  
    3433    , ("PIL1",        genPIL1) 
    3534    , ("PIL1-Perl5",  genPerl5) 
    36     , ("PIL1-Binary", genBinary) 
    3735    , ("PIL1-JSON",   genJSON) 
    3836    , ("PIL1-YAML",   genYAML) 
    … …  
    4139    , ("PIL2-JSON",   genPIL2JSON) 
    4240    , ("PIL2-YAML",   genPIL2YAML) 
    43     , ("PIL2-Binary", genPIL2Binary) 
    4441    , ("Pugs",        genPugs) 
     42    , ("Parse-YAML",  genParseYAML) 
    4543--  , ("XML",         genXML) 
    4644    ] 
    … …  
    6058    norm' "pil2"   = "PIL2" 
    6159    norm' "perl5"  = "!PIL1-Perl5" 
    62     norm' "binary" = "!PIL1-Binary" 
    6360    norm' "json"   = "!PIL1-JSON" 
    6461    norm' "yaml"   = "!PIL1-YAML" 
    … …  
    6663    norm' "pil1json"   = "PIL1-JSON" 
    6764    norm' "pil1yaml"   = "PIL1-YAML" 
    68     norm' "pil1binary" = "PIL1-Binary" 
    6965    norm' "pil2perl5"  = "PIL2-Perl5" 
    7066    norm' "pil2json"   = "PIL2-JSON" 
    7167    norm' "pil2yaml"   = "PIL2-YAML" 
    72     norm' "pil2binary" = "PIL2-Binary" 
    7368    norm' "pugs"   = "Pugs" 
    7469    -- norm' "xml"    = "XML" 

  • src/Pugs/CodeGen/PIL2.hs

    r8675 r8684  
    44module Pugs.CodeGen.PIL2 ( 
    55    genPIL2, 
    6     genPIL2Perl5, genPIL2Binary, genPIL2JSON, genPIL2YAML 
     6    genPIL2Perl5, genPIL2JSON, genPIL2YAML 
    77) where 
    88import Pugs.Internals 
    … …  
    1313import System.Directory 
    1414import DrIFT.Perl5 
    15 import DrIFT.Binary 
    1615import DrIFT.JSON 
    1716import DrIFT.YAML 
    … …  
    3231    return . VStr . unlines $ [showPerl5 penv] 
    3332 
    34 genPIL2Binary :: Eval Val 
    35 genPIL2Binary = do 
    36     penv <- compile () :: Eval PIL_Environment 
    37     liftIO $ do 
    38         tmp         <- getTemporaryDirectory 
    39         (file, fh)  <- openBinaryTempFile tmp "pugs.bin" 
    40         bh          <- openBinIO fh 
    41         put_ bh penv 
    42         hClose fh 
    43         return $ VStr (unlines [file]) 
    44  
    4533genPIL2JSON :: Eval Val 
    4634genPIL2JSON = do 

  • src/Pugs/PIL1.hs-drift

    r8682 r8684  
    2424import DrIFT.Perl5 
    2525import DrIFT.YAML 
    26 import DrIFT.Binary 
    2726import DrIFT.JSON 
    2827 
    … …  
    3029-- {-! global : Haskell2Xml !-} 
    3130 
    32 {-! global : GhcBinary, Perl5, JSON, YAML !-} 
     31{-! global : Perl5, JSON, YAML !-} 
    3332 
    3433{-| 
    … …  
    128127 
    129128------------------------------------------------------------------------ 
    130  
    131 instance Binary Exp where 
    132     put_ _ _ = return () 
    133     get  _   = return Noop 
    134 instance YAML Exp where 
    135     asYAML _ = asYAML () 
    136 instance Perl5 Exp where 
    137     showPerl5 _ = "(undef)" 
    138 instance JSON Exp where 
    139     showJSON _ = "null" 
    140  
    141 -- Non-canonical serialization... needs work 
    142 instance (Typeable a, YAML a) => YAML (TVar a) where 
    143     asYAML tv = do 
    144         v <- liftSTM (readTVar tv) 
    145         asYAML v 
    146 instance (Show (TVar a)) => Perl5 (TVar a) where 
    147     showPerl5 _ = "(warn '<ref>')" 
    148 instance (Show (TVar a)) => JSON (TVar a) where 
    149     showJSON _ = "null" 
    150  
    151 =begin DRIFT 
    152  
    153 data Scope = SState  -- ^ Persistent across calls 
    154            | SMy     -- ^ Lexical 
    155            | SOur    -- ^ Package 
    156            | SLet    -- ^ Hypotheticalised (reverted upon failure) 
    157            | STemp   -- ^ Temporary (reverted at scope exit) 
    158            | SGlobal -- ^ Global 
    159  
    160 data SubType = SubMethod    -- ^ Method 
    161              | SubCoroutine -- ^ Coroutine 
    162              | SubMacro     -- ^ Macro 
    163              | SubRoutine   -- ^ Regular subroutine 
    164              | SubBlock     -- ^ Bare block 
    165              | SubPointy    -- ^ Pointy sub 
    166              | SubPrim      -- ^ Built-in primitive operator (see "Pugs.Prim") 
    167  
    168  
    169 data Val 
    170     = VUndef                 -- ^ Undefined value 
    171     | VBool     !VBool       -- ^ Boolean value 
    172     | VInt      !VInt        -- ^ Integer value 
    173     | VRat      !VRat        -- ^ Rational number value 
    174     | VNum      !VNum        -- ^ Number (i.e. a double) 
    175     | VStr      !VStr        -- ^ String value 
    176     | VList     !VList       -- ^ List value 
    177     | VType     !VType       -- ^ Type value (e.g. @Int@ or @Type@) 
    178  
    179 data Cxt = CxtVoid         -- ^ Context that isn't expecting any values 
    180          | CxtItem !Type   -- ^ Context expecting a value of the specified type 
    181          | CxtSlurpy !Type -- ^ Context expecting multiple values of the 
    182                            --     specified type 
    183 data Type 
    184     = MkType !String      -- ^ A regular type 
    185     | TypeOr  !Type !Type -- ^ The disjunction (|) of two types 
    186     | TypeAnd !Type !Type -- ^ The conjunction (&) of two types 
    187  
    188 data Param = MkParam 
    189     { isInvocant    :: !Bool        -- ^ Is it in invocant slot? 
    190     , isOptional    :: !Bool        -- ^ Is it optional? 
    191     , isNamed       :: !Bool        -- ^ Is it named-only? 
    192     , isLValue      :: !Bool        -- ^ Is it lvalue (i.e. not `is copy`)? 
    193     , isWritable    :: !Bool        -- ^ Is it writable (i.e. `is rw`)? 
    194     , isLazy        :: !Bool        -- ^ Is it call-by-name (short-circuit)? 
    195     , paramName     :: !String      -- ^ Parameter name 
    196     , paramContext  :: !Cxt         -- ^ Parameter context: slurpiness and type 
    197     , paramDefault  :: !Exp         -- ^ Default expression (to evaluate to) 
    198     } 
    199  
    200 data Pos = MkPos 
    201     { posName           :: !String 
    202     , posBeginLine      :: !Int 
    203     , posBeginColumn    :: !Int 
    204     , posEndLine        :: !Int 
    205     , posEndColumn      :: !Int 
    206     } 
    207  
    208  
    209 =cut 

  • src/Pugs/PIL2.hs-drift

    r8682 r8684  
    2424import DrIFT.Perl5 
    2525import DrIFT.YAML 
    26 import DrIFT.Binary 
    2726import DrIFT.JSON 
    2827 
    … …  
    3029-- {-! global : Haskell2Xml !-} 
    3130 
    32 {-! global : GhcBinary, Perl5, JSON, YAML !-} 
     31{-! global : Perl5, JSON, YAML !-} 
    3332 
    3433{-| 
    … …  
    198197    deriving (Show, Eq, Ord, Typeable) 
    199198 
    200 ------------------------------------------------------------------------ 
    201  
    202 instance Binary Exp where 
    203     put_ _ _ = return () 
    204     get  _   = return Noop 
    205 instance YAML Exp where 
    206     asYAML _ = asYAML () 
    207 instance Perl5 Exp where 
    208     showPerl5 _ = "(undef)" 
    209 instance JSON Exp where 
    210     showJSON _ = "null" 
    211  
    212 -- Non-canonical serialization... needs work 
    213 instance (Typeable a, YAML a) => YAML (TVar a) where 
    214     asYAML tv = do 
    215         v <- liftSTM (readTVar tv) 
    216         asYAML v 
    217 instance (Show (TVar a)) => Perl5 (TVar a) where 
    218     showPerl5 _ = "(warn '<ref>')" 
    219 instance (Show (TVar a)) => JSON (TVar a) where 
    220     showJSON _ = "null" 
    221  
    222 =begin DRIFT 
    223  
    224 data Scope = SState  -- ^ Persistent across calls 
    225            | SMy     -- ^ Lexical 
    226            | SOur    -- ^ Package 
    227            | SLet    -- ^ Hypotheticalised (reverted upon failure) 
    228            | STemp   -- ^ Temporary (reverted at scope exit) 
    229            | SGlobal -- ^ Global 
    230  
    231 data SubType = SubMethod    -- ^ Method 
    232              | SubCoroutine -- ^ Coroutine 
    233              | SubMacro     -- ^ Macro 
    234              | SubRoutine   -- ^ Regular subroutine 
    235              | SubBlock     -- ^ Bare block 
    236              | SubPointy    -- ^ Pointy sub 
    237              | SubPrim      -- ^ Built-in primitive operator (see "Pugs.Prim") 
    238  
    239  
    240 data Val 
    241     = VUndef                 -- ^ Undefined value 
    242     | VBool     !VBool       -- ^ Boolean value 
    243     | VInt      !VInt        -- ^ Integer value 
    244     | VRat      !VRat        -- ^ Rational number value 
    245     | VNum      !VNum        -- ^ Number (i.e. a double) 
    246     | VStr      !VStr        -- ^ String value 
    247     | VList     !VList       -- ^ List value 
    248     | VType     !VType       -- ^ Type value (e.g. @Int@ or @Type@) 
    249  
    250 data Cxt = CxtVoid         -- ^ Context that isn't expecting any values 
    251          | CxtItem !Type   -- ^ Context expecting a value of the specified type 
    252          | CxtSlurpy !Type -- ^ Context expecting multiple values of the 
    253                            --     specified type 
    254 data Type 
    255     = MkType !String      -- ^ A regular type 
    256     | TypeOr  !Type !Type -- ^ The disjunction (|) of two types 
    257     | TypeAnd !Type !Type -- ^ The conjunction (&) of two types 
    258  
    259 data Param = MkParam 
    260     { isInvocant    :: !Bool        -- ^ Is it in invocant slot? 
    261     , isOptional    :: !Bool        -- ^ Is it optional? 
    262     , isNamed       :: !Bool        -- ^ Is it named-only? 
    263     , isLValue      :: !Bool        -- ^ Is it lvalue (i.e. not `is copy`)? 
    264     , isWritable    :: !Bool        -- ^ Is it writable (i.e. `is rw`)? 
    265     , isLazy        :: !Bool        -- ^ Is it call-by-name (short-circuit)? 
    266     , paramName     :: !String      -- ^ Parameter name 
    267     , paramContext  :: !Cxt         -- ^ Parameter context: slurpiness and type 
    268     , paramDefault  :: !Exp         -- ^ Default expression (to evaluate to) 
    269     } 
    270  
    271 data Pos = MkPos 
    272     { posName           :: !String 
    273     , posBeginLine      :: !Int 
    274     , posBeginColumn    :: !Int 
    275     , posEndLine        :: !Int 
    276     , posEndColumn      :: !Int 
    277     } 
    278  
    279  
    280 =cut 

  • util/drift.pl

    r7874 r8684  
    55# XXX - This is not at all portable. 
    66 
     7$ENV{DERIVEPATH} = "$Bin/../src"; 
     8 
    79my ($in, $out) = @ARGV; 
    810my ($rh, $wh); 
    … …  
    1012    $rh, $wh, 
    1113    'runhugs', 
     14    "-h1048576", 
    1215    "-P.:/usr/local/lib/hugs/libraries/:/usr/lib/hugs/libraries/:$Bin/../src/DrIFT:$Bin/../../DrIFT/src", 
    1316    "$Bin/../../DrIFT/src/DrIFT.hs",