{-
-- EPITECH PROJECT, 2023
-- LobsterLang
-- File description:
-- Compiler
-}

-- BONUS TODO: basic java trans compilation

module Compiler (
  compile,
  astToInstructions,
  compileInstructions,
  showInstructions,
  writeCompiledInstructionsToFile,
  Instruction(..),
  CompileConstants(..)
) where

import AST (Ast (..))

import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.UTF8 as BSUTF8
import Data.Binary
import Data.Binary.Put
import qualified Data.List

data CompileConstants = Null
  | MagicNumber deriving (Int -> CompileConstants -> ShowS
[CompileConstants] -> ShowS
CompileConstants -> String
(Int -> CompileConstants -> ShowS)
-> (CompileConstants -> String)
-> ([CompileConstants] -> ShowS)
-> Show CompileConstants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompileConstants -> ShowS
showsPrec :: Int -> CompileConstants -> ShowS
$cshow :: CompileConstants -> String
show :: CompileConstants -> String
$cshowList :: [CompileConstants] -> ShowS
showList :: [CompileConstants] -> ShowS
Show, CompileConstants -> CompileConstants -> Bool
(CompileConstants -> CompileConstants -> Bool)
-> (CompileConstants -> CompileConstants -> Bool)
-> Eq CompileConstants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompileConstants -> CompileConstants -> Bool
== :: CompileConstants -> CompileConstants -> Bool
$c/= :: CompileConstants -> CompileConstants -> Bool
/= :: CompileConstants -> CompileConstants -> Bool
Eq)
instance Enum CompileConstants where
  fromEnum :: CompileConstants -> Int
fromEnum CompileConstants
MagicNumber = Int
763
  fromEnum CompileConstants
Null = Int
0
  toEnum :: Int -> CompileConstants
toEnum Int
763 = CompileConstants
MagicNumber
  toEnum Int
_ = CompileConstants
Null

data Instruction =
    NoOp
  -- Stack Instructions
  | PushI Int
  | PushB Bool
  | PushSym String (Maybe [[Instruction]])
  | PushStr String
  | PushList Int [[Instruction]]
  | PushArg Int
  | PutArg
  -- Jump Instructions
  | Jump Int
  | JumpIfFalse Int
  -- Function Instructions
  | Def String Int [Instruction]
  | Fnv Int [String] Int [Instruction] [Int] (Maybe [[Instruction]])
  | Call -- ()
  | Ret
  -- Logical Instructions
  | Cond [Instruction] Int [Instruction] (Maybe [Instruction])
  -- Built-in Functions / Operators
    -- Arithmetic Operators
    | Add
    | Sub
    | Mul
    | Div
    | Mod
    | XorB -- ^^
    -- Comparison Operators
    | Eq
    | NotEq
    | Less
    | LessEq
    | Great
    | GreatEq
    -- Logical Operators
    | And
    | Or
    | Not -- Used to invert if statements and Boolean values.
    | Then
    -- Unary Operators
    | ToStr -- @
    | Neg -- Used only for negations that can not be determined at compile time (ex: Symbol negation)
    -- Built-in Functions
    | Apnd -- ++
    | RemAllOcc -- --
    | Get -- !!
    | Len -- ~
  deriving (Int -> Instruction -> ShowS
[Instruction] -> ShowS
Instruction -> String
(Int -> Instruction -> ShowS)
-> (Instruction -> String)
-> ([Instruction] -> ShowS)
-> Show Instruction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Instruction -> ShowS
showsPrec :: Int -> Instruction -> ShowS
$cshow :: Instruction -> String
show :: Instruction -> String
$cshowList :: [Instruction] -> ShowS
showList :: [Instruction] -> ShowS
Show, Instruction -> Instruction -> Bool
(Instruction -> Instruction -> Bool)
-> (Instruction -> Instruction -> Bool) -> Eq Instruction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Instruction -> Instruction -> Bool
== :: Instruction -> Instruction -> Bool
$c/= :: Instruction -> Instruction -> Bool
/= :: Instruction -> Instruction -> Bool
Eq)

instance Enum Instruction where
  fromEnum :: Instruction -> Int
fromEnum Instruction
NoOp = Int
0
  -- Stack Instructions [10 - 30]
  fromEnum (PushI Int
_) = Int
10
  fromEnum (PushB Bool
_) = Int
11
  fromEnum (PushSym String
_ Maybe [[Instruction]]
_) = Int
12
  fromEnum (PushStr String
_) = Int
13
  fromEnum (PushList Int
_ [[Instruction]]
_) = Int
14
  fromEnum (PushArg Int
_) = Int
15
  fromEnum Instruction
PutArg = Int
16
  -- Jump Instructions [30 - 40]
  fromEnum (Jump Int
_) = Int
30
  fromEnum (JumpIfFalse Int
_) = Int
31
  -- Function Instructions [40 - 45]
  fromEnum (Def {}) = Int
40
  fromEnum (Fnv {}) = Int
41
  fromEnum Instruction
Compiler.Call = Int
42
  fromEnum Instruction
Ret = Int
43
  -- Logical Instructions [45 - 50]
  fromEnum (Compiler.Cond {}) = Int
45
  -- Built-in Functions / Operators [50 - 90]
  -- Arithmetic Operators [50 - 60]
  fromEnum Instruction
Add = Int
50
  fromEnum Instruction
Sub = Int
51
  fromEnum Instruction
Mul = Int
52
  fromEnum Instruction
Div = Int
53
  fromEnum Instruction
Mod = Int
54
  fromEnum Instruction
XorB = Int
55
  -- Comparison Operators [60 - 70]
  fromEnum Instruction
Eq = Int
60
  fromEnum Instruction
NotEq = Int
61
  fromEnum Instruction
Less = Int
62
  fromEnum Instruction
LessEq = Int
63
  fromEnum Instruction
Great = Int
64
  fromEnum Instruction
GreatEq = Int
65
  -- Logical Operators [70 - 80]
  fromEnum Instruction
And = Int
70
  fromEnum Instruction
Or = Int
71
  fromEnum Instruction
Not = Int
72
  fromEnum Instruction
Then = Int
73
  -- Unary Operators [80 - 90]
  fromEnum Instruction
ToStr = Int
80
  fromEnum Instruction
Neg = Int
81
  -- Built-in Functions [100 - ...]
  fromEnum Instruction
Apnd = Int
100
  fromEnum Instruction
RemAllOcc = Int
101
  fromEnum Instruction
Get = Int
102
  fromEnum Instruction
Len = Int
103

  toEnum :: Int -> Instruction
toEnum Int
0 = Instruction
NoOp
  toEnum Int
10 = Int -> Instruction
PushI Int
0
  toEnum Int
11 = Bool -> Instruction
PushB Bool
False
  toEnum Int
12 = String -> Maybe [[Instruction]] -> Instruction
PushSym String
"" Maybe [[Instruction]]
forall a. Maybe a
Nothing
  toEnum Int
13 = String -> Instruction
PushStr String
""
  toEnum Int
14 = Int -> [[Instruction]] -> Instruction
PushList Int
0 []
  toEnum Int
15 = Int -> Instruction
PushArg Int
0
  toEnum Int
16 = Instruction
PutArg
  toEnum Int
30 = Int -> Instruction
Jump Int
0
  toEnum Int
31 = Int -> Instruction
JumpIfFalse Int
0
  toEnum Int
40 = String -> Int -> [Instruction] -> Instruction
Def String
"" Int
0 []
  toEnum Int
41 = Int
-> [String]
-> Int
-> [Instruction]
-> [Int]
-> Maybe [[Instruction]]
-> Instruction
Fnv Int
0 [] Int
0 [] [] Maybe [[Instruction]]
forall a. Maybe a
Nothing
  toEnum Int
42 = Instruction
Compiler.Call
  toEnum Int
43 = Instruction
Ret
  toEnum Int
45 = [Instruction]
-> Int -> [Instruction] -> Maybe [Instruction] -> Instruction
Compiler.Cond [] Int
0 [] Maybe [Instruction]
forall a. Maybe a
Nothing
  toEnum Int
50 = Instruction
Add
  toEnum Int
51 = Instruction
Sub
  toEnum Int
52 = Instruction
Mul
  toEnum Int
53 = Instruction
Div
  toEnum Int
54 = Instruction
Mod
  toEnum Int
55 = Instruction
XorB
  toEnum Int
60 = Instruction
Eq
  toEnum Int
61 = Instruction
NotEq
  toEnum Int
62 = Instruction
Less
  toEnum Int
63 = Instruction
LessEq
  toEnum Int
64 = Instruction
Great
  toEnum Int
65 = Instruction
GreatEq
  toEnum Int
70 = Instruction
And
  toEnum Int
71 = Instruction
Or
  toEnum Int
72 = Instruction
Not
  toEnum Int
73 = Instruction
Then
  toEnum Int
80 = Instruction
ToStr
  toEnum Int
81 = Instruction
Neg
  toEnum Int
100 = Instruction
Apnd
  toEnum Int
101 = Instruction
RemAllOcc
  toEnum Int
102 = Instruction
Get
  toEnum Int
103 = Instruction
Len
  toEnum Int
_ = Instruction
NoOp

astToInstructions :: Ast -> [Instruction]
astToInstructions :: Ast -> [Instruction]
astToInstructions (Value Int
value) = [Int -> Instruction
PushI Int
value]
astToInstructions (Boolean Bool
bool) = [Bool -> Instruction
PushB Bool
bool]
astToInstructions (Symbol String
symbolName Maybe [Ast]
Nothing) = [String -> Maybe [[Instruction]] -> Instruction
PushSym String
symbolName Maybe [[Instruction]]
forall a. Maybe a
Nothing]
astToInstructions (Symbol String
symbolName (Just [Ast]
symbolArgs)) =
  [String -> Maybe [[Instruction]] -> Instruction
PushSym String
symbolName ([[Instruction]] -> Maybe [[Instruction]]
forall a. a -> Maybe a
Just [[Instruction]]
symbolArgsInstructions)]
  where
    symbolArgsInstructions :: [[Instruction]]
symbolArgsInstructions =
      (Ast -> [Instruction]) -> [Ast] -> [[Instruction]]
forall a b. (a -> b) -> [a] -> [b]
map Ast -> [Instruction]
astToInstructions [Ast]
symbolArgs
astToInstructions (String String
stringValue) = [String -> Instruction
PushStr String
stringValue]
astToInstructions (List [Ast]
values) =
  [Int -> [[Instruction]] -> Instruction
PushList ([Ast] -> Int
_findAstInstrSize [Ast]
values) [[Instruction]]
valuesInstructions]
  where
    valuesInstructions :: [[Instruction]]
valuesInstructions = (Ast -> [Instruction]) -> [Ast] -> [[Instruction]]
forall a b. (a -> b) -> [a] -> [b]
map Ast -> [Instruction]
astToInstructions [Ast]
values
astToInstructions (AST.Call String
"+" [Ast]
args) =
  [Instruction] -> [Instruction]
forall a. [a] -> [a]
reverse ((Ast -> [Instruction]) -> [Ast] -> [Instruction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ast -> [Instruction]
astToInstructions [Ast]
args) [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
Add]
astToInstructions (AST.Call String
"-" [Ast]
args) =
  [Instruction] -> [Instruction]
forall a. [a] -> [a]
reverse ((Ast -> [Instruction]) -> [Ast] -> [Instruction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ast -> [Instruction]
astToInstructions [Ast]
args) [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
Sub]
astToInstructions (AST.Call String
"*" [Ast]
args) =
  [Instruction] -> [Instruction]
forall a. [a] -> [a]
reverse ((Ast -> [Instruction]) -> [Ast] -> [Instruction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ast -> [Instruction]
astToInstructions [Ast]
args) [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
Mul]
astToInstructions (AST.Call String
"/" [Ast]
args) =
  [Instruction] -> [Instruction]
forall a. [a] -> [a]
reverse ((Ast -> [Instruction]) -> [Ast] -> [Instruction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ast -> [Instruction]
astToInstructions [Ast]
args) [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
Div]
astToInstructions (AST.Call String
"%" [Ast]
args) =
  [Instruction] -> [Instruction]
forall a. [a] -> [a]
reverse ((Ast -> [Instruction]) -> [Ast] -> [Instruction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ast -> [Instruction]
astToInstructions [Ast]
args) [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
Mod]
astToInstructions (AST.Call String
"^^" [Ast]
args) =
  [Instruction] -> [Instruction]
forall a. [a] -> [a]
reverse ((Ast -> [Instruction]) -> [Ast] -> [Instruction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ast -> [Instruction]
astToInstructions [Ast]
args) [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
XorB]
astToInstructions (AST.Call String
"==" [Ast]
args) =
  [Instruction] -> [Instruction]
forall a. [a] -> [a]
reverse ((Ast -> [Instruction]) -> [Ast] -> [Instruction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ast -> [Instruction]
astToInstructions [Ast]
args) [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
Eq]
astToInstructions (AST.Call String
"!=" [Ast]
args) =
  [Instruction] -> [Instruction]
forall a. [a] -> [a]
reverse ((Ast -> [Instruction]) -> [Ast] -> [Instruction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ast -> [Instruction]
astToInstructions [Ast]
args) [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
NotEq]
astToInstructions (AST.Call String
"<" [Ast]
args) =
  [Instruction] -> [Instruction]
forall a. [a] -> [a]
reverse ((Ast -> [Instruction]) -> [Ast] -> [Instruction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ast -> [Instruction]
astToInstructions [Ast]
args) [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
Less]
astToInstructions (AST.Call String
"<=" [Ast]
args) =
  [Instruction] -> [Instruction]
forall a. [a] -> [a]
reverse ((Ast -> [Instruction]) -> [Ast] -> [Instruction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ast -> [Instruction]
astToInstructions [Ast]
args) [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
LessEq]
astToInstructions (AST.Call String
">" [Ast]
args) =
  [Instruction] -> [Instruction]
forall a. [a] -> [a]
reverse ((Ast -> [Instruction]) -> [Ast] -> [Instruction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ast -> [Instruction]
astToInstructions [Ast]
args) [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
Great]
astToInstructions (AST.Call String
">=" [Ast]
args) =
  [Instruction] -> [Instruction]
forall a. [a] -> [a]
reverse ((Ast -> [Instruction]) -> [Ast] -> [Instruction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ast -> [Instruction]
astToInstructions [Ast]
args) [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
GreatEq]
astToInstructions (AST.Call String
"&&" [Ast]
args) =
  [Instruction] -> [Instruction]
forall a. [a] -> [a]
reverse ((Ast -> [Instruction]) -> [Ast] -> [Instruction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ast -> [Instruction]
astToInstructions [Ast]
args) [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
And]
astToInstructions (AST.Call String
"||" [Ast]
args) =
  [Instruction] -> [Instruction]
forall a. [a] -> [a]
reverse ((Ast -> [Instruction]) -> [Ast] -> [Instruction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ast -> [Instruction]
astToInstructions [Ast]
args) [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
Or]
astToInstructions (AST.Call String
"!" [Ast]
args) =
  [Instruction] -> [Instruction]
forall a. [a] -> [a]
reverse ((Ast -> [Instruction]) -> [Ast] -> [Instruction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ast -> [Instruction]
astToInstructions [Ast]
args) [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
Not]
astToInstructions (AST.Call String
"$" [Ast]
args) =
  [Instruction] -> [Instruction]
forall a. [a] -> [a]
reverse ((Ast -> [Instruction]) -> [Ast] -> [Instruction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ast -> [Instruction]
astToInstructions [Ast]
args) [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
Then]
astToInstructions (AST.Call String
"@" [Ast]
args) =
  [Instruction] -> [Instruction]
forall a. [a] -> [a]
reverse ((Ast -> [Instruction]) -> [Ast] -> [Instruction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ast -> [Instruction]
astToInstructions [Ast]
args) [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
ToStr]
astToInstructions (AST.Call String
"++" [Ast]
args) =
  [Instruction] -> [Instruction]
forall a. [a] -> [a]
reverse ((Ast -> [Instruction]) -> [Ast] -> [Instruction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ast -> [Instruction]
astToInstructions [Ast]
args) [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
Apnd]
astToInstructions (AST.Call String
"--" [Ast]
args) =
  [Instruction] -> [Instruction]
forall a. [a] -> [a]
reverse ((Ast -> [Instruction]) -> [Ast] -> [Instruction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ast -> [Instruction]
astToInstructions [Ast]
args) [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
RemAllOcc]
astToInstructions (AST.Call String
"!!" [Ast]
args) =
  [Instruction] -> [Instruction]
forall a. [a] -> [a]
reverse ((Ast -> [Instruction]) -> [Ast] -> [Instruction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ast -> [Instruction]
astToInstructions [Ast]
args) [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
Get]
astToInstructions (AST.Call String
"~" [Ast]
args) =
  [Instruction] -> [Instruction]
forall a. [a] -> [a]
reverse ((Ast -> [Instruction]) -> [Ast] -> [Instruction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ast -> [Instruction]
astToInstructions [Ast]
args) [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
Len]
astToInstructions (AST.Call String
_ [Ast]
_) = [Instruction
NoOp]
astToInstructions (Define String
symbolName Ast
value) =
  let symbolValue :: [Instruction]
symbolValue = Ast -> [Instruction]
astToInstructions Ast
value
  in [String -> Int -> [Instruction] -> Instruction
Def String
symbolName Int
1 [Instruction]
symbolValue]
astToInstructions (FunctionValue [String]
argsNames Ast
funcBody Maybe [Ast]
Nothing) =
  [Int
-> [String]
-> Int
-> [Instruction]
-> [Int]
-> Maybe [[Instruction]]
-> Instruction
Fnv ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
argsNames) [String]
argsNames Int
nbFuncBodyInstructions
    [Instruction]
funcBodyInstructions [] Maybe [[Instruction]]
forall a. Maybe a
Nothing]
  where
    nbFuncBodyInstructions :: Int
nbFuncBodyInstructions = [Ast] -> Int
_findAstInstrSize [Ast
funcBody]
    funcBodyInstructions :: [Instruction]
funcBodyInstructions =
      [Instruction] -> [String] -> [Instruction]
_resolveFunctionPushArgs (Ast -> [Instruction]
astToInstructions Ast
funcBody [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
Ret]) [String]
argsNames
astToInstructions (FunctionValue [String]
argsNames Ast
funcBody (Just [Ast]
argsValues)) =
  [Int
-> [String]
-> Int
-> [Instruction]
-> [Int]
-> Maybe [[Instruction]]
-> Instruction
Fnv ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
argsNames) [String]
argsNames Int
nbFuncBodyInstructions
    [Instruction]
funcBodyInstructions [Int]
nbArgsValuesInstructions Maybe [[Instruction]]
argsValuesInstructions]
  where
    nbFuncBodyInstructions :: Int
nbFuncBodyInstructions = [Ast] -> Int
_findAstInstrSize [Ast
funcBody]
    funcBodyInstructions :: [Instruction]
funcBodyInstructions =
      [Instruction] -> [String] -> [Instruction]
_resolveFunctionPushArgs (Ast -> [Instruction]
astToInstructions Ast
funcBody [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
Ret]) [String]
argsNames
    argsValuesInstructions :: Maybe [[Instruction]]
argsValuesInstructions =
      [[Instruction]] -> Maybe [[Instruction]]
forall a. a -> Maybe a
Just ((Ast -> [Instruction]) -> [Ast] -> [[Instruction]]
forall a b. (a -> b) -> [a] -> [b]
map Ast -> [Instruction]
astToInstructions [Ast]
argsValues)
    nbArgsValuesInstructions :: [Int]
nbArgsValuesInstructions = Maybe [[Instruction]] -> [Int]
_instructionListLengths Maybe [[Instruction]]
argsValuesInstructions
astToInstructions (AST.Cond Ast
cond Ast
trueBlock (Just Ast
falseBlock)) =
  [[Instruction]
-> Int -> [Instruction] -> Maybe [Instruction] -> Instruction
Compiler.Cond [Instruction]
condInstructions Int
nbTrueBlockInstructions
    [Instruction]
trueBlockInstructions ([Instruction] -> Maybe [Instruction]
forall a. a -> Maybe a
Just [Instruction]
falseBlockInstructions)]
  where
    condInstructions :: [Instruction]
condInstructions = Ast -> [Instruction]
astToInstructions Ast
cond
    falseBlockInstructions :: [Instruction]
falseBlockInstructions = Ast -> [Instruction]
astToInstructions Ast
falseBlock
    trueBlockInstructions :: [Instruction]
trueBlockInstructions = Ast -> [Instruction]
astToInstructions Ast
trueBlock [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++
      [Int -> Instruction
Jump ([Ast] -> Int
_findAstInstrSize [Ast
falseBlock] Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)]
    nbTrueBlockInstructions :: Int
nbTrueBlockInstructions = [Ast] -> Int
_findAstInstrSize [Ast
trueBlock] Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
astToInstructions (AST.Cond Ast
cond Ast
trueBlock Maybe Ast
Nothing) =
  [[Instruction]
-> Int -> [Instruction] -> Maybe [Instruction] -> Instruction
Compiler.Cond [Instruction]
condInstructions Int
nbTrueBlockInstructions
    [Instruction]
trueBlockInstructions Maybe [Instruction]
forall a. Maybe a
Nothing]
  where
    condInstructions :: [Instruction]
condInstructions = Ast -> [Instruction]
astToInstructions Ast
cond
    trueBlockInstructions :: [Instruction]
trueBlockInstructions =
      Ast -> [Instruction]
astToInstructions Ast
trueBlock
    nbTrueBlockInstructions :: Int
nbTrueBlockInstructions = [Ast] -> Int
_findAstInstrSize [Ast
trueBlock] Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

_showInstruction :: Instruction -> Int -> [Char]
_showInstruction :: Instruction -> Int -> String
_showInstruction Instruction
NoOp Int
_ = String
"NO_OP\n"
_showInstruction (PushI Int
value) Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"PUSH_I " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
value String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction (PushB Bool
bool) Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"PUSH_B " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show Bool
bool String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction (PushStr String
stringValue) Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"PUSH_STR " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
stringValue String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction (PushSym String
symbolName Maybe [[Instruction]]
Nothing) Int
depth =
    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"PUSH_SYM " String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
symbolName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction (PushSym String
symbolName (Just [[Instruction]]
symbolArgs)) Int
depth =
    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"PUSH_SYM " String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
symbolName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([[Instruction]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Instruction]]
symbolArgs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"[\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Instruction]] -> Int -> String
_showInstructionList [[Instruction]]
symbolArgs (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]\n"
_showInstruction (PushList Int
nbValuesInstructions [[Instruction]]
valuesInstructions) Int
depth =
    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"PUSH_LIST " String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
nbValuesInstructions String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"[\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Instruction]] -> Int -> String
_showInstructionList [[Instruction]]
valuesInstructions (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]\n"
_showInstruction (PushArg Int
index) Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"PUSH_ARG " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
index String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
PutArg Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"PUT_ARG " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction (Jump Int
branchOffset) Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t")
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"JUMP "
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
branchOffset String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction (JumpIfFalse Int
branchOffset) Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t")
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"JUMP_IF_FALSE "
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
branchOffset String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
Add Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"ADD" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
Sub Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"SUB" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
Mul Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"MUL" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
Div Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"DIV" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
Mod Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"MOD" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
XorB Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"XOR_B" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
Eq Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"EQ" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
NotEq Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"NOT_EQ" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
Less Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"LESS" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
LessEq Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"LESS_EQ" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
Great Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"GREAT" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
GreatEq Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"GREAT_EQ" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
And Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"AND" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
Or Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"OR" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
Not Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"NOT" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
Then Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"THEN" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
ToStr Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"TO_STR" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
Neg Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"NEG" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
Compiler.Call Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"CALL" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
Ret Int
depth = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"RET" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction (Def String
symbolName Int
nbInstruction [Instruction]
instructions) Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"DEF " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
symbolName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++
  Int -> String
forall a. Show a => a -> String
show Int
nbInstruction String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") =\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Instruction] -> Int -> String
_showInstructions [Instruction]
instructions (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
_showInstruction (Fnv Int
nbArgsNames [String]
argsNames Int
nbFuncBodyInstructions
  [Instruction]
funcBodyInstructions [Int]
nbArgsValuesInstructions
  (Just [[Instruction]]
argsValuesInstructions)) Int
depth =
    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"FNV " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
nbArgsNames String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
argsNames String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show [Int]
nbArgsValuesInstructions String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"(\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Instruction]] -> Int -> String
_showInstructionList [[Instruction]]
argsValuesInstructions (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
" = (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
nbFuncBodyInstructions String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"){\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Instruction] -> Int -> String
_showInstructions [Instruction]
funcBodyInstructions (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}\n"
_showInstruction (Fnv Int
nbArgsNames [String]
argsNames Int
nbFuncBodyInstructions
  [Instruction]
funcBodyInstructions [Int]
_ Maybe [[Instruction]]
Nothing) Int
depth =
    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"FNV " String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
nbArgsNames String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    [String] -> String
forall a. Show a => a -> String
show [String]
argsNames String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
" = (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
nbFuncBodyInstructions String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"){\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Instruction] -> Int -> String
_showInstructions [Instruction]
funcBodyInstructions (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}\n"
_showInstruction (Compiler.Cond [Instruction]
condInstructions
  Int
nbTrueBlockInstructions [Instruction]
trueBlockInstructions
  (Just [Instruction]
falseBlockInstructions)) Int
depth = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"COND " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Instruction] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Instruction]
condInstructions) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"(\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Instruction] -> Int -> String
_showInstructions [Instruction]
condInstructions (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> ShowS
forall a. [a] -> [a] -> [a]
++
    Instruction -> Int -> String
_showInstruction (Int -> Instruction
JumpIfFalse Int
nbTrueBlockInstructions) Int
0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
" true: (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
nbTrueBlockInstructions String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"){\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Instruction] -> Int -> String
_showInstructions [Instruction]
trueBlockInstructions (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
" false: (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Instruction] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Instruction]
falseBlockInstructions) String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"){\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Instruction] -> Int -> String
_showInstructions [Instruction]
falseBlockInstructions (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}\n"
_showInstruction (Compiler.Cond [Instruction]
condInstructions
  Int
nbTrueBlockInstructions [Instruction]
trueBlockInstructions Maybe [Instruction]
Nothing) Int
depth =
    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"COND " String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Instruction] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Instruction]
condInstructions) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"(\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Instruction] -> Int -> String
_showInstructions [Instruction]
condInstructions (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> ShowS
forall a. [a] -> [a] -> [a]
++
    Instruction -> Int -> String
_showInstruction (Int -> Instruction
JumpIfFalse Int
nbTrueBlockInstructions) Int
0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
" true: (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
nbTrueBlockInstructions String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"){\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Instruction] -> Int -> String
_showInstructions [Instruction]
trueBlockInstructions (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
" false: {}\n"
_showInstruction Instruction
Apnd Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"APND" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
RemAllOcc Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"REM_ALL_OCC" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
Get Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"GET" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
_showInstruction Instruction
Len Int
depth =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
depth String
"\t") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"LEN" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"

_resolveFunctionPushArgs :: [Instruction] -> [String] -> [Instruction]
_resolveFunctionPushArgs :: [Instruction] -> [String] -> [Instruction]
_resolveFunctionPushArgs [] [String]
_ = []
_resolveFunctionPushArgs [PushSym String
symbolName Maybe [[Instruction]]
Nothing] [String]
argsNames =
  case String -> [String] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
Data.List.elemIndex String
symbolName [String]
argsNames of
    Just Int
value -> [Int -> Instruction
PushArg Int
value]
    Maybe Int
Nothing -> [String -> Maybe [[Instruction]] -> Instruction
PushSym String
symbolName Maybe [[Instruction]]
forall a. Maybe a
Nothing]
_resolveFunctionPushArgs [PushSym String
symbolName (Just [[Instruction]]
args)] [String]
argsNames =
  case String -> [String] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
Data.List.elemIndex String
symbolName [String]
argsNames of
    Just Int
value -> [Int -> Instruction
PushArg Int
value]
    Maybe Int
Nothing -> [String -> Maybe [[Instruction]] -> Instruction
PushSym String
symbolName
      ([[Instruction]] -> Maybe [[Instruction]]
forall a. a -> Maybe a
Just (([Instruction] -> [Instruction])
-> [[Instruction]] -> [[Instruction]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Instruction] -> [String] -> [Instruction]
`_resolveFunctionPushArgs` [String]
argsNames) [[Instruction]]
args))]
_resolveFunctionPushArgs [Compiler.Cond [Instruction]
condInstructions
  Int
nbTrueBlockInstructions [Instruction]
trueBlockInstructions
  (Just [Instruction]
falseBlockInstructions)] [String]
argsNames =
    [ [Instruction]
-> Int -> [Instruction] -> Maybe [Instruction] -> Instruction
Compiler.Cond
    ([Instruction] -> [String] -> [Instruction]
_resolveFunctionPushArgs [Instruction]
condInstructions [String]
argsNames)
    Int
nbTrueBlockInstructions
    ([Instruction] -> [String] -> [Instruction]
_resolveFunctionPushArgs [Instruction]
trueBlockInstructions [String]
argsNames)
    ([Instruction] -> Maybe [Instruction]
forall a. a -> Maybe a
Just ([Instruction] -> [String] -> [Instruction]
_resolveFunctionPushArgs [Instruction]
falseBlockInstructions [String]
argsNames))]
_resolveFunctionPushArgs [Compiler.Cond [Instruction]
condInstructions
  Int
nbTrueBlockInstructions [Instruction]
trueBlockInstructions Maybe [Instruction]
Nothing] [String]
argsNames =
    [ [Instruction]
-> Int -> [Instruction] -> Maybe [Instruction] -> Instruction
Compiler.Cond
    ([Instruction] -> [String] -> [Instruction]
_resolveFunctionPushArgs [Instruction]
condInstructions [String]
argsNames)
    Int
nbTrueBlockInstructions
    ([Instruction] -> [String] -> [Instruction]
_resolveFunctionPushArgs [Instruction]
trueBlockInstructions [String]
argsNames)
    Maybe [Instruction]
forall a. Maybe a
Nothing]
_resolveFunctionPushArgs [PushList Int
nbValuesInstructions [[Instruction]]
valuesInstructions]
  [String]
argsNames =
  [Int -> [[Instruction]] -> Instruction
PushList Int
nbValuesInstructions
    (([Instruction] -> [Instruction])
-> [[Instruction]] -> [[Instruction]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Instruction] -> [String] -> [Instruction]
`_resolveFunctionPushArgs` [String]
argsNames) [[Instruction]]
valuesInstructions)]
_resolveFunctionPushArgs [Instruction
instruction] [String]
_ = [Instruction
instruction]
_resolveFunctionPushArgs (Instruction
instruction:[Instruction]
instructions) [String]
argsNames
  = [Instruction] -> [String] -> [Instruction]
_resolveFunctionPushArgs [Instruction
instruction] [String]
argsNames
  [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction] -> [String] -> [Instruction]
_resolveFunctionPushArgs [Instruction]
instructions [String]
argsNames

_findAstInstrSize :: [Ast] -> Int
_findAstInstrSize :: [Ast] -> Int
_findAstInstrSize [] = Int
0
_findAstInstrSize (Value Int
_:[Ast]
xs) =
  Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Ast] -> Int
_findAstInstrSize [Ast]
xs
_findAstInstrSize (Boolean Bool
_:[Ast]
xs) =
  Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Ast] -> Int
_findAstInstrSize [Ast]
xs
_findAstInstrSize (String String
_:[Ast]
xs) =
  Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Ast] -> Int
_findAstInstrSize [Ast]
xs
_findAstInstrSize (Define String
_ Ast
ast:[Ast]
xs) =
  Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Ast] -> Int
_findAstInstrSize [Ast
ast] Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Ast] -> Int
_findAstInstrSize [Ast]
xs
_findAstInstrSize (List [Ast]
asts:[Ast]
xs) =
  Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Ast] -> Int
_findAstInstrSize [Ast]
asts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Ast] -> Int
_findAstInstrSize [Ast]
xs
_findAstInstrSize (Symbol String
_ Maybe [Ast]
Nothing:[Ast]
xs) =
  Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Ast] -> Int
_findAstInstrSize [Ast]
xs
_findAstInstrSize (Symbol String
_ (Just [Ast]
asts):[Ast]
xs) =
  [Ast] -> Int
_findAstInstrSize [Ast]
asts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Ast] -> Int
_findAstInstrSize [Ast]
xs-- push nbGivenArgs, pushSym, Call
_findAstInstrSize (AST.Call String
_ [Ast]
asts:[Ast]
xs) =
  [Ast] -> Int
_findAstInstrSize [Ast]
asts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Ast] -> Int
_findAstInstrSize [Ast]
xs
_findAstInstrSize (FunctionValue [String]
_ Ast
ast Maybe [Ast]
Nothing:[Ast]
xs) =
  [Ast] -> Int
_findAstInstrSize [Ast
ast] Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Ast] -> Int
_findAstInstrSize [Ast]
xs
_findAstInstrSize (FunctionValue [String]
_ Ast
ast (Just [Ast]
asts):[Ast]
xs) =
  [Ast] -> Int
_findAstInstrSize [Ast]
asts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Ast] -> Int
_findAstInstrSize [Ast
ast] Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
  [Ast] -> Int
_findAstInstrSize [Ast]
xs
_findAstInstrSize (AST.Cond Ast
astCond Ast
astTrue Maybe Ast
Nothing:[Ast]
xs) =
  [Ast] -> Int
_findAstInstrSize [Ast
astCond] Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Ast] -> Int
_findAstInstrSize [Ast
astTrue] Int -> Int -> Int
forall a. Num a => a -> a -> a
+
  [Ast] -> Int
_findAstInstrSize [Ast]
xs
_findAstInstrSize (AST.Cond Ast
astCond Ast
astTrue (Just Ast
astFalse):[Ast]
xs) =
  [Ast] -> Int
_findAstInstrSize [Ast
astCond] Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Ast] -> Int
_findAstInstrSize [Ast
astTrue] Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
  [Ast] -> Int
_findAstInstrSize [Ast
astFalse] Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Ast] -> Int
_findAstInstrSize [Ast]
xs

_instructionListLengths :: Maybe [[Instruction]] -> [Int]
_instructionListLengths :: Maybe [[Instruction]] -> [Int]
_instructionListLengths (Just []) = [Int
0]
_instructionListLengths (Just [[Instruction]
instructionList]) = [[Instruction] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Instruction]
instructionList]
_instructionListLengths (Just ([Instruction]
instructionList:[[Instruction]]
instructionLists)) =
  [Instruction] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Instruction]
instructionList Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Maybe [[Instruction]] -> [Int]
_instructionListLengths ([[Instruction]] -> Maybe [[Instruction]]
forall a. a -> Maybe a
Just [[Instruction]]
instructionLists)
_instructionListLengths Maybe [[Instruction]]
Nothing = []

_showInstructionList :: [[Instruction]] -> Int -> String
_showInstructionList :: [[Instruction]] -> Int -> String
_showInstructionList [] Int
_ = String
""
_showInstructionList [[Instruction]
instructions] Int
depth =
  [Instruction] -> Int -> String
_showInstructions [Instruction]
instructions Int
depth
_showInstructionList ([Instruction]
instructions:[[Instruction]]
instructionsList) Int
depth =
  [Instruction] -> Int -> String
_showInstructions [Instruction]
instructions Int
depth String -> ShowS
forall a. [a] -> [a] -> [a]
++
  String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Instruction]] -> Int -> String
_showInstructionList [[Instruction]]
instructionsList Int
depth

_showInstructions :: [Instruction] -> Int -> String
_showInstructions :: [Instruction] -> Int -> String
_showInstructions [Instruction]
instructions Int
depth =
  (Instruction -> String) -> [Instruction] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Instruction -> String
lambda [Instruction]
instructions where lambda :: Instruction -> String
lambda Instruction
x = Instruction -> Int -> String
_showInstruction Instruction
x Int
depth

showInstructions :: [Instruction] -> IO()
showInstructions :: [Instruction] -> IO ()
showInstructions [Instruction]
instructions = String -> IO ()
putStr ([Instruction] -> Int -> String
_showInstructions [Instruction]
instructions Int
0)

_putOpCodeFromInstruction :: Instruction -> Put
_putOpCodeFromInstruction :: Instruction -> Put
_putOpCodeFromInstruction Instruction
instruction =
  Word8 -> Put
putWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Instruction -> Int
forall a. Enum a => a -> Int
fromEnum Instruction
instruction))

_fputList :: (a -> Put) -> [a] -> Put
_fputList :: forall a. (a -> Put) -> [a] -> Put
_fputList a -> Put
_ [] = String -> Put
_putString String
""
_fputList a -> Put
func [a
element] = a -> Put
func a
element
_fputList a -> Put
func (a
element:[a]
elements) = a -> Put
func a
element Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a -> Put) -> [a] -> Put
forall a. (a -> Put) -> [a] -> Put
_fputList a -> Put
func [a]
elements

_putString :: String -> Put
_putString :: String -> Put
_putString String
string = let byteString :: ByteString
byteString = String -> ByteString
BSUTF8.fromString String
string
  in Int32 -> Put
putInt32be (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
byteString))
  Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putByteString ByteString
byteString

_putInt32 :: Int -> Put
_putInt32 :: Int -> Put
_putInt32 Int
value = Int32 -> Put
putInt32be (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
value::Int))

_putBool :: Bool -> Put
_putBool :: Bool -> Put
_putBool Bool
bool = Word8 -> Put
putWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
bool))

_compileInstruction :: Instruction -> Put
-- NoOp
_compileInstruction :: Instruction -> Put
_compileInstruction Instruction
NoOp = Instruction -> Put
_putOpCodeFromInstruction Instruction
NoOp
-- PushI
_compileInstruction (PushI Int
value) =
  Instruction -> Put
_putOpCodeFromInstruction (Int -> Instruction
PushI Int
value) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
_putInt32 Int
value
-- PushB
_compileInstruction (PushB Bool
bool) =
  Instruction -> Put
_putOpCodeFromInstruction (Bool -> Instruction
PushB Bool
bool) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Put
_putBool Bool
bool
-- PushSym
_compileInstruction (PushSym String
symbolName Maybe [[Instruction]]
Nothing) =
  Instruction -> Put
_putOpCodeFromInstruction (String -> Maybe [[Instruction]] -> Instruction
PushSym String
symbolName Maybe [[Instruction]]
forall a. Maybe a
Nothing)
  Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
_putString String
symbolName
_compileInstruction (PushSym String
symbolName (Just [[Instruction]]
symbolArgs)) =
  ([Instruction] -> Put) -> [[Instruction]] -> Put
forall a. (a -> Put) -> [a] -> Put
_fputList [Instruction] -> Put
compileInstructions [[Instruction]]
symbolArgs
  Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Instruction -> Put
_putOpCodeFromInstruction (Int -> Instruction
PushI ([[Instruction]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Instruction]]
symbolArgs))
  Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
_putInt32 ([[Instruction]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Instruction]]
symbolArgs)
  Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Instruction -> Put
_putOpCodeFromInstruction (String -> Maybe [[Instruction]] -> Instruction
PushSym String
symbolName ([[Instruction]] -> Maybe [[Instruction]]
forall a. a -> Maybe a
Just [[Instruction]]
symbolArgs))
  Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
_putString String
symbolName Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Instruction -> Put
_putOpCodeFromInstruction Instruction
Compiler.Call
-- PushStr
_compileInstruction (PushStr String
stringValue) =
  Instruction -> Put
_putOpCodeFromInstruction (String -> Instruction
PushStr String
stringValue) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
_putString String
stringValue
-- PushList
_compileInstruction (PushList Int
nbListValues [[Instruction]]
listValues) =
  Instruction -> Put
_putOpCodeFromInstruction (Int -> [[Instruction]] -> Instruction
PushList Int
nbListValues [[Instruction]]
listValues)
  Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
_putInt32 Int
nbListValues Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Instruction] -> Put) -> [[Instruction]] -> Put
forall a. (a -> Put) -> [a] -> Put
_fputList [Instruction] -> Put
compileInstructions [[Instruction]]
listValues
-- PushArg
_compileInstruction (PushArg Int
index) =
  Instruction -> Put
_putOpCodeFromInstruction (Int -> Instruction
PushArg Int
index) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
_putInt32 Int
index
-- PutArg
_compileInstruction Instruction
PutArg =
  Instruction -> Put
_putOpCodeFromInstruction Instruction
PutArg
-- Jump
_compileInstruction (Jump Int
branchOffset) =
  Instruction -> Put
_putOpCodeFromInstruction (Int -> Instruction
Jump Int
branchOffset)
  Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
_putInt32 Int
branchOffset
-- JumpIfFalse
_compileInstruction (JumpIfFalse Int
branchOffset) =
  Instruction -> Put
_putOpCodeFromInstruction (Int -> Instruction
JumpIfFalse Int
branchOffset)
  Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
_putInt32 Int
branchOffset
-- Add
_compileInstruction Instruction
Add = Instruction -> Put
_putOpCodeFromInstruction Instruction
Add
-- Sub
_compileInstruction Instruction
Sub = Instruction -> Put
_putOpCodeFromInstruction Instruction
Sub
-- Mul
_compileInstruction Instruction
Mul = Instruction -> Put
_putOpCodeFromInstruction Instruction
Mul
-- Div
_compileInstruction Instruction
Div = Instruction -> Put
_putOpCodeFromInstruction Instruction
Div
-- Mod
_compileInstruction Instruction
Mod = Instruction -> Put
_putOpCodeFromInstruction Instruction
Mod
-- XorB
_compileInstruction Instruction
XorB = Instruction -> Put
_putOpCodeFromInstruction Instruction
XorB
-- Eq
_compileInstruction Instruction
Eq = Instruction -> Put
_putOpCodeFromInstruction Instruction
Eq
-- NotEq
_compileInstruction Instruction
NotEq = Instruction -> Put
_putOpCodeFromInstruction Instruction
NotEq
-- Less
_compileInstruction Instruction
Less = Instruction -> Put
_putOpCodeFromInstruction Instruction
Less
-- LessEq
_compileInstruction Instruction
LessEq = Instruction -> Put
_putOpCodeFromInstruction Instruction
LessEq
-- Great
_compileInstruction Instruction
Great = Instruction -> Put
_putOpCodeFromInstruction Instruction
Great
-- GreatEq
_compileInstruction Instruction
GreatEq = Instruction -> Put
_putOpCodeFromInstruction Instruction
GreatEq
-- And
_compileInstruction Instruction
And = Instruction -> Put
_putOpCodeFromInstruction Instruction
And
-- Or
_compileInstruction Instruction
Or = Instruction -> Put
_putOpCodeFromInstruction Instruction
Or
-- Not
_compileInstruction Instruction
Not = Instruction -> Put
_putOpCodeFromInstruction Instruction
Not
-- Then
_compileInstruction Instruction
Then = Instruction -> Put
_putOpCodeFromInstruction Instruction
Then
-- ToStr
_compileInstruction Instruction
ToStr = Instruction -> Put
_putOpCodeFromInstruction Instruction
ToStr
-- Neg
_compileInstruction Instruction
Neg = Instruction -> Put
_putOpCodeFromInstruction Instruction
Neg
-- Call
_compileInstruction Instruction
Compiler.Call = Instruction -> Put
_putOpCodeFromInstruction Instruction
Compiler.Call
-- Ret
_compileInstruction Instruction
Ret = Instruction -> Put
_putOpCodeFromInstruction Instruction
Ret
-- Def
_compileInstruction (Def String
symbolName Int
nbInstruction [Instruction]
instructions)
  = Instruction -> Put
_putOpCodeFromInstruction (String -> Int -> [Instruction] -> Instruction
Def String
symbolName Int
nbInstruction [Instruction]
instructions)
    Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
_putString String
symbolName
    Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
_putInt32 Int
nbInstruction
    Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Instruction] -> Put
compileInstructions [Instruction]
instructions
-- Fnv
_compileInstruction (Fnv Int
nbArgsNames [String]
argsNames Int
nbFnBodyInsts
  [Instruction]
funcBodyInstructions [Int]
nbArgsValuesInstructions
  (Just [[Instruction]]
argsValuesInsts)) = ([Instruction] -> Put) -> [[Instruction]] -> Put
forall a. (a -> Put) -> [a] -> Put
_fputList [Instruction] -> Put
compileInstructions [[Instruction]]
argsValuesInsts
    Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Instruction -> Put
_putOpCodeFromInstruction (Int -> Instruction
PushI ([[Instruction]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Instruction]]
argsValuesInsts))
    Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
_putInt32 ([[Instruction]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Instruction]]
argsValuesInsts)
    Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Instruction -> Put
_putOpCodeFromInstruction (Int
-> [String]
-> Int
-> [Instruction]
-> [Int]
-> Maybe [[Instruction]]
-> Instruction
Fnv Int
nbArgsNames [String]
argsNames
    Int
nbFnBodyInsts [Instruction]
funcBodyInstructions [Int]
nbArgsValuesInstructions
    ([[Instruction]] -> Maybe [[Instruction]]
forall a. a -> Maybe a
Just [[Instruction]]
argsValuesInsts)) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
_putInt32 Int
nbArgsNames Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
_putInt32 Int
nbFnBodyInsts
    Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Instruction -> Put) -> [Instruction] -> Put
forall a. (a -> Put) -> [a] -> Put
_fputList Instruction -> Put
_compileInstruction [Instruction]
funcBodyInstructions
    Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Instruction -> Put
_putOpCodeFromInstruction Instruction
Compiler.Call
_compileInstruction (Fnv Int
nbArgsNames [String]
argsNames Int
nbFuncBodyInstructions
  [Instruction]
funcBodyInstructions [Int]
nbArgsValuesInstructions Maybe [[Instruction]]
Nothing) =
    Instruction -> Put
_putOpCodeFromInstruction (Int
-> [String]
-> Int
-> [Instruction]
-> [Int]
-> Maybe [[Instruction]]
-> Instruction
Fnv Int
nbArgsNames [String]
argsNames Int
nbFuncBodyInstructions
    [Instruction]
funcBodyInstructions [Int]
nbArgsValuesInstructions Maybe [[Instruction]]
forall a. Maybe a
Nothing)
    Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
_putInt32 Int
nbArgsNames
    Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
_putInt32 Int
nbFuncBodyInstructions
    Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Instruction -> Put) -> [Instruction] -> Put
forall a. (a -> Put) -> [a] -> Put
_fputList Instruction -> Put
_compileInstruction [Instruction]
funcBodyInstructions
-- Cond
_compileInstruction (Compiler.Cond [Instruction]
condInstructions
  Int
nbTrueBlockInstructions [Instruction]
trueBlockInstructions
  (Just [Instruction]
falseBlockInstructions)) =
    (Instruction -> Put) -> [Instruction] -> Put
forall a. (a -> Put) -> [a] -> Put
_fputList Instruction -> Put
_compileInstruction [Instruction]
condInstructions
    Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Instruction -> Put
_compileInstruction (Int -> Instruction
JumpIfFalse Int
nbTrueBlockInstructions)
    Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Instruction -> Put) -> [Instruction] -> Put
forall a. (a -> Put) -> [a] -> Put
_fputList Instruction -> Put
_compileInstruction [Instruction]
trueBlockInstructions
    Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Instruction -> Put) -> [Instruction] -> Put
forall a. (a -> Put) -> [a] -> Put
_fputList Instruction -> Put
_compileInstruction [Instruction]
falseBlockInstructions
_compileInstruction (Compiler.Cond [Instruction]
condInstructions
  Int
nbTrueBlockInstructions [Instruction]
trueBlockInstructions Maybe [Instruction]
Nothing) =
    (Instruction -> Put) -> [Instruction] -> Put
forall a. (a -> Put) -> [a] -> Put
_fputList Instruction -> Put
_compileInstruction [Instruction]
condInstructions
    Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Instruction -> Put
_compileInstruction (Int -> Instruction
JumpIfFalse Int
nbTrueBlockInstructions)
    Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Instruction -> Put) -> [Instruction] -> Put
forall a. (a -> Put) -> [a] -> Put
_fputList Instruction -> Put
_compileInstruction [Instruction]
trueBlockInstructions
-- Apnd
_compileInstruction Instruction
Apnd = Instruction -> Put
_putOpCodeFromInstruction Instruction
Apnd
-- RemAllOcc
_compileInstruction Instruction
RemAllOcc = Instruction -> Put
_putOpCodeFromInstruction Instruction
RemAllOcc
-- Get
_compileInstruction Instruction
Get = Instruction -> Put
_putOpCodeFromInstruction Instruction
Get
-- Len
_compileInstruction Instruction
Len = Instruction -> Put
_putOpCodeFromInstruction Instruction
Len

compileInstructions :: [Instruction] -> Put
compileInstructions :: [Instruction] -> Put
compileInstructions = (Instruction -> Put) -> [Instruction] -> Put
forall a. (a -> Put) -> [a] -> Put
_fputList Instruction -> Put
_compileInstruction

writeCompiledInstructionsToFile :: String -> Put -> IO()
writeCompiledInstructionsToFile :: String -> Put -> IO ()
writeCompiledInstructionsToFile String
filepath Put
compiledInsts =
  String -> ByteString -> IO ()
BS.writeFile String
filepath ([ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BSL.toChunks (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut Put
compiledInsts)

compile :: [Ast] -> String -> Bool -> IO()
compile :: [Ast] -> String -> Bool -> IO ()
compile [Ast]
ast String
filepath Bool
showInst = if Bool
showInst
  then [Instruction] -> IO ()
showInstructions [Instruction]
instructions
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put -> IO ()
writeCompiledInstructionsToFile String
filepath Put
compiledInstructions
  else String -> Put -> IO ()
writeCompiledInstructionsToFile String
filepath Put
compiledInstructions
  where
    instructions :: [Instruction]
instructions = (Ast -> [Instruction]) -> [Ast] -> [Instruction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ast -> [Instruction]
astToInstructions [Ast]
ast [Instruction] -> [Instruction] -> [Instruction]
forall a. [a] -> [a] -> [a]
++ [Instruction
Ret]
    compiledInstructions :: Put
compiledInstructions = Int -> Put
_putInt32 (CompileConstants -> Int
forall a. Enum a => a -> Int
fromEnum CompileConstants
MagicNumber) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
      (Instruction -> Put) -> [Instruction] -> Put
forall a. (a -> Put) -> [a] -> Put
_fputList Instruction -> Put
_compileInstruction [Instruction]
instructions