Changeset 8837 for src/Pugs/Run/Args.hs

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

* -n and -p now always surrounds the remaining flags with

while () {...} blocks, instead of only the -e parts.

Files:
1 modified

Legend:

Unmodified
Added
Removed
  • src/Pugs/Run/Args.hs

    r8738 r8837  
    126126 
    127127argRank :: Arg -> Int 
    128 argRank(Switch 'h')         = -1 
    129 argRank(Switch 'v')         = -1 
    130 argRank(Opt "-V:" _)        = -1 
    131 argRank(Switch 'V')         = -1 
    132 argRank(Opt "-I" _)         = 0 
    133 argRank(Switch 'd')         = 1 
    134 argRank(Switch 'w')         = 2 
    135 argRank(Switch 'c')         = 3 
    136 argRank(Opt "-C" _)         = 4 
    137 argRank(Opt "-B" _)         = 4 
    138 argRank(Opt "--external" _) = 5 
    139 argRank(Opt "-M" _)         = 98 
    140 argRank(Switch 'n')         = 99   -- translated into Perl code (later) 
    141 argRank(Switch 'p')         = 99   -- translated into Perl code (later) 
    142 argRank(Switch 'l')         = 100  -- translated into Perl code (later) 
    143 argRank(Switch '0')         = 100  -- translated into Perl code (later) 
    144 argRank(Opt "-e" _)         = 100  -- translated into Perl code 
    145 argRank(_)                  = 100  -- filename or @ARGS or whatever 
     128argRank (Switch 'h')         = -1 
     129argRank (Switch 'v')         = -1 
     130argRank (Opt "-V:" _)        = -1 
     131argRank (Switch 'V')         = -1 
     132argRank (Opt "-I" _)         = 0 
     133argRank (Switch 'd')         = 1 
     134argRank (Switch 'w')         = 2 
     135argRank (Switch 'c')         = 3 
     136argRank (Opt "-C" _)         = 4 
     137argRank (Opt "-B" _)         = 4 
     138argRank (Opt "--external" _) = 5 
     139argRank (Opt "-M" _)         = 98 
     140argRank (Switch 'n')         = 99   -- translated into Perl code (later) 
     141argRank (Switch 'p')         = 99   -- translated into Perl code (later) 
     142argRank (Switch 'l')         = 100  -- translated into Perl code (later) 
     143argRank (Switch '0')         = 100  -- translated into Perl code (later) 
     144argRank (Opt "-e" _)         = 100  -- translated into Perl code 
     145argRank _                    = 100  -- filename or @ARGS or whatever 
    146146 
    147147gatherArgs :: [String] -> [Arg] 
    148 gatherArgs([]) = [] 
    149 gatherArgs("-l":rest)             = gatherArgs("-e":"# BEGIN { ... } # to be done":rest) -- XXX implement BEGIN block later 
    150 gatherArgs("-e":frag:rest)        = [Opt "-e" frag] ++ gatherArgs(rest) 
    151 gatherArgs("--external":mod:rest) = [Opt "--external" mod] ++ gatherArgs(rest) 
    152 gatherArgs("-I":dir:rest)         = [Opt "-I" dir] ++ gatherArgs(rest) 
    153 gatherArgs("-M":mod:rest)         = [Opt "-M" mod] ++ gatherArgs(rest) 
    154 gatherArgs("-C":backend:rest)     = [Opt "-C" backend] ++ gatherArgs(rest) 
    155 gatherArgs("-B":backend:rest)     = [Opt "-B" backend] ++ gatherArgs(rest) 
    156 gatherArgs("-V:":item:rest)       = [Opt "-V:" item] ++ gatherArgs(rest) 
    157 gatherArgs(('-':[]):xs)           = [File "-"] ++ gatherArgs(xs) 
    158 gatherArgs(("--"):rest)           = [File x | x <- rest] 
    159 gatherArgs(('-':x:[]):xs)         = [Switch x] ++ gatherArgs(xs) 
    160 gatherArgs(x:xs)                  = [File x] ++ gatherArgs(xs) 
     148gatherArgs [] = [] 
     149-- XXX implement BEGIN block later 
     150gatherArgs ("-l":rest)             = gatherArgs("-e":"# BEGIN { ... } # to be done":rest) 
     151gatherArgs ("-e":frag:rest)        = [Opt "-e" frag] ++ gatherArgs(rest) 
     152gatherArgs ("--external":mod:rest) = [Opt "--external" mod] ++ gatherArgs(rest) 
     153gatherArgs ("-I":dir:rest)         = [Opt "-I" dir] ++ gatherArgs(rest) 
     154gatherArgs ("-M":mod:rest)         = [Opt "-M" mod] ++ gatherArgs(rest) 
     155gatherArgs ("-C":backend:rest)     = [Opt "-C" backend] ++ gatherArgs(rest) 
     156gatherArgs ("-B":backend:rest)     = [Opt "-B" backend] ++ gatherArgs(rest) 
     157gatherArgs ("-V:":item:rest)       = [Opt "-V:" item] ++ gatherArgs(rest) 
     158gatherArgs (('-':[]):xs)           = [File "-"] ++ gatherArgs(xs) 
     159gatherArgs (("--"):rest)           = [File x | x <- rest] 
     160gatherArgs (('-':x:[]):xs)         = [Switch x] ++ gatherArgs(xs) 
     161gatherArgs (x:xs)                  = [File x] ++ gatherArgs(xs) 
    161162 
    162163{- collect "-e" switches together, 
     
    166167desugarDashE :: [Arg] -> [Arg] 
    167168desugarDashE [] = [] 
    168 desugarDashE ((Switch 'p'):args) = desugarDashE ((Opt "-e" "while ($_ = =<>) { $_ .= chomp;"):script++[(Opt "-e" "; say $_; }")]++rest) 
    169                                  where 
    170                                    (script,rest) = partition isDashE args 
    171                                    isDashE (Opt "-e" _) = True 
    172                                    isDashE (_) = False 
    173 desugarDashE ((Switch 'n'):args) = desugarDashE ((Opt "-e" "while ($_ = =<>) { $_ .= chomp;"):script++[(Opt "-e" "}")]++rest) 
    174                                  where 
    175                                    (script,rest) = partition isDashE args 
    176                                    isDashE (Opt "-e" _) = True 
    177                                    isDashE (_) = False 
     169desugarDashE ((Switch 'p'):args) = desugarDashE $ 
     170    (Opt "-e" "env $_; while ($_ = =<>) { $_ = chomp($_);" : args) ++ [Opt "-e" "; say $_; }"] 
     171desugarDashE ((Switch 'n'):args) = desugarDashE $ 
     172    (Opt "-e" "env $_; while ($_ = =<>) { $_ = chomp($_);" : args) ++ [Opt "-e" "}"] 
    178173 
    179174-- -E is like -e, but not accessible as a normal parameter and used only