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
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
_ -> 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
{-# LANGUAGE FlexibleContexts #-}
module Language where
-import Serialise
+import Data.Char
newtype Main a = Main {unmain :: a}
data In a b = a :- b
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
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
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
+++ /dev/null
-{-# 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
--- /dev/null
+#!/bin/bash
+shopt -s globstar
+rm -rf **/*.{,dyn_}{hi,o} Main