Changeset 8677

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

* PIL/JS compilation now works with exported multisubs.

Location:
src/Pugs
Files:
2 modified

Legend:

Unmodified
Added
Removed

  • src/Pugs/Compile.hs

    r8153 r8677  
    121121 
    122122instance Compile (SubName, VCode) [PIL_Decl] where 
     123{- 
    123124    compile (name, vsub) | packageOf name /= packageOf (subName vsub) = do 
    124125        let storeC  = PBind [PVar $ qualify name] (PExp . PVar . qualify $ subName vsub) 
    … …  
    126127            exportL = "__export_" ++ (render $ varText name) 
    127128        return [PSub exportL SubPrim [] False False bodyC] 
     129-} 
    128130    compile (name, vsub) = do 
    129131        bodyC   <- enter cxtItemAny . compile $ case subBody vsub of 
    … …  
    134136 
    135137instance Compile (String, [(TVar Bool, TVar VRef)]) PIL_Expr where 
     138    compile (name, ((_, ref):_)) = do 
     139        rv <- readRef =<< liftSTM (readTVar ref) 
     140        case rv of 
     141            VCode sub   -> return $ PRawName (subName sub) 
     142            _           -> return $ PRawName name 
    136143    compile (name, _) = return $ PRawName name 
    137144 
    … …  
    143150        compile $ mergeStmts exp rest 
    144151    compile (Stmts (Pad scope pad exp) rest) = do 
    145         expC    <- compile $ mergeStmts exp rest 
    146152        padC    <- compile $ padToList pad 
    147         return $ PPad scope ((map fst $ padToList pad) `zip` padC) expC 
     153        let symC = (map fst $ padToList pad) `zip` padC 
     154            exps = [ Syn ":=" [Var name, Var from] | (name, PRawName from) <- symC ] 
     155        expC    <- compile $ mergeStmts (foldl1 mergeStmts (exps ++ [exp])) rest 
     156        return $ PPad scope symC expC 
    148157    compile exp = compileStmts exp 
    149158 

  • src/Pugs/Parser/Export.hs

    r8670 r8677  
    2121    let newPkg = envPackage env 
    2222    exps <- forM subs $ \(VCode sub) -> do 
    23         let qName = '&':newPkg ++ "::" ++ subname 
    24         let mkMulti = if isMulti sub then ('&':) else id 
    25         let mkExp = Syn ":=" [Var ('&':subname), Syn "sub" [Val $ VCode sub]] 
    26         let mkSym = Sym scope (mkMulti ('&':subname)) mkExp 
     23        let name = ('&':subname) 
     24            mkMulti = if isMulti sub then ('&':) else id 
     25            mkExp = Syn ":=" [Var name, Syn "sub" [Val $ VCode sub]] 
     26            mkSym = Sym scope (mkMulti name) mkExp 
    2727        doExport scope mkSym 
    2828    return $ case scope of