Changeset 14317 for src/Pugs/Eval.hs

Timestamp:

10/17/06 08:24:53 (2 years ago)

Author:

audreyt

svk:copy_cache_prev:

21206

Message:

* Unify "if" and "unless" into the new (Syn "cond") node, which

allows for pointy clauses in conditionals:

if f -> $x {

...

}
elsif g -> $y {

...

}
else -> $z {

...

}

* Bump CompUnit? version; please rm blib6/lib/*.yml before remaking.

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 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
@@ -1483 +1482 @@
         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