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
string_usize !str = _Tuple2 (string_size str) 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)
second !f !s = s
trace !str a = second (_trace str) a
\ No newline at end of file
......@@ -13,7 +13,7 @@
#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) \
Thunk* dst = get_dst(frame_ptr); \
......@@ -173,6 +173,12 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
switch (expr->type) {
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)
{
case 1:
......@@ -195,6 +201,11 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
}
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
// read local variables only after the last exec
......@@ -247,6 +258,12 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
}
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;
int argmask = 1;
......@@ -299,7 +316,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
case CT_APP_FUN:
{
Desc* slice = ((AppEntry*) expr)->f;
int new_frame_ptr = stack_top_a;
int argmask = 1;
......@@ -470,7 +487,8 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
case CT_VAR_UNBOXED:
{
Thunk* arg = local(frame_ptr, ((VarEntry*) expr)->index);
follow_thunk(arg);
assert(is_hnf(arg));
// no need to check for array length, thunks in HNF are never overwritten
......
......@@ -46,12 +46,13 @@ void init_mem() {
}
void* alloc_desc(int size) {
size = ((size + 3) / 4) * 4;
desc_alloc += size;
return malloc(size);
}
void* alloc_code(int size) {
code_alloc += size;
code_alloc += ((size + 3) / 4) * 4;
return malloc(size);
}
......
#include <string.h>
#include <stdio.h>
#include "prim.h"
#include "desc.h"
......@@ -109,6 +110,12 @@ void __C2I(int dst_idx) {
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)
{
Thunk* target = get_dst(dst_idx);
......@@ -345,6 +352,39 @@ void __eqS(int dst_idx)
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)) {
int nameLength = strlen(name);
......@@ -386,7 +426,8 @@ void init_prim() {
add_prim(2, 0b011, "and", &__and);
add_prim(2, 0b011, "or", &__or);
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(2, 0b010, "string_select", &__string_select);
......@@ -396,4 +437,7 @@ void init_prim() {
add_prim(3, 0b110, "string_slice", &__string_slice);
add_prim(2, 0b000, "string_append", &__string_append);
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 {
union {
Thunk* _forward_ptr;
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 Array _array;
Thunk* _args[];
......@@ -47,7 +47,7 @@ typedef struct __attribute__((packed)) Thunk {
#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
......
......@@ -3,13 +3,13 @@ module precompiler
import Sapl.SaplParser
import Sapl.SaplTokenizer
import StdBool, StdList, StdOrdList, StdFile, StdDebug
import StdBool, StdList, StdOrdList, StdFile, StdFunc, StdArray, StdDebug
import Text.StringAppender, Text
import Data.Map
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.File
......@@ -144,9 +144,16 @@ genDefs [f:fs] a = a <++ textSize fstr <++ " " <++ fstr <++ genDefs fs
where
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
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 (LReal lit) = a <++ "R" <++ sNum lit
(<++) 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