From 260a92f46c69e997e693f44fc543aa789f3eacd5 Mon Sep 17 00:00:00 2001
From: Chris Done <chrisdone@gmail.com>
Date: Thu, 21 Nov 2019 10:18:49 +0000
Subject: [PATCH] Fix seq on global names

---
 src/Duet/Stepper.hs |  2 +-
 test/Spec.hs        | 41 ++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 41 insertions(+), 2 deletions(-)

diff --git a/src/Duet/Stepper.hs b/src/Duet/Stepper.hs
index 53312f2..4477913 100644
--- a/src/Duet/Stepper.hs
+++ b/src/Duet/Stepper.hs
@@ -272,7 +272,7 @@ match = go [0]
 isWhnf :: Expression Type i l -> Bool
 isWhnf =
   \case
-    VariableExpression {} -> True
+    VariableExpression {} -> False
     ConstructorExpression {} -> True
     ConstantExpression {} -> True
     LiteralExpression {} -> True
diff --git a/test/Spec.hs b/test/Spec.hs
index 04df751..1d23e44 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -76,4 +76,43 @@ spec =
                           }))
                     (LiteralExpression () (IntegerLiteral 1))
                 , LiteralExpression () (IntegerLiteral 1)
-                ])))
+                ]))
+        it
+          "Seq"
+          (shouldBe
+             (second
+                last
+                (first
+                   (const ())
+                   (runNoLoggingT
+                      ((evalSupplyT
+                          (do decls <-
+                                parseText
+                                  "test"
+                                  "seq =\n\
+                                 \  \\x y ->\n\
+                                 \    case x of\n\
+                                 \      !_ -> y\n\
+                                 \loop = loop\n\
+                                 \main = seq loop 1"
+                              (binds, ctx) <- createContext decls
+                              things <-
+                                execWriterT
+                                  (runStepper
+                                     100
+                                     ctx
+                                     (fmap (fmap typeSignatureA) binds)
+                                     "main")
+                              pure things)
+                          [1 ..])))))
+             (Right
+                ((CaseExpression
+                    ()
+                    (VariableExpression () (ValueName 42 "loop"))
+                    [ CaseAlt
+                        { caseAltLabel = ()
+                        , caseAltPattern = BangPattern (WildcardPattern () "_")
+                        , caseAltExpression =
+                            LiteralExpression () (IntegerLiteral 1)
+                        }
+                    ])))))