From de3916240660bc4045706b5cfda6a00713d20314 Mon Sep 17 00:00:00 2001
From: Mart Lubbers <mart@martlubbers.net>
Date: Thu, 2 Sep 2021 14:14:17 +0200
Subject: [PATCH] cleanup

---
 datatype/Compiler.hs  | 36 +++++++++++++----------------------
 datatype/Language.hs  | 14 ++++++++++++--
 datatype/Printer.hs   |  4 ++--
 datatype/Serialise.hs | 44 -------------------------------------------
 datatype/clean.bash   |  3 +++
 5 files changed, 30 insertions(+), 71 deletions(-)
 delete mode 100644 datatype/Serialise.hs
 create mode 100644 datatype/clean.bash

diff --git a/datatype/Compiler.hs b/datatype/Compiler.hs
index 79ee6b7..152621b 100644
--- a/datatype/Compiler.hs
+++ b/datatype/Compiler.hs
@@ -6,13 +6,11 @@
 module Compiler where
 
 import Language
-import Serialise
---
+
 import qualified Data.Map as DM
-import Control.Monad.Writer
-import Control.Monad.State
 import Control.Monad.ST
---import Debug.Trace
+import Control.Monad.State
+import Control.Monad.Writer
 import Data.Array
 import Data.Array.ST
 import Data.Function
@@ -191,20 +189,20 @@ interpret memsize prog = runSTArray resultStack ! (memsize-1)
             Mul -> bop (*) memory reg >>= int program memory
             Div -> bop div memory reg >>= int program memory
             Neg -> uop negate memory reg >>= int program memory
-            And -> bop ((b2i .) . on (&&) i2b) memory reg >>= int program memory
-            Or  -> bop ((b2i .) . on (||) i2b) memory reg >>= int program memory
-            Not -> uop (b2i . Prelude.not . i2b) memory reg >>= int program memory
-            Eq  -> bop ((b2i .) . (==)) memory reg >>= int program memory
-            Neq -> bop ((b2i .) . (/=)) memory reg >>= int program memory
-            Le  -> bop ((b2i .) . (<)) memory reg >>= int program memory
-            Ge  -> bop ((b2i .) . (>)) memory reg >>= int program memory
-            Leq -> bop ((b2i .) . (<=)) memory reg >>= int program memory
-            Geq -> bop ((b2i .) . (>=)) memory reg >>= int program memory
+            And -> bop ((fromEnum .) . on (&&) toEnum) memory reg >>= int program memory
+            Or  -> bop ((fromEnum .) . on (||) toEnum) memory reg >>= int program memory
+            Not -> uop (fromEnum . Prelude.not . toEnum) memory reg >>= int program memory
+            Eq  -> bop ((fromEnum .) . (==)) memory reg >>= int program memory
+            Neq -> bop ((fromEnum .) . (/=)) memory reg >>= int program memory
+            Le  -> bop ((fromEnum .) . (<)) memory reg >>= int program memory
+            Ge  -> bop ((fromEnum .) . (>)) memory reg >>= int program memory
+            Leq -> bop ((fromEnum .) . (<=)) memory reg >>= int program memory
+            Geq -> bop ((fromEnum .) . (>=)) memory reg >>= int program memory
             Lbl _ -> int program memory reg
             Bra l -> branch l program reg >>= int program memory
             Brf l -> do
                 (reg', v) <- pop memory reg
-                reg'' <- if i2b v then pure reg' else branch l program reg'
+                reg'' <- if toEnum v then pure reg' else branch l program reg'
                 int program memory reg''
             Sth n ->
                     popn memory n reg
@@ -233,11 +231,3 @@ interpret memsize prog = runSTArray resultStack ! (memsize-1)
         _ -> readArray program (pc reg) >>= \case
             Lbl l | label == l -> pure $ reg
             _ -> branch label program $ reg { pc = pc reg - 1 }
-
-b2i :: Bool -> Int
-b2i True = 1
-b2i False = 0
-
-i2b :: Int -> Bool
-i2b 0 = False
-i2b _ = True
diff --git a/datatype/Language.hs b/datatype/Language.hs
index 1f0aab2..bc7c73f 100644
--- a/datatype/Language.hs
+++ b/datatype/Language.hs
@@ -2,7 +2,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 module Language where
 
-import Serialise
+import Data.Char
 
 newtype Main a = Main {unmain :: a}
 data In a b = a :- b
@@ -20,7 +20,7 @@ class Expression v where
     lit :: (Serialise a, Show a) => a -> v a
     (+.) :: Num a => v a -> v a -> v a
     (-.) :: Num a => v a -> v a -> v a
-    (/.) :: Fractional a => v a -> v a -> v a
+    (/.) :: Num a => v a -> v a -> v a
     (*.) :: Num a => v a -> v a -> v a
     neg :: Num a => v a -> v a
     (&.) :: v Bool -> v Bool -> v Bool
@@ -43,3 +43,13 @@ infixr 3 &.
 infix 4 ==., /=., <., >., <=., >=.
 infixl 6 +., -.
 infixl 7 *., /.
+
+class Serialise a where
+    serialise :: a -> Int
+
+instance Serialise Int where
+    serialise i = i
+instance Serialise Bool where
+    serialise = fromEnum
+instance Serialise Char where
+    serialise = ord
diff --git a/datatype/Printer.hs b/datatype/Printer.hs
index f200b15..9e25c5b 100644
--- a/datatype/Printer.hs
+++ b/datatype/Printer.hs
@@ -152,11 +152,11 @@ printBinOp thisctx op l r = paren' thisctx $
 
 printUnOp :: Ctx -> String -> Printer a -> Printer a
 printUnOp thisctx op l = paren' thisctx $
-       printLit (' ':op)
+        printLit (' ':op)
     >-> localctx (setBranch thisctx CtxRight) l
 
 printCons :: String -> Printer a -> Printer a
 printCons cons l = paren' CtxNonfix $ printLit cons >-> l
 
 printRec :: String -> Printer a -> Printer a
-printRec op l = printUnOp CtxNo op (accol l)-- (op++" ") (accol l)
+printRec op l = printUnOp CtxNo op $ accol l
diff --git a/datatype/Serialise.hs b/datatype/Serialise.hs
deleted file mode 100644
index effa82d..0000000
--- a/datatype/Serialise.hs
+++ /dev/null
@@ -1,44 +0,0 @@
-{-# LANGUAGE DefaultSignatures, FlexibleContexts, TypeOperators #-}
-module Serialise where
-
-import Data.Char
-
-import GHC.Generics
-
-class Serialise a where
-    serialise :: a -> Int
-
---class serialise a where
---    serialise :: a -> int -> [int] -> [int]
---    default serialise :: (generic a, gserialise (rep a)) => a -> int -> [int] -> [int]
---    serialise = gserialise . from
---
---class GSerialise f where
---    gserialise :: f a -> Int -> [Int] -> [Int]
---
-----Void
---instance GSerialise V1 where
---    gserialise _ _ = id
-----Unit
---instance GSerialise U1 where
---    gserialise _ _ = id
-----Pair
---instance (GSerialise a, GSerialise b) => GSerialise (a :*: b) where
---    gserialise (l :*: r) _ = gserialise l 0 . gserialise r 0
-----Constants, additional parameters and recursion of kind *
---instance Serialise a => GSerialise (K1 i a) where
---    gserialise (K1 a) i = serialise a i
-----Either not supported because we don't support sumtypes in our stack machine
---instance (GSerialise a, GSerialise b) => GSerialise (a :+: b) where
---    gserialise (L1 l) c = gserialise l (c * 2)
---    gserialise (R1 r) c = gserialise r (c + 1)
-----Datatype, Constructor or Selector
---instance (GSerialise a) => GSerialise (M1 i c a) where
---    gserialise (M1 l) c = (c:) . gserialise l 0
-
-instance Serialise Int where
-    serialise i = i
-instance Serialise Bool where
-    serialise b = if b then 1 else 0
-instance Serialise Char where
-    serialise c = ord c
diff --git a/datatype/clean.bash b/datatype/clean.bash
new file mode 100644
index 0000000..58b9019
--- /dev/null
+++ b/datatype/clean.bash
@@ -0,0 +1,3 @@
+#!/bin/bash
+shopt -s globstar
+rm -rf **/*.{,dyn_}{hi,o} Main
-- 
2.20.1