Skip to content
GitLab
Commit 5f3de1c8 authored by Laszlo Domoszlai's avatar Laszlo Domoszlai
Browse files

optimize node types: 

- CT_LIT -> SHARED_THUNK
- CT_VAR only local vars, function names are converted to applications
- CT_APP dynamic/static. static case contains the correct descriptor pointer (to the slice)
parent f1b4d027
Hide whitespace changes
Inline Side-by-side
interpreter/code.c
View file @ 5f3de1c8
......@@ -17,12 +17,10 @@ struct Thunk* create_thunk(Code* expr, int frame_ptr)
// TODO: check over application
// TODO: enforce strictness in ADT/Record
VarEntry* var = &((AppEntry*) expr)->var;
if (var->base.local_type == VAR_LOCAL)
if (expr->dyn_app)
{
Thunk* basethunk = local(frame_ptr, var->index);
if(!var->base.strict) basethunk = eval(basethunk);
Thunk* basethunk = local(frame_ptr, ((AppEntry*)expr)->var.index);
if(!((AppEntry*)expr)->var.base.strict) basethunk = eval(basethunk);
Desc* slice =
get_slice(basethunk->desc->type == FT_SLICE ?
......@@ -45,7 +43,7 @@ struct Thunk* create_thunk(Code* expr, int frame_ptr)
}
else
{
Thunk* thunk = createF(get_slice(var->f, expr->nr_args));
Thunk* thunk = createF(((AppEntry*) expr)->f);
assert(thunk->desc->arity == expr->nr_args);
......@@ -57,13 +55,9 @@ struct Thunk* create_thunk(Code* expr, int frame_ptr)
}
}
case CT_VAR:
if (expr->local_type == VAR_LOCAL) {
return local(frame_ptr, ((VarEntry*) expr)->index);
}else{
return createF(get_slice(((VarEntry*) expr)->f, 0));
}
case CT_LIT:
return createT(&((LitEntry*) expr)->thunk);
return local(frame_ptr, ((VarEntry*) expr)->index);
case CT_THUNK:
return &((ThunkEntry*) expr)->thunk;
}
}
......@@ -80,12 +74,10 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
// TODO: check over application
// TODO: enforce strictness in ADT/Record
VarEntry* var = &((AppEntry*) expr)->var;
if (var->base.local_type == VAR_LOCAL)
if (expr->dyn_app)
{
Thunk* basethunk = local(frame_ptr, var->index);
if(!var->base.strict) basethunk = eval(basethunk);
Thunk* basethunk = local(frame_ptr, ((AppEntry*)expr)->var.index);
if(!((AppEntry*)expr)->var.base.strict) basethunk = eval(basethunk);
Desc* slice =
get_slice(basethunk->desc->type == FT_SLICE ?
......@@ -166,7 +158,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
}
else
{
Desc* slice = get_slice(var->f, expr->nr_args);
Desc* slice = ((AppEntry*) expr)->f;
if (slice->type == FT_PRIM) {
Thunk args[expr->nr_args];
......@@ -222,84 +214,71 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
break;
}
case CT_VAR:
if (expr->local_type == VAR_LOCAL) {
Thunk* thunk = local(frame_ptr, ((VarEntry*) expr)->index);
if(((VarEntry*) expr)->base.strict)
{
assert(is_hnf(thunk));
set_return(root_frame_ptr, thunk);
destroy_stack_frame(root_frame_ptr);
return;
}
while (thunk->desc == (Desc*) __FORWARD_PTR__) {
thunk = thunk->_forward_ptr;
}
{
Thunk* thunk = local(frame_ptr, ((VarEntry*) expr)->index);
if(((VarEntry*) expr)->base.strict)
{
assert(is_hnf(thunk));
forward_to(get_dst(root_frame_ptr), thunk);
set_return(root_frame_ptr, thunk);
if (thunk->desc->type == FT_FUN) {
// Destroy stack frame before eval, it is not needed any more
// Greatly reduces stack usage
destroy_stack_frame(root_frame_ptr);
frame_ptr = stack_top_a;
// Here frame_ptr == root_frame_ptr
int argmask = 1;
for (int i = 0; i < thunk->desc->arity; i++) {
destroy_stack_frame(root_frame_ptr);
return;
}
if(((FunEntry*) thunk->desc)->strictness & argmask)
{
push_a(eval(thunk->_args[i]));
}
else
{
push_a(thunk->_args[i]);
}
argmask <<= 1;
}
expr = ((FunEntry*) thunk->desc)->body;
continue;
}
else if(thunk->desc->type == FT_PRIM) {
while (thunk->desc == (Desc*) __FORWARD_PTR__) {
thunk = thunk->_forward_ptr;
}
forward_to(get_dst(root_frame_ptr), thunk);
set_return(root_frame_ptr, thunk);
if (thunk->desc->type == FT_FUN) {
// Destroy stack frame before eval, it is not needed any more
// Greatly reduces stack usage
destroy_stack_frame(root_frame_ptr);
frame_ptr = stack_top_a;
// Here frame_ptr == root_frame_ptr
int argmask = 1;
for (int i = 0; i < thunk->desc->arity; i++) {
for (int i = 0; i < thunk->desc->arity; i++) {
if(((FunEntry*) thunk->desc)->strictness & argmask)
{
push_a(eval(thunk->_args[i]));
}
else
{
push_a(thunk->_args[i]);
}
((PrimEntry*) thunk->desc)->exec(root_frame_ptr);
}
destroy_stack_frame(root_frame_ptr);
return;
}else{
// Safe to destroy, the next call has no arguments
destroy_stack_frame(root_frame_ptr);
Desc* slice = get_slice(((VarEntry*) expr)->f, 0);
if(slice->type == FT_FUN)
{
expr = ((FunEntry*)slice)->body;
continue;
}
else
{
set_return(root_frame_ptr, updateF(get_dst(root_frame_ptr), slice));
return;
argmask <<= 1;
}
expr = ((FunEntry*) thunk->desc)->body;
continue;
}
case CT_LIT:
set_return(root_frame_ptr, &((LitEntry*) expr)->thunk);
else if(thunk->desc->type == FT_PRIM) {
for (int i = 0; i < thunk->desc->arity; i++) {
push_a(eval(thunk->_args[i]));
}
((PrimEntry*) thunk->desc)->exec(root_frame_ptr);
}
destroy_stack_frame(root_frame_ptr);
return;
}
case CT_THUNK:
{
// TODO: set forward
set_return(root_frame_ptr, &((ThunkEntry*) expr)->thunk);
destroy_stack_frame(root_frame_ptr);
return;
}
case CT_SELECT:
{
push_a(NULL);
......
interpreter/code.h
View file @ 5f3de1c8
......@@ -3,46 +3,36 @@
#include "thunk.h"
#define CT_LIT 1
#define CT_VAR 2
#define CT_APP 3
#define CT_SELECT 4
#define CT_IF 5
#define CT_THUNK 1 // Shared thunk
#define CT_VAR 2
#define CT_APP 3
#define CT_SELECT 4
#define CT_IF 5
struct Code {
unsigned int type : 3;
unsigned int local_type : 3;
unsigned int nr_args : 5; // used in AppEntry
unsigned int dyn_app : 1; // used in AppEntry
unsigned int nr_cases : 5; // used in SelectEntry
unsigned int strict : 1; // used in VarEntry
};
#define LIT_INT 1
#define LIT_REAL 2
#define LIT_CHAR 3
#define LIT_BOOL 4
#define LIT_STRING 5
struct LitEntry {
struct ThunkEntry {
struct Code base;
struct Thunk thunk;
};
#define VAR_LOCAL 0
#define VAR_FN 1
struct VarEntry {
struct Code base;
union {
int index; // index on the stack
struct Desc* f;
};
int index; // index on the stack
};
struct AppEntry {
struct Code base;
struct VarEntry var;
union {
struct VarEntry var;
struct Desc* f;
};
struct Code* args[];
};
......@@ -56,7 +46,7 @@ struct SelectCaseEntry {
union {
struct ADTEntry* cons;
struct LitEntry* lit;
struct ThunkEntry* lit;
};
};
......
interpreter/parse.c
View file @ 5f3de1c8
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <stdbool.h>
#include "parse.h"
#include "mem.h"
......@@ -217,7 +217,7 @@ int parseDef1(char** ptr) {
return 1;
}
LitEntry* parseLit(char **ptr) {
ThunkEntry* parseLit(char **ptr) {
// 1. Type char
char type = *(*ptr)++;
......@@ -226,13 +226,12 @@ LitEntry* parseLit(char **ptr) {
if (!parseInt(ptr, &strlen)) return 0;
}
struct LitEntry* entry = (LitEntry*) alloc_code(sizeof (LitEntry) + strlen + 1);
entry->base.type = CT_LIT;
struct ThunkEntry* entry = (ThunkEntry*) alloc_code(sizeof (ThunkEntry) + strlen);
entry->base.type = CT_THUNK;
switch (type) {
case 'I': // Int
{
entry->base.local_type = LIT_INT;
entry->thunk.desc = (Desc*) __INT__;
if (!parseInt(ptr, &entry->thunk._int)) return 0;
break;
......@@ -240,7 +239,6 @@ LitEntry* parseLit(char **ptr) {
case 'C': // Char
{
entry->base.local_type = LIT_CHAR;
entry->thunk.desc = (Desc*) __CHAR__;
entry->thunk._char = *(*ptr)++;
break;
......@@ -248,7 +246,6 @@ LitEntry* parseLit(char **ptr) {
case 'R': // Real
{
entry->base.local_type = LIT_REAL;
entry->thunk.desc = (Desc*) __REAL__;
if (!parseReal(ptr, &entry->thunk._real)) return 0;
break;
......@@ -257,7 +254,6 @@ LitEntry* parseLit(char **ptr) {
case '0': // Bool
case '1':
{
entry->base.local_type = LIT_BOOL;
entry->thunk.desc = (Desc*) __BOOL__;
entry->thunk._bool = type == '1';
break;
......@@ -284,18 +280,12 @@ VarEntry* parseVar(char **ptr, VarEntry* target) {
case 'L': // Local var
case 'S': // Strict local var
{
entry->base.local_type = VAR_LOCAL;
entry->base.strict = type == 'S';
if (!parseInt(ptr, &entry->index)) return 0;
break;
}
case 'F': // Function
{
entry->base.local_type = VAR_FN;
entry->f = parseFunName(ptr); // can fail
break;
}
}
default:
return 0;
}
return entry;
......@@ -303,22 +293,66 @@ VarEntry* parseVar(char **ptr, VarEntry* target) {
Code* parseTerm(char **ptr);
AppEntry* parseApp(char **ptr) {
/*
* It is very messy, because it handles 3 cases:
* 1. Dynamic app: the function part is a local variable or argument
* 2. Static app, where the function is a zero arg data constructor, or a non-zero parameter function with zero arguments
* 3. Other static cases
*/
Code* parseApp(char **ptr, bool dynamic) {
int nrArgs;
if (!parseInt(ptr, &nrArgs)) return 0;
struct AppEntry* entry = (AppEntry*) alloc_code(sizeof (AppEntry) + sizeof (void*) * nrArgs);
entry->base.type = CT_APP;
entry->base.nr_args = nrArgs;
struct AppEntry* entry = NULL;
if(!dynamic && nrArgs == 0)
{
(*ptr)++; // Skip 'F' for the static var
Desc* desc = parseFunName(ptr); // can fail
if(desc != NULL) desc = get_slice(desc, nrArgs);
for (int i = 0; i < nrArgs; i++) {
entry->args[i] = parseTerm(ptr);
if (entry->args[i] == 0) return 0;
/*
if(desc->type == FT_ADT || desc->type == FT_SLICE)
{
struct ThunkEntry* entry = (ThunkEntry*) alloc_code(sizeof (ThunkEntry));
entry->base.type = CT_THUNK;
entry->thunk.desc = desc;
return (Code*) entry;
}
*/
entry = (AppEntry*) alloc_code(sizeof (AppEntry));
entry->f = desc;
}
else
{
entry = (AppEntry*) alloc_code(sizeof (AppEntry) + sizeof (void*) * nrArgs);
for (int i = 0; i < nrArgs; i++) {
entry->args[i] = parseTerm(ptr);
if (entry->args[i] == 0) return 0;
}
parseVar(ptr, &entry->var);
if(dynamic)
{
parseVar(ptr, &entry->var);
}
else
{
(*ptr)++; // Skip 'F' for the static var
Desc* desc = parseFunName(ptr); // can fail
if(desc != NULL) desc = get_slice(desc, nrArgs);
entry->f = desc;
}
}
return entry;
entry->base.type = CT_APP;
entry->base.nr_args = nrArgs;
entry->base.dyn_app = dynamic;
return (Code*) entry;
}
SelectEntry* parseSelect(char **ptr) {
......@@ -376,8 +410,10 @@ Code* parseTerm(char **ptr) {
return (Code*) parseLit(ptr);
case 'V': // Variable
return (Code*) parseVar(ptr, NULL);
case 'A': // Application
return (Code*) parseApp(ptr);
case 'A': // Static application
return (Code*) parseApp(ptr, false);
case 'D': // Dynamic application
return (Code*) parseApp(ptr, true);
case 'S': // Select
return (Code*) parseSelect(ptr);
case 'I': // If
......
precompiler/precompiler.icl
View file @ 5f3de1c8
......@@ -14,7 +14,7 @@ from Text.Unicode.UChar import instance toChar UChar
import System.CommandLine
import System.File
:: VarType = Local Int Bool | Fun String
:: VarType = Local Int Bool
:: Context = { vars :: Map String VarType
, localcount :: Int
......@@ -57,8 +57,8 @@ sNum num a = a <++ num <++ " "
sText text a = a <++ sNum (textSize text) <++ text
sTerm ctx (SLit lit) a = a <++ "L" <++ lit
sTerm ctx (SVar var) a = a <++ "V" <++ sVar ctx var
sTerm ctx (SApplication var terms) a = a <++ "A" <++ sList (sTerm ctx) terms <++ sVar ctx var
sTerm ctx (SVar var) a = a <++ sVarApp ctx var
sTerm ctx (SApplication var terms) a = a <++ if (isLocalVar ctx var) "D" "A" <++ sList (sTerm ctx) terms <++ sVar ctx var
sTerm ctx (SSelect expr cs) a = a <++ "S" <++ sTerm ctx expr <++ sList (sSelectCase ctx) cs
sTerm ctx (SIf cond texpr fexpr) a = a <++ "I" <++ sTerm ctx cond <++ sTerm ctx texpr <++ sTerm ctx fexpr
......@@ -70,6 +70,8 @@ sSelectCase ctx (PLit lit, expr) a
sSelectCase ctx (PDefault, expr) a
= a <++ "D" <++ sTerm ctx expr
isLocalVar ctx var = member (unpackVar var) ctx.vars
sVar ctx var a
= case get varName ctx.vars of
(Just (Local i True)) = a <++ "S" <++ sNum i
......@@ -78,6 +80,14 @@ sVar ctx var a
where
varName = unpackVar var
sVarApp ctx var a
= case get varName ctx.vars of
(Just (Local i True)) = a <++ "VS" <++ sNum i
(Just (Local i False)) = a <++ "VL" <++ sNum i
_ = a <++ "A" <++ sList (sTerm ctx) [] <++ sVar ctx var
where
varName = unpackVar var
genDefs [] a = a
genDefs [f:fs] a = a <++ textSize fstr <++ " " <++ fstr <++ genDefs fs
where
......
Supports Markdown
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