Changeset 12317 for src/Pugs/Compile

Show
Ignore:
Timestamp:
08/16/06 19:28:24 (2 years ago)
Author:
audreyt
Message:

* Glorious refactoring of the Var type.

Previously, Var is type synonym to String, and all package

lookups, OUTER
handling, sigil and twigil parsing etc were done in an extremely adhoc way with String operations.

Now we split Var into several parts.
Take "&Moose::Elk::infix:<antler>" as an example:

v_sigil
VarSigil? -- SScalar
v_twigil
VarTwigil? -- TNone
v_package
Pkg -- ["Moose", "Elk"]
v_categ
VarCateg? -- C_infix
v_name
ID -- "antler"

The names are stored as interned ByteStrings? for fast comparison.

All involved types are changed from String to new types as well,

such as (envPackage
Pkg).
Location:
src/Pugs/Compile
Files:
3 modified

Legend:

Unmodified
Added
Removed

  • src/Pugs/Compile/Haskell.hs

    r8153 r12317  
    5252    argC = compile stmt 
    5353    argRest = compile rest 
    54 compile (App (Var op) Nothing []) = [| op0 op [] |] 
    55 compile (App (Var ('&':op)) Nothing [arg]) = [| do 
     54compile (App (Var var) Nothing []) | op <- cast var = [| op0 op [] |] 
     55compile (App (Var var) Nothing [arg]) | ('&':op) <- cast var = [| do 
    5656        val <- $(argC) 
    5757        op1 op val 
    5858    |] where 
    5959    argC = compile arg 
    60 compile (App (Var ('&':op)) Nothing [arg1, arg2]) = [| do 
     60compile (App (Var var) Nothing [arg1, arg2]) | ('&':op) <- cast var = [| do 
    6161        val1 <- $(argC1) 
    6262        val2 <- $(argC2) 

  • src/Pugs/Compile/PIL2.hs

    r10842 r12317  
    1818import Text.PrettyPrint 
    1919 
     20import qualified Data.ByteString.Char8 as Str 
     21 
    2022tcVoid, tcLValue :: TCxt 
    2123tcVoid      = TCxtVoid 
    … …  
    6466        return $ concat entries' 
    6567        where 
    66         entries = sortBy padSort $ padToList pad 
     68        entries = sortBy padSort [ (cast var, ref) | (var, ref) <- padToList pad ] 
    6769        canCompile (name@('&':_), xs) | length xs > 1 = do 
    6870            fmap concat $ mapM (\x -> canCompile (name, [x])) xs 
    … …  
    127129        rv <- readRef =<< liftSTM (readTVar ref) 
    128130        case rv of 
    129             VCode sub   -> return $ PRawName (subName sub) 
     131            VCode sub   -> return $ PRawName (cast $ subName sub) 
    130132            _           -> return $ PRawName name 
    131133    compile (name, _) = return $ PRawName name 
    … …  
    137139    compile (Ann (Cxt cxt) rest) = enter cxt $ compile rest 
    138140    compile (Ann _ rest) = compile rest 
    139     compile (Sym _ "" rest) = compile rest 
    140141    compile (Stmts (Pad SOur _ exp) rest) = do 
    141142        compile $ mergeStmts exp rest 
    142143    compile (Stmts (Pad scope pad exp) rest) = do 
    143         padC    <- compile $ padToList pad 
    144         let symC = (map fst $ padToList pad) `zip` padC 
    145             exps = [ Syn ":=" [Var name, Var from] | (name, PRawName from) <- symC, name /= from ] 
     144        padC    <- compile [ (cast var :: String, ref) | (var, ref) <- padToList pad ] 
     145        let symC = (map (cast . fst) $ padToList pad) `zip` padC 
     146            exps = [ Syn ":=" [_Var name, _Var from] 
     147                   | (name, PRawName from) <- symC 
     148                   , name /= from 
     149                   ] 
    146150        expC    <- compile $ mergeStmts (foldl1 mergeStmts (exps ++ [exp])) rest 
    147151        return $ PPad scope symC expC 
    … …  
    170174        thisC   <- enter cxtVoid $ compile this 
    171175        declC   <- enter cxtVoid $ compile decl 
    172         restC   <- enterPackage pkg $ compileStmts rest 
     176        restC   <- enterPackage (cast pkg) $ compileStmts rest 
    173177        return $ PStmts thisC $ PStmts declC restC 
    174178        where 
    175179          -- XXX - kludge. 
    176           decl = App (Var func) Nothing [(Val (VStr pkg))] 
     180          decl = App (_Var func) Nothing [(Val (VStr pkg))] 
    177181          func = "&" ++ (capitalize sym) ++ "::_create" 
    178182          capitalize []     = [] 
    … …  
    198202    compile (Ann Prag{} rest) = compile rest -- fmap (PPos pos rest) $ compile rest 
    199203    compile (Ann _ rest) = compile rest 
    200     compile (Sym _ "" rest) = compile rest 
    201204    compile Noop = return PNoop 
    202205    compile (Val val) = do 
    … …  
    222225        bodyC   <- compile body 
    223226        postC   <- compile post 
    224         funC    <- compile (Var "&statement_control:loop") 
     227        funC    <- compile (_Var "&statement_control:loop") 
    225228        return . PStmt . PExp $ PApp TCxtVoid funC Nothing 
    226229            [preC, pBlock condC, pBlock bodyC, pBlock postC] 
    … …  
    233236        expC    <- compile exp 
    234237        bodyC   <- compile body 
    235         funC    <- compile (Var "&statement_control:for") 
     238        funC    <- compile (_Var "&statement_control:for") 
    236239        return . PStmt . PExp $ PApp TCxtVoid funC Nothing [expC, bodyC] 
    237     compile (Syn "given" _) = compile (Var "$_") -- XXX 
    238     compile (Syn "when" _) = compile (Var "$_") -- XXX 
     240    compile (Syn "given" _) = compile (_Var "$_") -- XXX 
     241    compile (Syn "when" _) = compile (_Var "$_") -- XXX 
    239242    compile exp = fmap PStmt $ compile exp 
    240243 
    … …  
    275278    compile (Ann (Cxt cxt) rest) = enter cxt $ compile rest 
    276279    compile (Ann _ rest) = compile rest 
    277     compile (Sym _ "" rest) = compile rest 
    278280    -- XXX: pragmas? 
    279     compile (Var name) = return $ PVar name 
     281    compile (Var name) = return $ _PVar name 
    280282    compile (Syn (sigil:"::()") exps) = do 
    281         compile $ App (Var "&Pugs::Internals::symbolic_deref") Nothing $ 
     283        compile $ App (_Var "&Pugs::Internals::symbolic_deref") Nothing $ 
    282284            (Val . VStr $ sigil:""):exps 
    283     compile (App (Var "&goto") (Just inv) args) = do 
     285    compile (App (Var var) (Just inv) args) | var == cast "&goto" = do 
    284286        cxt     <- askTCxt 
    285287        funC    <- compile inv 
    … …  
    304306        isLogicalLazy _ = False 
    305307    compile exp@(Syn "if" _) = compConditional exp 
    306     compile (Syn "{}" (x:xs)) = compile $ App (Var "&postcircumfix:{}") (Just x) xs 
     308    compile (Syn "{}" (x:xs)) = compile $ App (_Var "&postcircumfix:{}") (Just x) xs 
    307309    compile (Syn "[]" (x:xs)) = do 
    308         compile (App (Var "&postcircumfix:[]") (Just x) xs) 
     310        compile (App (_Var "&postcircumfix:[]") (Just x) xs) 
    309311    compile (Syn "," exps) = do 
    310         compile (App (Var "&infix:,") Nothing exps) 
     312        compile (App (_Var "&infix:,") Nothing exps) 
    311313    -- Minor hack, my $a = [] is parsed as my $a = [Noop], resulting in my $a = 
    312314    -- [undef], which is wrong. 
    313315    compile (Syn "\\[]" [Noop]) = do 
    314         compile (App (Var "&circumfix:[]") Nothing []) 
     316        compile (App (_Var "&circumfix:[]") Nothing []) 
    315317    compile (Syn "\\[]" exps) = do 
    316         compile (App (Var "&circumfix:[]") Nothing exps) 
     318        compile (App (_Var "&circumfix:[]") Nothing exps) 
    317319    compile (Syn name@(sigil:"{}") exps) | (sigil ==) `any` "$@%&" = do 
    318         compile (App (Var $ "&circumfix:" ++ name) Nothing exps) 
     320        compile (App (_Var $ "&circumfix:" ++ name) Nothing exps) 
    319321    compile (Syn "\\{}" exps) = do 
    320         compile (App (Var "&circumfix:{}") Nothing exps) 
     322        compile (App (_Var "&circumfix:{}") Nothing exps) 
    321323    compile (Syn "*" exps) = do 
    322         compile (App (Var "&prefix:*") Nothing exps) 
     324        compile (App (_Var "&prefix:*") Nothing exps) 
    323325    compile (Syn "=" [lhs, rhs]) = do 
    324326        lhsC <- enterLValue $ compile lhs 
    … …  
    330332    compile (Syn syn [lhs, exp]) | last syn == '=' = do 
    331333        let op = "&infix:" ++ init syn 
    332         compile $ Syn "=" [lhs, App (Var op) Nothing [lhs, exp]] 
     334        compile $ Syn "=" [lhs, App (_Var op) Nothing [lhs, exp]] 
    333335    compile (Syn "but" [obj, block]) = 
    334         compile $ App (Var "&Pugs::Internals::but_block") Nothing [obj, block] 
     336        compile $ App (_Var "&Pugs::Internals::but_block") Nothing [obj, block] 
    335337    compile exp@(Syn "namespace" _) = do 
    336338        -- XXX - Is there a better way to wrap Stmts as LValue? 
    … …  
    345347    -- For now, using &Pugs::Internals::named_pair is probably ok. 
    346348    compile (Syn "named" kv@[_, _]) = do 
    347         compile $ App (Var "&Pugs::Internals::named_pair") Nothing kv 
     349        compile $ App (_Var "&Pugs::Internals::named_pair") Nothing kv 
    348350    compile exp = compError exp 
    349351 
    … …  
    353355    condC   <- enter (CxtItem $ mkType "Bool") $ compile cond 
    354356    bodyC   <- enter CxtVoid $ compile body 
    355     funC    <- compile (Var $ "&statement_control:" ++ name) 
     357    funC    <- compile (_Var $ "&statement_control:" ++ name) 
    356358    return . PStmt . PExp $ PApp cxt funC Nothing [pBlock condC, pBlock bodyC] 
    357359compLoop exp = compError exp 
    … …  
    363365compConditional (Syn name exps) = do 
    364366    [condC, trueC, falseC] <- compile exps 
    365     funC    <- compile $ Var ("&statement_control:" ++ name) 
     367    funC    <- compile $ _Var ("&statement_control:" ++ name) 
    366368    cxt     <- askTCxt 
    367369    return $ PApp cxt funC Nothing [condC, PThunk trueC, PThunk falseC] 
    368370compConditional exp = compError exp 
     371 
     372_PVar :: Var -> PIL_LValue 
     373_PVar = PVar . cast 
    369374 
    370375{-| Compiles various 'Exp's to 'PIL_Expr's. -} 
    … …  
    374379    compile (Ann (Cxt cxt) rest) = enter cxt $ compile rest 
    375380    compile (Ann _ rest) = compile rest 
    376     compile (Sym _ "" rest) = compile rest 
    377381    -- XXX: pragmas? 
    378     compile (Var name) = return . PExp $ PVar name 
     382    compile (Var name) = return . PExp $ _PVar name 
    379383    compile exp@(Val (VCode _)) = compile $ Syn "sub" [exp] 
    380384    compile (Val val) = fmap PLit $ compile val 
    … …  
    413417 
    414418-- utility functions 
    415 padSort :: (Var, [(TVar Bool, TVar VRef)]) -> (String, [(a, b)]) -> Ordering 
     419padSort :: (String, [(TVar Bool, TVar VRef)]) -> (String, [(a, b)]) -> Ordering 
    416420padSort (a, [(_, _)]) (b, [(_, _)]) 
    417421    | (head a == ':' && head b == '&') = LT 

  • src/Pugs/Compile/Pugs.hs

    r12204 r12317  
    7070 
    7171 
    72 instance Compile (String, [(TVar Bool, TVar VRef)]) where 
    73     compile ((':':'*':_), _) = return Str.empty -- XXX - :*Bool etc; punt for now 
    74     compile (n, tvars) = do 
    75         tvarsC <- fmap (filter (not . Str.null)) $ mapM compile tvars 
    76         if null tvarsC then return Str.empty else do 
    77         return $ Str.concat [pl, Str.pack (show n), Str.pack ", [", joinMany tvarsC, br, pr] 
     72instance Compile (Var, [(TVar Bool, TVar VRef)]) where 
     73    compile (var, tvars) 
     74        | SType <- v_sigil var, isGlobalVar var = return Str.empty 
     75        | otherwise = do 
     76            tvarsC <- fmap (filter (not . Str.null)) $ mapM compile tvars 
     77            if null tvarsC then return Str.empty else do 
     78            return $ Str.concat [pl, Str.pack (cast var), Str.pack ", [", joinMany tvarsC, br, pr] 
    7879 
    7980instance (Typeable a) => Compile (Maybe (TVar a)) where