Skip to content
Snippets Groups Projects
Commit b43674ce authored by Hugo Hörnquist's avatar Hugo Hörnquist
Browse files

Fix serializer, + compilation.

parent cae6987a
No related branches found
No related tags found
No related merge requests found
{-# Language ImportQualifiedPost #-}
module Eval where module Eval where
import Data.Map.Strict qualified as Map import Data.Map.Strict qualified as Map
......
module Serialize where module Serialize where
import Data.Char (ord, chr)
import Expression import Expression
serialize :: Expression -> String encodeNumber :: Integer -> String
serialize (Number x) = encodeNumber x = [chr(fromInteger a + 33) | a <- [mod (div x (94^b)) 94 | b<-[y,y-1..0]]]
chr . (+ 33) . fromInteger <$> where y = floor $ logBase 94.0 (fromInteger x)
[(x `div` 94^b) `mod` 94
| b <- [digits, digits-1 .. 0]]
where digits = floor $ logBase 94 (fromInteger x)
serialize (Number x) = 'I':encodeNumber x
serialize (Str x) = 'S':fmap (chr . (+ 33) . ord) x
serialize (Boolean True) = "T"
serialize (Boolean False) = "F"
serialize (Variable x) = 'V':(fmap (chr . (+ 33) . ord) $ encodeNumber x)
serialize (Lambda x y) = "L" ++ fmap (chr . (+ 33) . ord) (encodeNumber x) ++ " " ++ serialize y
serialize (Negate x) = "U- " ++ serialize x
serialize (Not x) = "U! " ++ serialize x
serialize (StringToInt x) = "U# " ++ serialize x
serialize (IntToString x) = "U$ " ++ serialize x
serialize (Add x y) = "B+ " ++ serialize x ++ " " ++ serialize y
serialize (Sub x y) = "B- " ++ serialize x ++ " " ++ serialize y
serialize (Mul x y) = "B* " ++ serialize x ++ " " ++ serialize y
serialize (Div x y) = "B/ " ++ serialize x ++ " " ++ serialize y
serialize (Mod x y) = "B% " ++ serialize x ++ " " ++ serialize y
serialize (Gt x y) = "B> " ++ serialize x ++ " " ++ serialize y
serialize (Lt x y) = "B< " ++ serialize x ++ " " ++ serialize y
serialize (Eq x y) = "B= " ++ serialize x ++ " " ++ serialize y
serialize (Or x y) = "B| " ++ serialize x ++ " " ++ serialize y
serialize (And x y) = "B& " ++ serialize x ++ " " ++ serialize y
serialize (Concat x y) = "B++ " ++ serialize x ++ " " ++ serialize y
serialize (Take x y) = "BT " ++ serialize x ++ " " ++ serialize y
serialize (Drop x y) = "BD " ++ serialize x ++ " " ++ serialize y
serialize (Apply x y) = "B$ " ++ serialize x ++ " " ++ serialize y
serialize (If x y z) = "? " ++ serialize x ++ " " ++ serialize y ++ " " ++ serialize z
{-# Language ImportQualifiedPost #-}
import Data.Map.Strict qualified as Map import Data.Map.Strict qualified as Map
import Text.Parsec (parse) import Text.Parsec (parse)
import Control.Monad.Reader (runReader) import Control.Monad.Reader (runReader)
......
module Serialize where
import Data.Char (ord, chr)
import Expression
serialize :: Expression -> String
serialize (Number x) = 'I':[chr((fromInteger a) + 33) | a <- [mod (div x (94^b)) 94 | b<-[y,y-1..0]]]
where y = floor ( logBase 94.0 (fromInteger x) )
serialize (Str x) = 'S':[chr((ord a) + 33)|a<-x]
serialize (Boolean x) = if x
then "T"
else "F"
serialize (Variable x) = "V" . [chr(ord(x)+33)]
serialize (Lambda x y) = "L" . [chr(ord(x)+33)] . " " . (serialize y)
serialize (Negate x) = "U- " . (serialize x)
serialize (Not x) = "U! " . (serialize x)
serialize (StringToInt x) = "U# " . (serialize x)
serialize (IntToString x) = "U$ " . (serialize x)
serialize (Add x y) = "B+ " . (serialize x) . " " . (serialize y)
serialize (Sub x y) = "B- " . (serialize x) . " " . (serialize y)
serialize (Mul x y) = "B* " . (serialize x) . " " . (serialize y)
serialize (Div x y) = "B/ " . (serialize x) . " " . (serialize y)
serialize (Mod x y) = "B% " . (serialize x) . " " . (serialize y)
serialize (Gt x y) = "B> " . (serialize x) . " " . (serialize y)
serialize (Lt x y) = "B< " . (serialize x) . " " . (serialize y)
serialize (Eq x y) = "B= " . (serialize x) . " " . (serialize y)
serialize (Or x y) = "B| " . (serialize x) . " " . (serialize y)
serialize (And x y) = "B& " . (serialize x) . " " . (serialize y)
serialize (Concat x y) = "B. " . (serialize x) . " " . (serialize y)
serialize (Take x y) = "BT " . (serialize x) . " " . (serialize y)
serialize (Drop x y) = "BD " . (serialize x) . " " . (serialize y)
serialize (Apply x y) = "B$ " . (serialize x) . " " . (serialize y)
serialize (If x y z) = "? " . (serialize x) . " " . (serialize y) . " " . (serialize z)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment