aboutsummaryrefslogtreecommitdiff
path: root/Sjit
diff options
context:
space:
mode:
Diffstat (limited to 'Sjit')
-rw-r--r--Sjit/Compile.dcl17
-rw-r--r--Sjit/Compile.icl43
-rw-r--r--Sjit/Run.dcl1
-rw-r--r--Sjit/Run.icl51
-rw-r--r--Sjit/Syntax.icl22
5 files changed, 58 insertions, 76 deletions
diff --git a/Sjit/Compile.dcl b/Sjit/Compile.dcl
index d373e42..e630178 100644
--- a/Sjit/Compile.dcl
+++ b/Sjit/Compile.dcl
@@ -13,17 +13,24 @@ from Sjit.Syntax import :: Function
| Call !Int
| Jmp !Int
- | JmpTrue !Int
+ | JmpCond !Cond !Int
| Ret
| Halt
- | IAdd
- | IMul
- | ISub
- | IDiv
+ | Op !Op
| PlaceHolder !Int !Int // only used during compilation
+:: Op
+ = OAdd | OMul
+ | OSub | ODiv
+
+:: Cond
+ = CEq | CNe
+ | CLt | CLe
+ | CGt | CGe
+ | CTrue
+
:: Program :== {!Instr}
:: CompileState =
diff --git a/Sjit/Compile.icl b/Sjit/Compile.icl
index 527676f..b5ea1bf 100644
--- a/Sjit/Compile.icl
+++ b/Sjit/Compile.icl
@@ -98,13 +98,10 @@ where
Pop n -> 0-n
Call _ -> 0
Jmp _ -> 0
- JmpTrue _ -> 0
+ JmpCond c _ -> if (c=:CTrue) -1 -2
Ret -> -1
Halt -> -2
- IAdd -> -1
- IMul -> -1
- ISub -> -1
- IDiv -> -1
+ Op _ -> -1
PlaceHolder _ n -> n
reserve :: !Int !CompileState -> m (!Int, !CompileState) | Monad m
@@ -152,20 +149,38 @@ where
# args = if (args=:[]) [Int 0] args
= foldM (flip expr) cs (reverse args) >>= \cs -> case get f cs.funs of
Nothing -> case f of
- "+" -> gen [IAdd] cs
- "-" -> gen [ISub] cs
- "*" -> gen [IMul] cs
- "/" -> gen [IDiv] cs
- _ -> Left ("undefined function '" +++ toString f +++ "'")
+ "+" -> gen [Op OAdd] cs
+ "-" -> gen [Op OSub] cs
+ "*" -> gen [Op OMul] cs
+ "/" -> gen [Op ODiv] cs
+ _ -> Left ("undefined function '" +++ toString f +++ "'")
Just f -> case length args of
1 -> gen [Call f] cs
n -> gen [Pop (n-1),Call f] cs
+ expr (If (App cond [a,b]) t e) cs | isJust condop =
+ expr a cs >>=
+ expr b >>=
+ reserve -2 >>= \(jmpcond,cs=:{sp=orgsp}) ->
+ expr e cs >>=
+ reserve 0 >>= \(jmpend,cs) ->
+ fillPlaceHolder jmpcond (JmpCond (fromJust condop) cs.pc) {cs & sp=orgsp} >>=
+ expr t >>= \cs ->
+ fillPlaceHolder jmpend (Jmp cs.pc) cs
+ where
+ condop = case cond of
+ "==" -> Just CEq
+ "<>" -> Just CNe
+ "<" -> Just CLt
+ "<=" -> Just CLe
+ ">" -> Just CGt
+ ">=" -> Just CGe
+ _ -> Nothing
expr (If b t e) cs =
expr b cs >>=
- reserve -1 >>= \(jmptrue,cs=:{sp=orgsp}) ->
+ reserve -1 >>= \(jmpcond,cs=:{sp=orgsp}) ->
expr e cs >>=
reserve 0 >>= \(jmpend,cs) ->
- fillPlaceHolder jmptrue (JmpTrue cs.pc) {cs & sp=orgsp} >>=
+ fillPlaceHolder jmpcond (JmpCond CTrue cs.pc) {cs & sp=orgsp} >>=
expr t >>= \cs ->
fillPlaceHolder jmpend (Jmp cs.pc) cs
@@ -198,8 +213,8 @@ gEncode{|EITHER|} _ fr (RIGHT r) i arr = fr r i arr
gEncode{|CONS of {gcd_index}|} fx (CONS x) i arr = fx x (i+1) {arr & [i]=gcd_index}
gEncode{|OBJECT|} fx (OBJECT x) i arr = fx x i arr
-derive gEncodedSize Instr
-derive gEncode Instr
+derive gEncodedSize Cond, Op, Instr
+derive gEncode Cond, Op, Instr
encode :: !a -> *{#Int} | gEncodedSize{|*|}, gEncode{|*|} a
encode x
diff --git a/Sjit/Run.dcl b/Sjit/Run.dcl
index aff22fc..371f4f5 100644
--- a/Sjit/Run.dcl
+++ b/Sjit/Run.dcl
@@ -2,5 +2,4 @@ definition module Sjit.Run
from Sjit.Compile import :: CompileState
-interpret :: !CompileState -> Int
exec :: !CompileState -> Int
diff --git a/Sjit/Run.icl b/Sjit/Run.icl
index ad03e02..8bd3972 100644
--- a/Sjit/Run.icl
+++ b/Sjit/Run.icl
@@ -7,57 +7,6 @@ from Data.Map import :: Map(..), get
import Sjit.Compile
-interpret :: !CompileState -> Int
-interpret cs = exec 0 []
-where
- prog = get_program cs
- sz = size prog
-
- exec :: !Int ![Int] -> Int
- exec i stack
- | i < 0 || i >= sz = abort "out of bounds\n"
- | otherwise = case prog.[i] of
- PushI n -> exec (i+1) [n:stack]
- PushRef r -> exec (i+1) [stack!!r:stack]
- Put n -> case stack of
- [val:stack] -> exec (i+1) (take (n-1) stack ++ [val:drop n stack])
- Pop n -> exec (i+1) (drop n stack)
- Call f -> exec f [i+1:stack]
- Jmp f -> exec f stack
- JmpTrue f -> case stack of
- [0:stack] -> exec (i+1) stack
- [_:stack] -> exec f stack
- Ret -> case stack of
- [ret:stack] -> exec ret stack
- Halt -> case stack of
- [r] -> r
- _ -> abort (toString (length stack) +++ " values left on stack\n")
-
- IAdd -> case stack of
- [a:b:stack] -> exec (i+1) [a+b:stack]
- IMul -> case stack of
- [a:b:stack] -> exec (i+1) [a*b:stack]
- ISub -> case stack of
- [a:b:stack] -> exec (i+1) [a-b:stack]
- IDiv -> case stack of
- [a:b:stack] -> exec (i+1) [a/b:stack]
-
- get_program :: !CompileState -> Program
- get_program cs
- # prog = loop 0 cs.blocks (createArray (sum [size b \\ b <|- cs.blocks]) Halt)
- # prog & [1] = Call (fromJust (get "main" cs.funs))
- = prog
- where
- loop :: !Int ![!Program!] !*Program -> .Program
- loop i [!b:bs!] prog
- # (i,prog) = copy i 0 (size b-1) b prog
- = loop i bs prog
- where
- copy :: !Int !Int !Int !Program !*Program -> *(!Int, !*Program)
- copy i _ -1 _ prog = (i, prog)
- copy i bi n b prog = copy (i+1) (bi+1) (n-1) b {prog & [i]=b.[bi]}
- loop _ [!!] prog = prog
-
exec :: !CompileState -> Int
exec {jitst} = exec jitst.code_start
where
diff --git a/Sjit/Syntax.icl b/Sjit/Syntax.icl
index 90aeb39..e382696 100644
--- a/Sjit/Syntax.icl
+++ b/Sjit/Syntax.icl
@@ -5,9 +5,12 @@ import StdEnv
import Control.Applicative
import Control.Monad
import Data.Either
+from Data.Foldable import class Foldable(foldr1)
from Data.Func import $
import Data.Functor
import Data.GenEq
+from Data.List import instance Foldable []
+import Data.Maybe
import Text.Parsers.Simple.Core
:: Token
@@ -60,13 +63,15 @@ where
n | isFunnyIdent n
# (i,n) = readIdent isFunnyIdent [] i e s
- -> lex [TIdent n:tks] i e s
+ # tk = case n of
+ "=" -> TEq
+ n -> TIdent n
+ -> lex [tk:tks] i e s
n | isDigit n
# (i,n) = readInt [] i e s
-> lex [TInt n:tks] i e s
- '=' -> lex [TEq: tks] (i+1) e s
',' -> lex [TComma: tks] (i+1) e s
'(' -> lex [TParenOpen: tks] (i+1) e s
')' -> lex [TParenClose:tks] (i+1) e s
@@ -77,7 +82,7 @@ where
isIdent c = isAlpha c || c == '_'
isFunnyIdent :: !Char -> Bool
- isFunnyIdent c = isMember c ['+-*/']
+ isFunnyIdent c = isMember c ['+-*/<>=']
readIdent :: !(Char -> Bool) ![Char] !Int !Int !String -> (!Int, !String)
readIdent ok cs i e s
@@ -102,12 +107,19 @@ where
expr :: Parser Token Expr
expr
- = leftAssoc (tok "+" <|> tok "-")
- $ leftAssoc (tok "*" <|> tok "/")
+ = rightAssoc (toks ["==","<>","<","<=",">",">="])
+ $ leftAssoc (toks ["+","-"])
+ $ leftAssoc (toks ["*","/"])
$ noInfix
where
tok :: !String -> Parser Token String
tok s = pToken (TIdent s) $> s
+ toks = foldr1 (<|>) o map tok
+
+ rightAssoc :: !(Parser Token String) !(Parser Token Expr) -> Parser Token Expr
+ rightAssoc opp exprp = exprp >>= \e1 ->
+ optional (opp >>= \op -> rightAssoc opp exprp >>= \e -> pure (op,e)) >>=
+ pure o maybe e1 (\(op,e2) -> App op [e1,e2])
leftAssoc :: !(Parser Token String) !(Parser Token Expr) -> Parser Token Expr
leftAssoc opp exprp = exprp >>= \e1 ->
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-12 15:42:24 +0000