Commit be8a06f3 authored by Laszlo Domoszlai's avatar Laszlo Domoszlai
Browse files

KnuthBendix works now

parent 86ee1b4c
...@@ -9,3 +9,6 @@ App5 !f a1 a2 a3 a4 a5 = f a1 a2 a3 a4 a5 ...@@ -9,3 +9,6 @@ App5 !f a1 a2 a3 a4 a5 = f a1 a2 a3 a4 a5
string_usize !str = _Tuple2 (string_size str) str string_usize !str = _Tuple2 (string_size str) str
string_uselect !str !pos::I = _Tuple2 (string_select str pos) str string_uselect !str !pos::I = _Tuple2 (string_select str pos) str
string_replace !str !idx::I !ch::C = _Tuple2 (string_select str idx) (string_update str idx ch) string_replace !str !idx::I !ch::C = _Tuple2 (string_select str idx) (string_update str idx ch)
second !f !s = s
trace !str a = second (_trace str) a
\ No newline at end of file
...@@ -13,7 +13,7 @@ ...@@ -13,7 +13,7 @@
#define instackb(addr) ((char*)addr >= (char*) &stack_b[0] && (char*)addr < (char*) &stack_b[STACK_SIZE_B]) #define instackb(addr) ((char*)addr >= (char*) &stack_b[0] && (char*)addr < (char*) &stack_b[STACK_SIZE_B])
#define follow_thunk(thunk) if (thunk->desc == (Desc*) __FORWARD_PTR__) thunk = thunk->_forward_ptr; #define follow_thunk(thunk) while (thunk->desc == (Desc*) __FORWARD_PTR__) thunk = thunk->_forward_ptr;
#define forward_thunk(thunk, frame_ptr) \ #define forward_thunk(thunk, frame_ptr) \
Thunk* dst = get_dst(frame_ptr); \ Thunk* dst = get_dst(frame_ptr); \
...@@ -173,6 +173,12 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr) ...@@ -173,6 +173,12 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
switch (expr->type) { switch (expr->type) {
case CT_APP_PRIM1: case CT_APP_PRIM1:
{ {
if(get_dst(root_frame_ptr) == NULL)
{
Thunk* tmp = (Thunk*) alloc_heap(sizeof(Thunk));
set_return(root_frame_ptr, tmp);
}
switch(expr->arg_pattern) switch(expr->arg_pattern)
{ {
case 1: case 1:
...@@ -195,6 +201,11 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr) ...@@ -195,6 +201,11 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
} }
case CT_APP_PRIM2: case CT_APP_PRIM2:
{ {
if(get_dst(root_frame_ptr) == NULL)
{
Thunk* tmp = (Thunk*) alloc_heap(sizeof(Thunk));
set_return(root_frame_ptr, tmp);
}
// careful, "exec" may trigger garbage collection // careful, "exec" may trigger garbage collection
// read local variables only after the last exec // read local variables only after the last exec
...@@ -247,6 +258,12 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr) ...@@ -247,6 +258,12 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
} }
case CT_APP_PRIM: case CT_APP_PRIM:
{ {
if(get_dst(root_frame_ptr) == NULL)
{
Thunk* tmp = (Thunk*) alloc_heap(sizeof(Thunk));
set_return(root_frame_ptr, tmp);
};
PrimEntry* desc = (PrimEntry*) ((AppEntry*) expr)->f; PrimEntry* desc = (PrimEntry*) ((AppEntry*) expr)->f;
int argmask = 1; int argmask = 1;
...@@ -299,7 +316,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr) ...@@ -299,7 +316,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
case CT_APP_FUN: case CT_APP_FUN:
{ {
Desc* slice = ((AppEntry*) expr)->f; Desc* slice = ((AppEntry*) expr)->f;
int new_frame_ptr = stack_top_a; int new_frame_ptr = stack_top_a;
int argmask = 1; int argmask = 1;
...@@ -470,7 +487,8 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr) ...@@ -470,7 +487,8 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
case CT_VAR_UNBOXED: case CT_VAR_UNBOXED:
{ {
Thunk* arg = local(frame_ptr, ((VarEntry*) expr)->index); Thunk* arg = local(frame_ptr, ((VarEntry*) expr)->index);
follow_thunk(arg);
assert(is_hnf(arg)); assert(is_hnf(arg));
// no need to check for array length, thunks in HNF are never overwritten // no need to check for array length, thunks in HNF are never overwritten
......
...@@ -46,12 +46,13 @@ void init_mem() { ...@@ -46,12 +46,13 @@ void init_mem() {
} }
void* alloc_desc(int size) { void* alloc_desc(int size) {
size = ((size + 3) / 4) * 4;
desc_alloc += size; desc_alloc += size;
return malloc(size); return malloc(size);
} }
void* alloc_code(int size) { void* alloc_code(int size) {
code_alloc += size; code_alloc += ((size + 3) / 4) * 4;
return malloc(size); return malloc(size);
} }
......
#include <string.h> #include <string.h>
#include <stdio.h>
#include "prim.h" #include "prim.h"
#include "desc.h" #include "desc.h"
...@@ -109,6 +110,12 @@ void __C2I(int dst_idx) { ...@@ -109,6 +110,12 @@ void __C2I(int dst_idx) {
target->_int = readC(arg(1)); target->_int = readC(arg(1));
} }
void __I2C(int dst_idx) {
Thunk* target = get_dst(dst_idx);
target->desc = (Desc*) __CHAR__;
target->_int = (char) readI(arg(1));
}
void __string_size(int dst_idx) void __string_size(int dst_idx)
{ {
Thunk* target = get_dst(dst_idx); Thunk* target = get_dst(dst_idx);
...@@ -345,6 +352,39 @@ void __eqS(int dst_idx) ...@@ -345,6 +352,39 @@ void __eqS(int dst_idx)
target->_int = eq; target->_int = eq;
} }
void __C2S(int dst_idx) {
Thunk* target = get_dst(dst_idx);
Thunk* ch = arg(1);
target = string_create(target, 1);
target->_array._chars[0] = (char) ch->_int;
set_return(dst_idx, target);
}
void __trace(int dst_idx)
{
Thunk* str = arg(1);
int length;
char* chars;
if(str->desc == (Desc*) __STRING_PTR__)
{
chars = str->_string_ptr->chars;
length = str->_string_ptr->length;
}
else
{
chars = str->_array._chars;
length = str->_array.length;
}
for(int i=0; i<length; i++)
{
printf("%c", chars[i]);
}
}
void add_prim(int arity, int boxingMap, char* name, void (*exec)(int)) { void add_prim(int arity, int boxingMap, char* name, void (*exec)(int)) {
int nameLength = strlen(name); int nameLength = strlen(name);
...@@ -386,7 +426,8 @@ void init_prim() { ...@@ -386,7 +426,8 @@ void init_prim() {
add_prim(2, 0b011, "and", &__and); add_prim(2, 0b011, "and", &__and);
add_prim(2, 0b011, "or", &__or); add_prim(2, 0b011, "or", &__or);
add_prim(2, 0b011, "mod", &__mod); add_prim(2, 0b011, "mod", &__mod);
add_prim(1, 0b001, "C2I", &__C2I); add_prim(1, 0b001, "C2I", &__C2I);
add_prim(1, 0b001, "I2C", &__I2C);
add_prim(1, 0b000, "string_size", &__string_size); add_prim(1, 0b000, "string_size", &__string_size);
add_prim(2, 0b010, "string_select", &__string_select); add_prim(2, 0b010, "string_select", &__string_select);
...@@ -396,4 +437,7 @@ void init_prim() { ...@@ -396,4 +437,7 @@ void init_prim() {
add_prim(3, 0b110, "string_slice", &__string_slice); add_prim(3, 0b110, "string_slice", &__string_slice);
add_prim(2, 0b000, "string_append", &__string_append); add_prim(2, 0b000, "string_append", &__string_append);
add_prim(2, 0b000, "eqS", &__eqS); add_prim(2, 0b000, "eqS", &__eqS);
add_prim(1, 0b001, "C2S", &__C2S);
add_prim(1, 0b000, "_trace", &__trace);
} }
...@@ -38,7 +38,7 @@ typedef struct __attribute__((packed)) Thunk { ...@@ -38,7 +38,7 @@ typedef struct __attribute__((packed)) Thunk {
union { union {
Thunk* _forward_ptr; Thunk* _forward_ptr;
int _int; // also char and bool int _int; // also char and bool
double _real; // TODO: move "real" out of here, too long (at least on 32 bits) double _real;
struct CleanString* _string_ptr; // For CT_THUNK struct CleanString* _string_ptr; // For CT_THUNK
struct Array _array; struct Array _array;
Thunk* _args[]; Thunk* _args[];
...@@ -47,7 +47,7 @@ typedef struct __attribute__((packed)) Thunk { ...@@ -47,7 +47,7 @@ typedef struct __attribute__((packed)) Thunk {
#pragma pack(pop) #pragma pack(pop)
#define thunk_size_f(arity) max(sizeof (Thunk), sizeof (Desc*) + sizeof (Thunk*) * arity); #define thunk_size_f(arity) ((max(sizeof (Thunk), sizeof (Desc*) + sizeof (Thunk*) * arity) + 3) / 4) * 4
#ifdef DEBUG #ifdef DEBUG
......
...@@ -3,13 +3,13 @@ module precompiler ...@@ -3,13 +3,13 @@ module precompiler
import Sapl.SaplParser import Sapl.SaplParser
import Sapl.SaplTokenizer import Sapl.SaplTokenizer
import StdBool, StdList, StdOrdList, StdFile, StdDebug import StdBool, StdList, StdOrdList, StdFile, StdFunc, StdArray, StdDebug
import Text.StringAppender, Text import Text.StringAppender, Text
import Data.Map import Data.Map
import Text.Unicode.Encodings.JS import Text.Unicode.Encodings.JS
from Text.Unicode.UChar import instance toChar UChar from Text.Unicode.UChar import instance toChar UChar, instance toInt UChar
import System.CommandLine import System.CommandLine
import System.File import System.File
...@@ -144,9 +144,16 @@ genDefs [f:fs] a = a <++ textSize fstr <++ " " <++ fstr <++ genDefs fs ...@@ -144,9 +144,16 @@ genDefs [f:fs] a = a <++ textSize fstr <++ " " <++ fstr <++ genDefs fs
where where
fstr = toString (sFunc newContext f newAppender) fstr = toString (sFunc newContext f newAppender)
encodeString :: UString -> String
encodeString us = {c \\ c <- map (convert o toInt) us}
where
convert cc
| cc > 255 = '?'
= toChar cc
instance Appendable Literal instance Appendable Literal
where where
(<++) a (LString lit) = a <++ "S" <++ sText (toJSLiteral lit) (<++) a (LString lit) = a <++ "S" <++ sText (encodeString lit)
(<++) a (LInt lit) = a <++ "I" <++ sNum lit (<++) a (LInt lit) = a <++ "I" <++ sNum lit
(<++) a (LReal lit) = a <++ "R" <++ sNum lit (<++) a (LReal lit) = a <++ "R" <++ sNum lit
(<++) a (LChar [c]) = a <++ "C" <++ toString (toChar c) (<++) a (LChar [c]) = a <++ "C" <++ toString (toChar c)
......
Using equations:
(0 + X) = X
(-(X) + X) = 0
((X + Y) + Z) = (X + (Y + Z))
Success
-((B + A)) -> (-(A) + -(B))
-(0) -> 0
-(-(A)) -> A
(A + -(A)) -> 0
(B + (-(B) + A)) -> A
(A + 0) -> A
(-(B) + (B + A)) -> A
((C + B) + A) -> (C + (B + A))
(-(A) + A) -> 0
(0 + A) -> A
[0]
\ No newline at end of file
This diff is collapsed.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment