Changeset 20058 for src/Pugs

Timestamp:

03/04/08 22:06:31 (7 months ago)

Author:

gbacon

Message:

Build the library, but the executable still doesn't link. Why aren't we building an Executable with cabal?

Location:

src/Pugs

Files:

• AST.hs (modified) (3 diffs)
• AST/Internals.hs (modified) (1 diff)
• AST/Internals/Instances.hs (modified) (1 diff)
• AST/Pad.hs (modified) (1 diff)
• Compile.hs (modified) (1 diff)
• Compile/Pugs.hs (modified) (1 diff)
• Eval.hs (modified) (3 diffs)
• Internals/Cast.hs (modified) (1 diff)
• Internals/ID.hs (modified) (1 diff)
• Monads.hs (modified) (1 diff)
• Parser/Operator.hs (modified) (2 diffs)

src/Pugs/AST.hs

@@ -196 +196 @@
             merge _ old = case old of
                 PEConstant{ pe_proto = MkRef (ICode oldCV) }
-                    | Just mc <- fromTypeable oldCV -> protoEntry
+                    | Just (mc :: VMultiCode) <- fromTypeable oldCV -> protoEntry
                         { pe_proto = MkRef . ICode $ protoCode
                             { mc_assoc      = code_assoc c `mappend` code_assoc mc
@@ -449 +449 @@
 readCodesFromRef :: VRef -> Eval [VCode]
 readCodesFromRef (MkRef (ICode c))
-    | Just mc <- fromTypeable c = do
+    | Just (mc :: VMultiCode) <- fromTypeable c = do
         let names@(pivot:_) = Set.elems (mc_variants mc)
         rvs <- fmap concat . forM names $ \var -> do
@@ -460 +460 @@
                 rvsGlobal <- readCodesFromRef =<< fromVal cvGlobal
                 return (rvsGlobal ++ rvs)
-    | Just cv <- fromTypeable c = return [cv]
+    | Just (cv :: VCode) <- fromTypeable c = return [cv]
 readCodesFromRef ref = do
     code <- fromVal =<< readRef ref

src/Pugs/AST/Internals.hs

@@ -2086 +2086 @@
 instance YAML VRef where
     asYAML (MkRef (ICode cv))
-        | Just mc <- fromTypeable cv = do
+        | Just (mc :: VMultiCode) <- fromTypeable cv = do
             mcC <- asYAML (mc :: VMultiCode)
             return $ mkTagNode (tagHs "VMultiCode") $ ESeq [mcC]

src/Pugs/AST/Internals/Instances.hs

@@ -115 +115 @@
 instance YAML VRef where
     asYAML (MkRef (ICode cv))
-        | Just mc <- fromTypeable cv = do
+        | Just (mc :: VMultiCode) <- fromTypeable cv = do
             mcC <- asYAML (mc :: VMultiCode)
             return $ mkTagNode (tagHs "VMultiCode") $ ESeq [mcC]

src/Pugs/AST/Pad.hs

@@ -80 +80 @@
     PEConstant{ pe_proto = MkRef (ICode newCV), pe_flags = flags }
     PEConstant{ pe_proto = MkRef (ICode oldCV) }
-    | Just newMC <- fromTypeable newCV
-    , Just oldMC <- fromTypeable oldCV
+    | Just (newMC :: VMultiCode) <- fromTypeable newCV
+    , Just (oldMC :: VMultiCode) <- fromTypeable oldCV
     = PEConstant
         { pe_type  = mc_type newMC -- XXX - Select a narrower type?

src/Pugs/Compile.hs

@@ -74 +74 @@
         where
         entries = sortBy padSort [ (cast var, readPadEntry ref) | (var, ref) <- padToList pad ]
-        canCompile (name@('&':_), sym) = do
-            ref <- sym
+        canCompile (name@('&':_) :: String, sym) = do
+            (ref :: VRef) <- sym
             case ref of
                 MkRef ICode{} -> do

src/Pugs/Compile/Pugs.hs

@@ -21 +21 @@
 
 joinMany :: [Str] -> Str
-joinMany xs = Str.join cm (filter (not . Str.null) xs)
+joinMany xs = Str.intercalate cm (filter (not . Str.null) xs)
 
 instance (Compile x) => Compile [x] where

src/Pugs/Eval.hs

@@ -185 +185 @@
 evalRef ref = do
     if refType ref == (mkType "Thunk") then forceRef ref else do
-    val <- catchT $ \esc -> do
+    val <- catchT $ \(esc :: Val -> Eval ()) -> do
         MkEnv{ envContext = cxt, envLValue = lv } <- ask
         let typ = typeOfCxt cxt
@@ -281 +281 @@
             Nothing
                 | SType <- sig      -> return . VType . cast $ if isQualifiedVar var
-                    then cast $ Buf.join (__"::") [cast pkg, cast name]
+                    then cast $ Buf.intercalate (__"::") [cast pkg, cast name]
                     else name
                 | isGlobalVar var || pkg `notElem` [emptyPkg, callerPkg, outerPkg, contextPkg] -> do
@@ -1484 +1484 @@
                     --- not scalarRef! -- use the new "transparent IType" thing!
                     case showType (typeOfSigilVar var) of
-                        "Hash"  -> ($ v) . fix $ \redo x -> case x of
+                        "Hash"  -> ($ v) . fix $ \(redo :: Val -> Eval Val) x -> case x of
                             VRef (MkRef (IHash h)) -> return (VRef $ hashRef h) 
                             VRef ref@(MkRef IScalar{}) -> redo =<< readRef ref
                             _ -> fmap (VRef . hashRef) (fromVal v :: Eval VHash)
-                        "Array" -> ($ v) . fix $ \redo x -> case x of
+                        "Array" -> ($ v) . fix $ \(redo :: Val -> Eval Val) x -> case x of
                             VRef (MkRef (IArray a)) -> return (VRef $ arrayRef a) 
                             VRef ref@(MkRef IScalar{}) -> redo =<< readRef ref

src/Pugs/Internals/Cast.hs

@@ -82 +82 @@
     castBack = UTF8.pack
 
+instance ((:<:) ByteString) String where
+    castBack = UTF8.unpack
+
 #endif

src/Pugs/Internals/ID.hs

@@ -89 +89 @@
     cast = cast . idBuf
 
+instance ((:<:) String) ID where
+    castBack = cast
+
 instance ((:<:) ID) ByteString where
     castBack = idBuf

src/Pugs/Monads.hs

@@ -252 +252 @@
 recloseRef :: VRef -> STM VRef
 recloseRef (MkRef (ICode cv))
-    | Just vcode <- fromTypeable cv = do
+    | Just (vcode :: VCode) <- fromTypeable cv = do
         vcode'   <- recloseCode vcode
         return . MkRef . ICode $ vcode'

src/Pugs/Parser/Operator.hs

@@ -27 +27 @@
 
 newtype OpName = MkOpName ID
-    deriving (Show, Eq, Typeable, (:>:) String, (:>:) ByteString, (:<:) ByteString, (:>:) ID)
+    deriving (Show, Eq, Typeable, (:>:) String, (:>:) ByteString, (:<:) ByteString, (:>:) ID, (:<:) String, (:<:) ID)
 
 instance Ord OpName where
     compare (MkOpName MkID{ idKey = a, idBuf = x }) (MkOpName MkID{ idKey = b, idBuf = y })
         = compare (Buf.length y) (Buf.length x) `mappend` compare b a
+
+instance ((:<:) OpName) ByteString where
+    castBack (MkOpName id) = castBack id
 
 -- Not yet transcribed into a full optable parser with dynamic precedence
@@ -650 +653 @@
             notFollowedBy (char '(' <|> (char ':' >> char ':'))
             possiblyApplyMacro $ App (Var var) Nothing []
-        parseOneTerm (name, categ) = do
+        parseOneTerm (name :: OpName, categ) = do
             symbol (cast name)
             return MkVar