From 48dfd7ad2f104321657a3ea44d33340761c95c2e Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Wed, 9 Nov 2016 20:46:44 +0100 Subject: [PATCH] started with interpreter for basic language --- Makefile | 2 +- gCons.dcl | 4 +- gCons.icl | 2 + int/.gitignore | 2 + int/int.c | 120 +++++++++++++++++++++++++++++++++++++++++++++ int/mTaskSymbols.h | 23 +++++++++ mTaskInterpret.dcl | 1 - mTaskInterpret.icl | 43 ++++++++++------ 8 files changed, 177 insertions(+), 20 deletions(-) create mode 100644 int/.gitignore create mode 100644 int/int.c create mode 100644 int/mTaskSymbols.h diff --git a/Makefile b/Makefile index 104f190..28bd5d5 100644 --- a/Makefile +++ b/Makefile @@ -27,7 +27,7 @@ BINARIES:= mTaskExamples mTaskInterpret all: $(BINARIES) -%: %.icl $(wildcard *.dcl) +%: %.icl $(wildcard *.[id]cl) $(CLM) $(CLMLIBS) $(CLMFLAGS) $(basename $<) -o $@ clean: diff --git a/gCons.dcl b/gCons.dcl index 827c637..c43236a 100644 --- a/gCons.dcl +++ b/gCons.dcl @@ -10,7 +10,7 @@ definition module gCons import StdGeneric generic consName a :: a -> String -derive consName CONS of {gcd_name},UNIT,PAIR,EITHER,OBJECT,RECORD,FIELD,Int,Bool,Char,(->) +derive consName CONS of {gcd_name},UNIT,PAIR,EITHER,OBJECT,RECORD,FIELD,Int,Bool,Char,String,(->) generic consIndex a :: a -> Int -derive consIndex CONS of {gcd_index},UNIT,PAIR,EITHER,OBJECT,Int,Bool,Char +derive consIndex CONS of {gcd_index},UNIT,PAIR,EITHER,OBJECT,Int,Bool,Char,String diff --git a/gCons.icl b/gCons.icl index fff9450..3446116 100644 --- a/gCons.icl +++ b/gCons.icl @@ -21,6 +21,7 @@ consName{|FIELD|} f (FIELD x) = f x consName{|Int|} i = toString i consName{|Bool|} b = toString b consName{|Char|} c = toString c +consName{|String|} s = s consName{|(->)|} f g x = g (x undef) generic consIndex a :: a -> Int @@ -33,3 +34,4 @@ consIndex{|OBJECT|} f (OBJECT x) = f x consIndex{|Int|} i = i consIndex{|Bool|} b = if b 1 0 consIndex{|Char|} c = toInt c +consIndex{|String|} _ = 0 diff --git a/int/.gitignore b/int/.gitignore new file mode 100644 index 0000000..9162877 --- /dev/null +++ b/int/.gitignore @@ -0,0 +1,2 @@ +int +Makefile diff --git a/int/int.c b/int/int.c new file mode 100644 index 0000000..71d3b4c --- /dev/null +++ b/int/int.c @@ -0,0 +1,120 @@ +#include + +#include "mTaskSymbols.h" + +#define STACKSIZE 1024 +#define PROGRAMSIZE 1024 + +#define DEBUG +#ifdef DEBUG +#define debug(s, ...) printf(s, ##__VA_ARGS__); +#else +#define debug(s, ...) ; +#endif + +#define die(s, ...) {fprintf(stderr, s, ##__VA_ARGS__); return 1;} + +char program[PROGRAMSIZE+1] = {0}; +int stack[STACKSIZE+1] = {0}; + +int main(void) +{ + // + char c; + int pl, sp, pc; + + //Read program + pc = 0; + while ((c = getchar()) != EOF && pc < PROGRAMSIZE) + program[pc++] = c; + if (pc >= PROGRAMSIZE) + die("Max program size: %d\n", PROGRAMSIZE); + pl = pc; + debug("Done reading, program length: %d\n", pl); + + //Evaluate program + //Reset program counter and stack counter + pc = 0; + sp = 0; + while(pc != pl){ + switch(program[pc++]){ + case BCNop:; + break; + case BCPush: + stack[sp++] = program[pc++]; + break; + case BCPop: + sp--; + break; + case BCNot: + stack[sp] = stack[sp] > 0 ? 0 : 1; + break; + case BCAdd: + stack[sp-1] = stack[sp] + stack[sp-1]; + sp -= 1; + break; + case BCSub: + stack[sp-1] = stack[sp] - stack[sp-1]; + sp -= 1; + break; + case BCMul: + stack[sp-1] = stack[sp] * stack[sp-1]; + sp -= 1; + break; + case BCDiv: + stack[sp-1] = stack[sp] / stack[sp-1]; + sp -= 1; + break; + case BCAnd: + stack[sp-1] = stack[sp] && stack[sp-1]; + sp -= 1; + break; + case BCOr: + stack[sp-1] = stack[sp] || stack[sp-1]; + sp -= 1; + break; + case BCEq: + stack[sp-1] = stack[sp] == stack[sp-1]; + sp -= 1; + break; + case BCNeq: + stack[sp-1] = stack[sp] != stack[sp-1]; + sp -= 1; + break; + case BCLes: + stack[sp-1] = stack[sp] < stack[sp-1]; + sp -= 1; + break; + case BCGre: + stack[sp-1] = stack[sp] > stack[sp-1]; + sp -= 1; + break; + case BCLeq: + stack[sp-1] = stack[sp] <= stack[sp-1]; + sp -= 1; + break; + case BCGeq: + stack[sp-1] = stack[sp] >= stack[sp-1]; + sp -= 1; + break; + case BCJmp: + pc = pc + program[pc]; + break; + case BCJmpT: + if (stack[sp]) + pc = pc + program[pc]; + else + pc++; + break; + case BCJmpF: + if (stack[sp]) + pc++; + else + pc = pc + program[pc]; + break; + default: + die("Unrecognized command: %X\n", program[--pc]); + } + } + return 0; +} diff --git a/int/mTaskSymbols.h b/int/mTaskSymbols.h new file mode 100644 index 0000000..d4b75e9 --- /dev/null +++ b/int/mTaskSymbols.h @@ -0,0 +1,23 @@ +#ifndef MTASK_H +#define MTASK_H +#define BCNop 0 +#define BCPush 1 +#define BCPop 2 +#define BCNeg 3 +#define BCNot 4 +#define BCAdd 5 +#define BCSub 6 +#define BCMul 7 +#define BCDiv 8 +#define BCAnd 9 +#define BCOr 10 +#define BCEq 11 +#define BCNeq 12 +#define BCLes 13 +#define BCGre 14 +#define BCLeq 15 +#define BCGeq 16 +#define BCJmp 17 +#define BCJmpT 18 +#define BCJmpF 19 +#endif diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl index 5a80189..885d52e 100644 --- a/mTaskInterpret.dcl +++ b/mTaskInterpret.dcl @@ -9,7 +9,6 @@ import mTask | BCPush String | BCPop //Unary ops - | BCNeg | BCNot //Binary Int ops | BCAdd diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl index 80286f2..eaded85 100644 --- a/mTaskInterpret.icl +++ b/mTaskInterpret.icl @@ -5,17 +5,17 @@ import gdynamic, gCons, GenEq, StdMisc, StdArray import GenPrint import mTask +import StdFile +import StdString + from StdFunc import o import StdTuple import Data.Tuple -import Data.Functor import StdList -import Control.Applicative -import Control.Monad -import Data.Monoid -import Control.Monad.State -import Control.Monad.Identity from Data.Func import $ +from Text import class Text(join), instance Text String + + toByteVal :: BC -> String @@ -46,13 +46,15 @@ instance boolExpr ByteCode where instance If ByteCode Stmt Stmt Stmt where If b t e = BCIfStmt b t e instance If ByteCode Stmt e Stmt where If b t e = BCIfStmt b t e -instance If ByteCode Stmt Stmt e where If b t e = BCIfStmt b t e -instance If ByteCode Stmt x y where If b t e = BCIfStmt b t e +//instance If ByteCode Stmt Stmt e where If b t e = BCIfStmt b t e +//instance If ByteCode Stmt x y where If b t e = BCIfStmt b t e instance IF ByteCode where IF b t e = BCIfStmt b t e (?) b t = BCIfStmt b t $ BC [] BCIfStmt b t e = b <+-> [BCJmpF $ length <$> t + 1] <++> t <+-> [BCJmp $ length <$> e] <++> e +instance noOp ByteCode where noOp = BC [] + (<++>) infixl 7 (<++>) (BC x) (BC y) = BC $ x ++ y @@ -74,11 +76,20 @@ instance serial ByteCode where instance zero BCState where zero = {a=()} -//runByteCode :: (ByteCode Int Expr) BCState -> [BC] -//runByteCode (BC f) s = evalState f s -//runByteCode (BC f) s = fst (f Rd s) - -//Start :: Main (ByteCode Int Expr) -//Start :: [BC] -Start :: ByteCode Int Expr -Start = (lit 36 +. lit 42) +. lit 84 +//Start :: ByteCode Int Expr +//Start = (lit 36 +. lit 42) +. lit 84 +// +derive consIndex BC +derive consName BC + +Start w +# (io, w) = stdio w +# io = io <<< "#ifndef MTASK_H\n#define MTASK_H\n" +# io = io <<< join "\n" ["#define " +++ consName{|*|} x +++ " " +++ toString (consIndex{|*|} x)\\x<-allBC] +# (ok, w) = fclose (io <<< "\n#endif\n") w +| not ok = abort "Couldn't close stdio" += w + where + allBC = [BCNop, BCPush "", BCPop, BCNeg, BCNot, BCAdd, BCSub, BCMul, + BCDiv, BCAnd, BCOr, BCEq, BCNeq, BCLes, BCGre, BCLeq, BCGeq, + BCJmp 0, BCJmpT 0, BCJmpF 0] -- 2.20.1