From b03f51f3a363f861f9d5de30ec6a337fec316383 Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom@tomsmeding.com>
Date: Fri, 21 May 2021 09:16:00 +0200
Subject: Initial

---
 Main.hs | 48 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 48 insertions(+)
 create mode 100644 Main.hs

(limited to 'Main.hs')

diff --git a/Main.hs b/Main.hs
new file mode 100644
index 0000000..d52fedc
--- /dev/null
+++ b/Main.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE LambdaCase #-}
+module Main where
+
+import Data.Text.Lazy (Text)
+import qualified Data.Text.Lazy as T
+import qualified Data.Text.Lazy.IO as T
+import System.Environment
+import System.Exit
+
+import Pattern
+import Parser
+import Pretty
+import SourceFile
+
+
+apply :: Pattern -> SourceFile -> SourceFile
+apply pat (SourceFile chunks) =
+    SourceFile $ flip map chunks $ \case CSkip s -> CSkip s
+                                         COcc occ -> COcc (apply' pat occ)
+
+apply' :: Pattern -> Occurrence -> Occurrence
+apply' (Pattern name items) origocc@(Occurrence name' args)
+  | name == name' = Occurrence name' (travOrigsArgs items args)
+  | otherwise = origocc
+
+travOrigsArgs :: [Origin] -> [(Text, Text)] -> [(Text, Text)]
+travOrigsArgs [] args = args
+travOrigsArgs _ [] = []
+travOrigsArgs (OCopy : items) (arg:args) = arg : travOrigsArgs items args
+travOrigsArgs (ONew name : items) args = (T.pack " ", name) : travOrigsArgs items args
+
+main :: IO ()
+main = do
+    getArgs >>= \case
+        [fname, pat] -> do
+            pat' <- case parsePattern pat of
+              Left err -> die err
+              Right pat' -> return pat'
+            source <- readFile fname
+            parsed <- case parseSourceFile fname source pat' of
+              Left err -> die (show err)
+              Right res -> return res
+            print parsed
+            T.putStrLn (pretty parsed)
+            putStrLn (replicate 80 '-')
+            T.putStrLn (pretty (apply pat' parsed))
+        _ -> do
+            die "Usage: refactor-type-parameters <file.hs> <OpenAcc env aenv *taenv t>"
-- 
cgit v1.2.3-70-g09d2