started with interpreter for basic language

diff --git a/Makefile b/Makefile
index 104f190..28bd5d5 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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 (file)
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 (file)
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 (file)
--- 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 (file)
--- 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]