Changeset 12317 for src/Pugs/Compile.hs

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).
Files:
1 modified

Legend:

Unmodified
Added
Removed

  • src/Pugs/Compile.hs

    r10842 r12317  
    7373        return $ concat entries' 
    7474        where 
    75         entries = sortBy padSort $ padToList pad 
     75        entries = sortBy padSort [ (cast var, ref) | (var, ref) <- padToList pad ] 
    7676        canCompile (name@('&':_), xs) | length xs > 1 = do 
    7777            fmap concat $ mapM (\x -> canCompile (name, [x])) xs 
    … …  
    136136        rv <- readRef =<< liftSTM (readTVar ref) 
    137137        case rv of 
    138             VCode sub   -> return $ PRawName (subName sub) 
     138            VCode sub   -> return $ PRawName (cast $ subName sub) 
    139139            _           -> return $ PRawName name 
    140140    compile (name, _) = return $ PRawName name 
    … …  
    146146    compile (Ann (Cxt cxt) rest) = enter cxt $ compile rest 
    147147    compile (Ann _ rest) = compile rest 
    148     compile (Sym _ "" rest) = compile rest 
    149148    compile (Stmts (Pad SOur _ exp) rest) = do 
    150149        compile $ mergeStmts exp rest 
    151150    compile (Stmts (Pad scope pad exp) rest) = do 
    152         padC    <- compile $ padToList pad 
    153         let symC = (map fst $ padToList pad) `zip` padC 
    154             exps = [ Syn ":=" [Var name, Var from] | (name, PRawName from) <- symC, name /= from ] 
     151        padC    <- compile [ (cast var :: String, ref) | (var, ref) <- padToList pad ] 
     152        let symC = (map (cast . fst) $ padToList pad) `zip` padC 
     153            exps = [ Syn ":=" [_Var name, _Var from] 
     154                   | (name, PRawName from) <- symC 
     155                   , name /= from 
     156                   ] 
    155157        expC    <- compile $ mergeStmts (foldl1 mergeStmts (exps ++ [exp])) rest 
    156158        return $ PPad scope symC expC 
    … …  
    179181        thisC   <- enter cxtVoid $ compile this 
    180182        declC   <- enter cxtVoid $ compile decl 
    181         restC   <- enterPackage pkg $ compileStmts rest 
     183        restC   <- enterPackage (cast pkg) $ compileStmts rest 
    182184        return $ PStmts thisC $ PStmts declC restC 
    183185        where 
    184186          -- XXX - kludge. 
    185           decl = App (Var func) Nothing [(Val (VStr pkg))] 
     187          decl = App (_Var func) Nothing [(Val (VStr pkg))] 
    186188          func = "&" ++ (capitalize sym) ++ "::_create" 
    187189          capitalize []     = [] 
    … …  
    207209    compile (Ann Prag{} rest) = compile rest -- fmap (PPos pos rest) $ compile rest 
    208210    compile (Ann _ rest) = compile rest 
    209     compile (Sym _ "" rest) = compile rest 
    210211    compile Noop = return PNoop 
    211212    compile (Val val) = do 
    … …  
    231232        bodyC   <- compile body 
    232233        postC   <- compile post 
    233         funC    <- compile (Var "&statement_control:loop") 
     234        funC    <- compile (_Var "&statement_control:loop") 
    234235        return . PStmt . PExp $ PApp TCxtVoid funC Nothing 
    235236            [preC, pBlock condC, pBlock bodyC, pBlock postC] 
    … …  
    242243        expC    <- compile exp 
    243244        bodyC   <- compile body 
    244         funC    <- compile (Var "&statement_control:for") 
     245        funC    <- compile (_Var "&statement_control:for") 
    245246        return . PStmt . PExp $ PApp TCxtVoid funC Nothing [expC, bodyC] 
    246     compile (Syn "given" _) = compile (Var "$_") -- XXX 
    247     compile (Syn "when" _) = compile (Var "$_") -- XXX 
     247    compile (Syn "given" _) = compile (_Var "$_") -- XXX 
     248    compile (Syn "when" _) = compile (_Var "$_") -- XXX 
    248249    compile exp = fmap PStmt $ compile exp 
    249250 
    … …  
    284285    compile (Ann (Cxt cxt) rest) = enter cxt $ compile rest 
    285286    compile (Ann _ rest) = compile rest 
    286     compile (Sym _ "" rest) = compile rest 
    287287    -- XXX: pragmas? 
    288     compile (Var name) = return $ PVar name 
     288    compile (Var name) = return $ _PVar name 
    289289    compile (Syn (sigil:"::()") exps) = do 
    290         compile $ App (Var "&Pugs::Internals::symbolic_deref") Nothing $ 
     290        compile $ App (_Var "&Pugs::Internals::symbolic_deref") Nothing $ 
    291291            (Val . VStr $ sigil:""):exps 
    292     compile (App (Var "&goto") (Just inv) args) = do 
     292    compile (App (Var var) (Just inv) args) | var == cast "&goto" = do 
    293293        cxt     <- askTCxt 
    294294        funC    <- compile inv 
    … …  
    313313        isLogicalLazy _ = False 
    314314    compile exp@(Syn "if" _) = compConditional exp 
    315     compile (Syn "{}" (x:xs)) = compile $ App (Var "&postcircumfix:{}") (Just x) xs 
     315    compile (Syn "{}" (x:xs)) = compile $ App (_Var "&postcircumfix:{}") (Just x) xs 
    316316    compile (Syn "[]" (x:xs)) = do 
    317         compile (App (Var "&postcircumfix:[]") (Just x) xs) 
     317        compile (App (_Var "&postcircumfix:[]") (Just x) xs) 
    318318    compile (Syn "," exps) = do 
    319         compile (App (Var "&infix:,") Nothing exps) 
     319        compile (App (_Var "&infix:,") Nothing exps) 
    320320    -- Minor hack, my $a = [] is parsed as my $a = [Noop], resulting in my $a = 
    321321    -- [undef], which is wrong. 
    322322    compile (Syn "\\[]" [Noop]) = do 
    323         compile (App (Var "&circumfix:[]") Nothing []) 
     323        compile (App (_Var "&circumfix:[]") Nothing []) 
    324324    compile (Syn "\\[]" exps) = do 
    325         compile (App (Var "&circumfix:[]") Nothing exps) 
     325        compile (App (_Var "&circumfix:[]") Nothing exps) 
    326326    compile (Syn name@(sigil:"{}") exps) | (sigil ==) `any` "$@%&" = do 
    327         compile (App (Var $ "&circumfix:" ++ name) Nothing exps) 
     327        compile (App (_Var $ "&circumfix:" ++ name) Nothing exps) 
    328328    compile (Syn "\\{}" exps) = do 
    329         compile (App (Var "&circumfix:{}") Nothing exps) 
     329        compile (App (_Var "&circumfix:{}") Nothing exps) 
    330330    compile (Syn "*" exps) = do 
    331         compile (App (Var "&prefix:*") Nothing exps) 
     331        compile (App (_Var "&prefix:*") Nothing exps) 
    332332    compile (Syn "=" [lhs, rhs]) = do 
    333333        lhsC <- enterLValue $ compile lhs 
    … …  
    339339    compile (Syn syn [lhs, exp]) | last syn == '=' = do 
    340340        let op = "&infix:" ++ init syn 
    341         compile $ Syn "=" [lhs, App (Var op) Nothing [lhs, exp]] 
     341        compile $ Syn "=" [lhs, App (_Var op) Nothing [lhs, exp]] 
    342342    compile (Syn "but" [obj, block]) = 
    343         compile $ App (Var "&Pugs::Internals::but_block") Nothing [obj, block] 
     343        compile $ App (_Var "&Pugs::Internals::but_block") Nothing [obj, block] 
    344344    compile exp@(Syn "namespace" _) = do 
    345345        -- XXX - Is there a better way to wrap Stmts as LValue? 
    … …  
    354354    -- For now, using &Pugs::Internals::named_pair is probably ok. 
    355355    compile (Syn "named" kv@[_, _]) = do 
    356         compile $ App (Var "&Pugs::Internals::named_pair") Nothing kv 
     356        compile $ App (_Var "&Pugs::Internals::named_pair") Nothing kv 
    357357    compile exp = compError exp 
    358358 
    … …  
    362362    condC   <- enter (CxtItem $ mkType "Bool") $ compile cond 
    363363    bodyC   <- enter CxtVoid $ compile body 
    364     funC    <- compile (Var $ "&statement_control:" ++ name) 
     364    funC    <- compile (_Var $ "&statement_control:" ++ name) 
    365365    return . PStmt . PExp $ PApp cxt funC Nothing [pBlock condC, pBlock bodyC] 
    366366compLoop exp = compError exp 
    … …  
    372372compConditional (Syn name exps) = do 
    373373    [condC, trueC, falseC] <- compile exps 
    374     funC    <- compile $ Var ("&statement_control:" ++ name) 
     374    funC    <- compile $ _Var ("&statement_control:" ++ name) 
    375375    cxt     <- askTCxt 
    376376    return $ PApp cxt funC Nothing [condC, PThunk trueC, PThunk falseC] 
    377377compConditional exp = compError exp 
     378 
     379_PVar :: Var -> PIL_LValue 
     380_PVar = PVar . cast 
    378381 
    379382{-| Compiles various 'Exp's to 'PIL_Expr's. -} 
    … …  
    383386    compile (Ann (Cxt cxt) rest) = enter cxt $ compile rest 
    384387    compile (Ann _ rest) = compile rest 
    385     compile (Sym _ "" rest) = compile rest 
    386388    -- XXX: pragmas? 
    387     compile (Var name) = return . PExp $ PVar name 
     389    compile (Var name) = return . PExp $ _PVar name 
    388390    compile exp@(Val (VCode _)) = compile $ Syn "sub" [exp] 
    389391    compile (Val val) = fmap PLit $ compile val 
    … …  
    422424 
    423425-- utility functions 
    424 padSort :: (Var, [(TVar Bool, TVar VRef)]) -> (String, [(a, b)]) -> Ordering 
     426padSort :: (String, [(TVar Bool, TVar VRef)]) -> (String, [(a, b)]) -> Ordering 
    425427padSort (a, [(_, _)]) (b, [(_, _)]) 
    426428    | (head a == ':' && head b == '&') = LT