Changeset 14489 for src/Pugs/Eval.hs

Timestamp:

10/24/06 17:19:16 (2 years ago)

Author:

audreyt

Message:

* Restore support for:

if EXPR -> $x {

...

}
elsif EXPR -> $x {

...

}
else -> $x {

...

}

Files:

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

src/Pugs/Eval.hs

@@ -463 +463 @@
     evalExp $ App (_Var "&Pugs::Internals::but_block") Nothing [obj, block]
 
-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 "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 "for" [list, body] = enterLoop $ do
@@ -1496 +1495 @@
         return $ mkCode
             { subEnv        = Just env
-            , subType       = SubBlock
+            , subType       = SubPrim   -- This is a pseudoblock with no scope
             , subParams     = [defaultScalarParam]
             , subBody       = x
             }
+    Noop                        -> fromCodeExp (Syn "block" [Noop])
     _                           -> fromClosure x
     where