Changeset 8677 for src/Pugs/Compile.hs

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

* PIL/JS compilation now works with exported multisubs.

Files:
1 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