From: Mart Lubbers Date: Thu, 2 Sep 2021 12:14:17 +0000 (+0200) Subject: cleanup X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=de3916240660bc4045706b5cfda6a00713d20314;p=clean-tests.git cleanup --- 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