add interpreter

.gitignore

@@ -0,0 +1,3 @@
+dist/
+*.bf
+bfi/bfi

Main.hs

@@ -22,7 +22,6 @@ import qualified Front
 import qualified Core
 import qualified GMachine
 import qualified SAM
-import qualified SCGR
 import qualified Brainfuck
 
 

README

@@ -0,0 +1 @@
+You can run `./conv` followed by `./auto-test` (you need fish)

auto-test

@@ -3,8 +3,8 @@
 function test_bf
     echo "=== $argv[1] ==="
     rm -f test/(basename $argv[1] .hs).bf
-    ~/devenv/hs2bf/hs2bf --make $argv[1] > test/(basename $argv[1] .hs).bf
-    time -f 'user:%U sys:%S' ~/bin/bfi test/(basename $argv[1] .hs).bf
+    dist/build/hs2bf/hs2bf --make $argv[1] > test/(basename $argv[1] .hs).bf
+    time -f 'user:%U sys:%S' bfi/bfi test/(basename $argv[1] .hs).bf
     echo ""
 end
 

bfi/conv

@@ -0,0 +1,3 @@
+#!/bin/env fish
+
+gcc -O3 main.c -o bfi

bfi/main.c

@@ -0,0 +1,105 @@
+#include <stdio.h>
+#include <stdlib.h>
+
+#define MEM_SIZE (20*1000*1000) // 20MB
+
+
+void run(FILE *log,char *code){
+    char *code_base=code;
+
+    unsigned char *ptr_base=malloc(MEM_SIZE);
+    memset(ptr_base,0,MEM_SIZE);
+
+    unsigned char *ptr=ptr_base;
+
+    long stp=0;
+    while(*code){
+        /*
+        if(log)
+            fprintf(log,"%c %d %d\n",*code,code-code_base,ptr-ptr_base);
+        */
+        stp++;
+        switch(*code){
+            case '>': ++ptr; break;
+            case '<': --ptr; break;
+            case '+': ++*ptr; break;
+            case '-': --*ptr; break;
+            case '.': fwrite(ptr,1,1,stdout); break;
+            case ',': fread(ptr,1,1,stdin); break;
+            case '[':
+                if(*ptr==0){
+                    int c=1;
+                    while(c>0){
+                        code++;
+                        if(*code=='[') c++;
+                        if(*code==']') c--;
+                    }
+                }
+                break;
+            case ']':
+                if(*ptr!=0){
+                    int c=1;
+                    while(c>0){
+                        code--;
+                        if(*code==']') c++;
+                        if(*code=='[') c--;
+                    }
+                }
+            default:
+                stp--;
+        }
+
+        code++;
+    }
+    fprintf(stderr,"%lld steps\n",stp);
+
+    free(ptr_base);
+}
+
+int main(int argc,char **argv){
+    if(argc!=2 && argc!=3){
+        printf("usage: bfi <file> (compiled with MEM_SIZE=%d)\n",MEM_SIZE);
+        printf("usage: bfi <file> <prof> (compiled with MEM_SIZE=%d)\n",MEM_SIZE);
+        return -1;
+    }
+
+    // open
+    FILE *fp=fopen(argv[1],"r");
+    if(fp==NULL){
+        printf("could not open %s\n",argv[1]);
+        return -2;
+    }
+
+    fseek(fp,0,SEEK_END);
+    int size=ftell(fp);
+    fseek(fp,0,SEEK_SET);
+
+    char *code=malloc(size+1);
+    fread(code,size,1,fp);
+    code[size]=0;
+
+    // close
+    fclose(fp);
+
+    setbuf(stdin,NULL);
+    setbuf(stdout,NULL);
+    fflush(stdin);
+    fflush(stdout);
+
+    // open optional log file
+    FILE *log=NULL;
+    if(argc==3){
+        log=fopen(argv[2],"w");
+        if(log==NULL){
+            printf("could not open %s\n",argv[2]);
+            return -2;
+        }
+    }
+
+    run(log,code);
+    free(code);
+    if(log) fclose(log);
+
+    return 0;
+}
+

conv

@@ -1,6 +1,8 @@
 #!/bin/env fish
 
-set PROG ./hs2bf
-
-ghc --make Main -O -o $PROG
+cd bfi
+./conv
+cd ..
 
+cabal configure
+cabal build

hs2bf.cabal

@@ -16,7 +16,7 @@ data-files:      Prelude.hs
 data-dir:        test
 tested-with:     GHC==6.12.1
 extra-source-files:
-    Front.hs Core.hs GMachine.hs SAM.hs SCGR.hs Brainfuck.hs
+    Front.hs Core.hs GMachine.hs SAM.hs Brainfuck.hs
     Util.hs SRuntime.hs
 executable hs2bf
     main-is: Main.hs

make-each

@@ -1,6 +1,6 @@
 #!/bin/env fish
 
-set PROG ./hs2bf
+set PROG dist/build/hs2bf/hs2bf
 set FILE $argv[1]
 
 function compile

test/Prelude.hs

@@ -0,0 +1,174 @@
+
+-- internal
+seq=undefined
+undefined=undefined
+addByteRaw=undefined
+subByteRaw=undefined
+cmpByteRaw=undefined
+
+
+-- generic combinanors
+infixr 9 .
+(.) f g x=f (g x)
+
+infixr 0 $
+f $ x=f x
+
+infixr 0 $!
+f $! x=x `seq` (f x)
+
+
+id x=x
+flip f x y=f y x
+
+
+-- boolean
+data Bool
+    =False
+    |True
+
+infixr 2 ||
+x || y=
+    case x of
+        True  -> True
+        False -> y
+
+infixr 3 &&
+x && y=
+    case x of
+        False -> False
+        True  -> y
+
+otherwise=True
+
+
+-- maybe
+data Maybe a
+    =Nothing
+    |Just a
+
+
+-- either
+data Either a b
+    =Left a
+    |Right b
+
+
+-- ordering
+data Ordering
+    =EQ -- 0
+    |LT -- 1
+    |GT -- 2
+
+
+-- tuple
+data XT1 a=XT1 a
+data XT2 a b=XT2 a b
+data XT3 a b c=XT3 a b c
+
+
+
+-- list
+data XList a
+    =XCons a (XList a)
+    |XNil
+
+
+head (x:xs)=x
+tail (x:xs)=xs
+
+reverse []=[]
+reverse (x:xs)=reverse xs++[x]
+
+map f []=[]
+map f (x:xs)=f x:map f xs
+
+filter f []=[]
+filter f (x:xs)
+    |f x       = x:filter f xs
+    |otherwise = filter f xs
+
+(x:xs) !! n
+    |n `eqByte` 0 = x
+    |otherwise    = xs !! (n `subByte` 1)
+
+xs ++ ys=
+    case xs of
+        []   -> ys
+        x:xs -> x:(xs++ys)
+
+
+{- I don't know why, but this code doesn't work!
+[]++ys=ys
+(x:xs)++ys=x:(xs++ys)
+-}
+
+
+
+length []=0
+length (x:xs)=1 `addByte` (length xs)
+
+foldr f z []=z
+foldr f z (x:xs)=f x (foldr f z xs)
+
+foldl f z []=z
+foldl f z (x:xs)=foldl f (f x z) xs
+
+
+-- I/O
+data E
+    =Input (Char -> E)
+    |Output !Char E
+    |Halt
+
+
+
+
+
+
+addByte x y=x `seq` (y `seq` (addByteRaw x y))
+subByte x y=x `seq` (y `seq` (subByteRaw x y))
+cmpByte x y=x `seq` (y `seq` (cmpByteRaw x y))
+
+eqByte x y=case cmpByte x y of
+    EQ -> True
+    s  -> False
+
+ltByte x y=case cmpByte x y of
+    LT -> True
+    s  -> False
+
+gtByte x y=case cmpByte x y of
+    GT -> True
+    s  -> False
+
+leByte x y=case cmpByte x y of
+    GT -> False
+    s  -> True
+
+geByte x y=case cmpByte x y of
+    LT -> False
+    s  -> True
+
+{-
+data Int
+    =PInt Byte
+    |NInt Byte
+
+
+negateInt (PInt x)=NInt x
+negateInt (NInt x)=PInt x
+
+addInt (PInt x) (PInt y)=PInt $ x `addByte` y
+addInt (NInt x) (NInt y)=NInt $ x `addByte` y
+addInt (PInt x) (NInt y)
+    |x `gtByte` y = PInt $ x `subByte` y
+    |otherwise    = NInt $ y `subByte` x
+addInt (NInt x) (PInt y)
+    |x `gtByte` y = NInt $ x `subByte` y
+    |otherwise    = PInt $ y `subByte` x
+
+-}
+
+
+