tests again

src/Gyehoek/CPS/Lower.hs

@@ -291,51 +291,3 @@ lower e = fmap Wasm.renderModule . Wasm.execGenMod $ do
   
 lowerProgram :: Program -> Eff es Text
 lowerProgram (MkProgram e) = lower e
-
-antiquote_example =
-  let
-    metavar :: Integer
-    metavar = 123
-
-    e1 :: Wasm.Expr
-    e1 = [expr|
-      (func $blah (result i32)
-        (i32.const #{metavar}))
-    |]
-
-    e2 :: Wasm.Expr
-    e2 = [expr|
-      (func $blah (result i32)
-        (i32.const 123))
-    |]
-  in (metavar,e1,e2,e1==e2)
-
-antiquote_splicing_example =
-  let
-    metavars :: Wasm.Expr
-    metavars = [expr|i32 i64 f64|]
-
-    e1 :: Wasm.Expr
-    e1 = [expr|
-      (func $blah (param ##{metavars}))
-    |]
-
-    e2 :: Wasm.Expr
-    e2 = [expr|
-      (func $blah (param i32 i64 f64))
-    |]
-  in (metavars, e1, e2, e1 == e2)
-
-antiquote_both_example =
-  let
-    m1 = 123 :: Int
-    ms = [expr|i32 i64|]
-
-    e1 = [expr|
-      a (b #{m1} c) d ##{ms} e
-    |]
-
-    e2 = [expr|
-      a (b 123 c) d i32 i64 e
-    |]
-  in (e1,e2,e1==e2)

src/Gyehoek/Sexp.hs

@@ -39,6 +39,7 @@ module Gyehoek.Sexp
   , fromSexp
   , stripLocation
   , format
+  , equivalent
   )
   where
 
@@ -82,6 +83,7 @@ import Control.Applicative (Alternative((<|>)))
 import Debug.Pretty.Simple
 import qualified Data.Vector as V
 import qualified Data.Vector.Strict
+import Data.Function (on)
 
 
 sexp :: SexpIso a => Iso' a Text
@@ -288,6 +290,11 @@ stripLocation = cata \case
   SL.Compose (a SL.:< e) ->
     SL.Fix . SL.Compose $ SL.dummyPos SL.:< e
 
+-- | @('==')@ for 'Sexp's modulo source location — return true if the
+-- two sexps are equal in all but 'Position' fields.
+equivalent :: Sexp -> Sexp -> Bool
+equivalent = (==) `on` stripLocation
+
 instance SexpIso Natural where
   sexpIso = Sexp.integer >>> Sexp.partialOsi f g
     where
@@ -311,27 +318,6 @@ instance SexpIso a => SpliceSexp (List a) where
 instance SpliceSexp Sexp where
   spliceSexp = toListOf each
 
-unquoteSplicing :: List Sexp.Sexp -> Maybe ExpQ
-unquoteSplicing xs
-  | (_:_) <- xs ^.. folded . _UnquoteSplicing
-  = Just [| mconcat $(spans) |]
-  where
-    spans = xs
-      & groupBy \cases
-          (UnquoteSplicing _; Unquote _) _ -> False
-          _ (UnquoteSplicing _; Unquote _) -> False
-          _ _                              -> True
-      & fmap \case
-        [e@(Unquote _)] ->
-          case unquote e of
-            Just x -> [| [$(x)] |]
-            Nothing -> error "unreachable"
-        [UnquoteSplicing x] ->
-          [| stripLocation <$> spliceSexp $(varE (mkName (T.unpack x))) |]
-        x -> [| stripLocation <$> x |]
-      & listE
-unquoteSplicing _ = Nothing
-
 unquoteSplicingRecursive :: List Sexp.Sexp -> ExpQ
 unquoteSplicingRecursive xs = [| mconcat $(spans) |]
   where
@@ -352,15 +338,10 @@ unquoteSplicingRecursive xs = [| mconcat $(spans) |]
 
 unquoteRecursive :: Sexp.Sexp -> ExpQ
 unquoteRecursive = \case
-  Unquote x -> [| stripLocation (toSexp $(varE (mkName (T.unpack x)))) |]
+  Unquote x -> [| toSexp $(varE (mkName (T.unpack x))) |]
   SL.ParenList xs -> [|SL.ParenList $(unquoteSplicingRecursive xs)|]
   e -> liftData e
 
-unquote :: Sexp.Sexp -> Maybe ExpQ
-unquote (Unquote x) =
-  Just [| stripLocation . toSexp $ $(varE (mkName (T.unpack x))) |]
-unquote _ = Nothing
-
 _ParenList :: Prism' Sexp (List Sexp)
 _ParenList = prism' SL.ParenList \case
   SL.ParenList xs -> Just xs