Changeset 14337 for src/Pugs/Eval.hs

Timestamp:

10/17/06 08:25:35 (2 years ago)

Author:

audreyt

svk:copy_cache_prev:

21206

Message:

* Remove Judy from the Pugs build process.

This is a pervasive change to avoid GC issues completely
before the release, as the nature of addForeignPtrFinalizer's
weird interaction with GHC is not fully diagnosed.

Also, TVar/IORef based storage, which was exceedingly slow
in GHC 6.4, now actually compares competitively with Judy maps.
Judy is still more memory efficient and may be faster on some
architectures, but its re-incoporation will have to wait until
after release and a fuller understanding of its use of FFI/GC.

Files:

• src/Pugs/Eval.hs (modified) (2 diffs)

src/Pugs/Eval.hs

@@ -456 +456 @@
     evalExp $ App (_Var "&Pugs::Internals::but_block") Nothing [obj, block]
 
-reduceSyn "if" [cond, bodyIf, bodyElse] = do
-    vbool     <- enterRValue $ enterEvalContext (cxtItem "Bool") cond
-    vb        <- fromVal vbool
-    reduce $ if vb then bodyIf else bodyElse
-
-reduceSyn "cond" [cond, bodyIf, bodyElse] = do
-    topic <- enterRValue $ enterEvalContext (cxtItem "Bool") cond
-    vb    <- fromVal topic
-    sub   <- fromCodeExp $ if vb then bodyIf else bodyElse
-    apply sub Nothing [App (_Var "&VAR") (Just (Val topic)) []]
+reduceSyn name [cond, bodyIf, bodyElse]
+    | "if"     <- name = doCond id
+    | "unless" <- name = doCond not
+    where
+    doCond :: (Bool -> Bool) -> Eval Val
+    doCond f = do
+        vbool     <- enterRValue $ enterEvalContext (cxtItem "Bool") cond
+        vb        <- fromVal vbool
+        if (f vb)
+            then reduce bodyIf
+            else reduce bodyElse
 
 reduceSyn "for" [list, body] = enterLoop $ do
@@ -1482 +1483 @@
         return $ mkCode
             { subEnv        = Just env
-            , subType       = SubPrim   -- This is a pseudoblock with no scope
+            , subType       = SubBlock
             , subParams     = [defaultScalarParam]
             , subBody       = x
             }
-    Noop                        -> fromCodeExp (Syn "block" [Noop])
     _                           -> fromClosure x
     where