From: Mart Lubbers <mart@martlubbers.net>
Date: Wed, 9 Nov 2016 19:46:44 +0000 (+0100)
Subject: started with interpreter for basic language
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=48dfd7ad2f104321657a3ea44d33340761c95c2e;p=mTask.git

started with interpreter for basic language
---

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 <stdio.h>
+
+#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]