callgrind.out.*
massif.out.*
+
+doc
# Possible values are: NO, YES and FAIL_ON_WARNINGS.
# The default value is: NO.
-WARN_AS_ERROR = NO
+WARN_AS_ERROR = YES
# The WARN_FORMAT tag determines the format of the warning messages that doxygen
# can produce. The string should contain the $file, $line, and $text tags, which
# be searched for input files as well.
# The default value is: NO.
-RECURSIVE = NO
+RECURSIVE = YES
# The EXCLUDE tag can be used to specify files and/or directories that should be
# excluded from the INPUT source files. This way you can easily exclude a
# Note that the wildcards are matched against the file with absolute path, so to
# exclude all test directories for example use the pattern */test/*
-EXCLUDE_PATTERNS =
+EXCLUDE_PATTERNS = */scan.h/* */parse.h/*
# The EXCLUDE_SYMBOLS tag can be used to specify one or more symbol names
# (namespaces, classes, functions, etc.) that should be excluded from the
clean:
$(MAKE) -C src clean
+ $(RM) a.c a.ssm a.out
+++ /dev/null
-#!/bin/bash
-usage() {
- echo "Usage: $0 CSOURCE [-o OFILE]" >&2
- exit 1
-}
-if [ $# -lt 1 ]
-then
- usage
-fi
-if [ $# -eq 3 ]
-then
- if [ $2 != "-o" ]
- then
- usage
- fi
- OFILE=$3
-else
- OFILE=a.out
-fi
-make
-./splc < "$1"
-CFLAGS=${CFLAGS:-}
-LDLIBS=${LDLIBS:-}
-LDFLAGS=${LDFLAGS:-}
-CC=${CC:-gcc}
-set -xe
-"$CC" $CFLAGS a.c $LDFLAGS rts.c $LDLIBS -o "$OFILE"
-./"$OFILE"
// if (REFC(ptr) == 0)
// free(ptr-1);
}
-struct splc_tuple *splc_tuple(WORD fst, WORD snd) {
+struct splc_tuple *splc_tuple_real(WORD fst, WORD snd) {
struct splc_tuple *res = splc_malloc(sizeof(struct splc_tuple));
res->fst = fst;
res->snd = snd;
}
return l->hd;
}
+int main()
+{
+ realmain();
+ return 0;
+}
struct splc_tuple { WORD fst; WORD snd; };
struct splc_list { WORD hd; struct splc_list *tl; };
-struct splc_tuple *splc_tuple(WORD fst, WORD snd);
+#define splc_tuple(l, r) splc_tuple_real((intptr_t)(l), (intptr_t)(r))
+struct splc_tuple *splc_tuple_real(WORD fst, WORD snd);
struct splc_list *splc_cons(WORD hd, struct splc_list *tl);
WORD hd(struct splc_list *l);
struct splc_list *tl(struct splc_list *l);
#define die(...) { fprintf(stderr, __VA_ARGS__); exit(1); }
#define isEmpty(l) ((l) == NULL)
#define tl(l) (l)->tl
-#define fst(l) (l)->fst
-#define snd(l) (l)->snd
-#define print_Int(l) printf("%ld", l);
-#define print_Char(l) printf("%c", l);
+#define fst(l) ((struct splc_tuple *)(l))->fst
+#define snd(l) ((struct splc_tuple *)(l))->snd
+#define print_Int(l) printf("%ld", (long)l);
+#define print_Char(l) printf("%c", (char)l);
#define print_Bool(l) printf("%s", (l) ? "true" : "false");
#define eq_Int(x, y) ((x)==(y))
#define eq_Char(x, y) ((x)==(y))
#define eq_Bool(x, y) ((x)==(y))
+void realmain(void);
+int main(void);
+
#endif
* @param iter Name of the iterator variable
* @param array Pointer to the array
*/
-/** Iterate over the indices and elements of an array */
-#define ARRAY_ITER(type, x, iter, a) ARRAY_ITERI (iter, a) {\
- type (x) = ARRAY_EL(type, a, iter);
+#define ARRAY_ITER(type, x, iter, array) ARRAY_ITERI (iter, array) {\
+ type (x) = ARRAY_EL(type, array, iter);
/**
* Macro to end an array iteration
*
* @param array Pointer to the array
* @param idx Index of removal
*/
-void array_remove(struct array *a, size_t idx);
+void array_remove(struct array *array, size_t idx);
/**
* Move an item from a position to another, moving the other items.
* @param from Original index of the item
* @param to New index of the item
*/
-void array_move(struct array *a, size_t from, size_t to);
+void array_move(struct array *array, size_t from, size_t to);
/**
* Insert an item into a sorted array.
* @param array Pointer to the array
* @param cmp Comparison function
*/
-void array_binsert(void *key, struct array *a, int (*cmp)(const void *, const void *));
+void array_binsert(void *key, struct array *array, int (*cmp)(const void *, const void *));
#endif
#include "util.h"
#include "ast.h"
#include "type.h"
-#include "list.h"
#include "parse.h"
const char *binop_str[] = {
/** Datatype that stores the overloading information */
struct overload {
- struct array print; /** overloaded print calls, @type struct overload_entry * */
- struct array eq; /** overloaded equality calls, @type struct overload_entry * */
+ struct array print; /** overloaded print calls, type: struct overload_entry * */
+ struct array eq; /** overloaded equality calls, type: struct overload_entry * */
};
/** Single overloading entry */
struct overload_entry {
#include "../sem.h"
#include "../gen.h"
+static const char *fun_name(const char *name)
+{
+ if (strcmp(name, "abs") == 0)
+ return "splc_abs";
+ return name;
+}
+
static void expr_genc(struct expr *expr, FILE *cout);
static void binop_genc(char *fun, struct expr *l, struct expr *r, FILE *cout)
safe_fprintf(cout, "print_");
overloaded_type(expr->loc, expr->data.efuncall.type, cout);
} else {
- safe_fprintf(cout, "%s", expr->data.efuncall.ident);
+ safe_fprintf(cout, "%s", fun_name(expr->data.efuncall.ident));
}
safe_fprintf(cout, "(");
ARRAY_ITER(struct expr *, e, i, &expr->data.efuncall.args) {
safe_fprintf(cout, ";\n");
}
+static void fields_genc(struct array *fields, const char *ident, FILE *cout)
+{
+ safe_fprintf(cout, "%s", ident);
+ ARRAY_ITER(char *, f, i, fields)
+ safe_fprintf(cout, "->%s", f);
+ AIEND
+}
+
static void stmt_genc(struct stmt *stmt, int indent, FILE *cout)
{
if (stmt == NULL)
switch(stmt->type) {
case sassign:
pindent(indent, cout);
- safe_fprintf(cout, "%s", stmt->data.sassign.ident);
- ARRAY_ITER(char *, f, i, &stmt->data.sassign.fields)
- safe_fprintf(cout, "->%s", f);
- AIEND
+ fields_genc(&stmt->data.sassign.fields, stmt->data.sassign.ident, cout);
safe_fprintf(cout, " = ");
expr_genc(stmt->data.sassign.expr, cout);
safe_fprintf(cout, ";\n");
static void fundecl_sig(struct fundecl *decl, FILE *cout)
{
type_genc(decl->rtype, cout);
- safe_fprintf(cout, "%s (", decl->ident);
+ safe_fprintf(cout, "%s (", fun_name(decl->ident));
ARRAY_ITER(char *, a, i, &decl->args) {
if (i >= ARRAY_SIZE(decl->atypes))
die("function with unmatched type\n");
static void fundecl_genc(const struct ast *ast, struct fundecl *decl, FILE *cout)
{
if (strcmp(decl->ident, "main") == 0)
- safe_fprintf(cout, "int main()");
+ safe_fprintf(cout, "void real_main()");
else
fundecl_sig(decl, cout);
safe_fprintf(cout, "{\n");
ARRAY_ITER(struct stmt *, s, i, &decl->body)
stmt_genc(s, 1, cout);
AIEND
- if (strcmp(decl->ident, "main") == 0)
- safe_fprintf(cout, "\treturn 0;\n");
safe_fprintf(cout, "}\n");
}
-
static void decl_genc(const struct ast *ast, struct decl *decl, FILE *cout)
{
switch (decl->type) {
safe_fprintf(cout, "\twhile(t != NULL) {\n");
safe_fprintf(cout, "\t\tif (!eq_");
overloaded_type(loc, type->data.tlist, cout);
- safe_fprintf(cout, "(x->hd, y->hd));\n");
+ safe_fprintf(cout, "(hd(x), hd(y)));\n");
safe_fprintf(cout, "\t\t\treturn false;\n");
- safe_fprintf(cout, "\t\tt = t->tl;\n");
+ safe_fprintf(cout, "\t\tt = tl(t);\n");
safe_fprintf(cout, "\t}\n");
safe_fprintf(cout, "\treturn true;\n");
break;
safe_fprintf(cout, "(x->fy->fst)");
safe_fprintf(cout, " && eq_");
overloaded_type(loc, type->data.ttuple.r, cout);
- safe_fprintf(cout, "(x->snd, y->snd);");
+ safe_fprintf(cout, "(snd(x), snd(y));");
break;
default:
die("cannot compare anything else than tuples and lists");
safe_fprintf(cout, "\twhile(t != NULL) {\n");
safe_fprintf(cout, "\t\tprint_");
overloaded_type(loc, type->data.tlist, cout);
- safe_fprintf(cout, "(t->hd);\n");
- safe_fprintf(cout, "\t\tif (t->tl != NULL)\n");
+ safe_fprintf(cout, "((");
+ type_genc(type->data.tlist, cout);
+ safe_fprintf(cout, ")hd(t));\n");
+ safe_fprintf(cout, "\t\tif (tl(t) != NULL)\n");
safe_fprintf(cout, "\t\t\tprintf(\", \");\n");
- safe_fprintf(cout, "\t\tt = t->tl;\n");
+ safe_fprintf(cout, "\t\tt = tl(t);\n");
safe_fprintf(cout, "\t}\n");
safe_fprintf(cout, "\tprintf(\"]\");\n");
break;
safe_fprintf(cout, "\tprintf(\"(\");\n");
safe_fprintf(cout, "\tprint_");
overloaded_type(loc, type->data.ttuple.l, cout);
- safe_fprintf(cout, "(t->fst);\n");
+ safe_fprintf(cout, "((");
+ type_genc(type->data.ttuple.l, cout);
+ safe_fprintf(cout, ")fst(t));\n");
safe_fprintf(cout, "\tprintf(\",\");\n");
safe_fprintf(cout, "\tprint_");
overloaded_type(loc, type->data.ttuple.r, cout);
- safe_fprintf(cout, "(t->snd);\n");
+ safe_fprintf(cout, "((");
+ type_genc(type->data.ttuple.r, cout);
+ safe_fprintf(cout, ")snd(t));\n");
safe_fprintf(cout, "\tprintf(\")\");\n");
break;
default:
#include "../ast.h"
#include "../gen.h"
+/**
+ * Generate C code for the abstract syntax tree
+ *
+ * @param res abstract syntax tree
+ * @param ol dictionary of overloaded function calls
+ * @param cout stream to output the result to
+ */
void genc(const struct ast *res, const struct overload ol, FILE *cout);
#endif
#include "../ast.h"
#include "../gen.h"
+/**
+ * Generate SSM code for the abstract syntax tree
+ *
+ * @param res abstract syntax tree
+ * @param ol dictionary of overloaded function calls
+ * @param cout stream to output the result to
+ */
void genssm(const struct ast *res, const struct overload ol, FILE *cout);
#endif
* Print an identifier
*
* @param i identifier
- * @param stream to print to
+ * @param cout to print to
*/
void ident_print(struct ident i, FILE *cout);
/**
+++ /dev/null
-#include <stdlib.h>
-#include <stdbool.h>
-
-#include "list.h"
-#include "util.h"
-
-struct list *list_cons(void *el, struct list *tail)
-{
- struct list *res = xalloc(1, struct list);
- res->el = el;
- res->tail = tail;
- return res;
-}
-
-void list_free(struct list *head, void (*freefun)(void *))
-{
- while (head != NULL) {
- struct list *t = head;
- if (freefun != NULL)
- freefun(head->el);
- head = head->tail;
- free(t);
- }
-}
-
-void **list_to_array(struct list *list, int *num, bool reverse, int extra)
-{
- int i = list_length(list);
- *num = i;
- void **ptr = xalloc(i+extra, void *);
-
- struct list *r = list;
- while(i > 0) {
- if (reverse)
- ptr[--i] = r->el;
- else
- ptr[*num-(--i)-1] = r->el;
- struct list *t = r;
- r = r->tail;
- free(t);
- }
- return ptr;
-}
-
-int list_length(struct list *r)
-{
- int i = 0;
- FOREACH(e, r)
- i++;
- return i;
-}
+++ /dev/null
-#ifndef LIST_H
-#define LIST_H
-
-#include <stdbool.h>
-
-#define FOREACH(x, l) for(struct list *x = l; x != NULL; x = x->tail)
-
-struct list {
- void *el;
- struct list *tail;
-};
-
-struct list *list_cons(void *el, struct list *tail);
-void list_free(struct list *head, void (*freefun)(void *));
-void **list_to_array(struct list *list, int *num, bool reverse, int extra);
-int list_length(struct list *head);
-
-#endif
#include "array.h"
#include "ast.h"
-#include "list.h"
#include "parse.h"
int yylex(void);
#include "ast.h"
+/**
+ * Emit a type error
+ *
+ * @param l location
+ * @param d also exit with error code 1
+ * @param msg format string
+ * @param ... format arguments
+ */
void type_error(YYLTYPE l, bool d, const char *msg, ...);
+
+/**
+ * Perform all semantical analyses.
+ *
+ * @param ast pointer to the unchecked abstract syntax tree
+ * @result pointer to the checked abstract syntax tree
+ */
struct ast *sem(struct ast *ast);
#endif
#include "../ast.h"
+/**
+ * Check that all global variable initialisers are constant
+ *
+ * @param ast abstract syntax tree
+ */
void sem_check_constant(struct ast *ast);
#endif
#include "hm/scheme.h"
#include "../ident.h"
+/**
+ * Infer all types in the AST
+ *
+ * @param ast abstract syntax tree
+ * @result abstract syntax tree with all types inferred
+ */
struct ast *infer(struct ast *ast);
+/**
+ * Unify a type
+ *
+ * @param loc location of the type to localise possible errors
+ * @param l left-hand side
+ * @param r right-hand side
+ */
struct subst *unify(YYLTYPE loc, struct type *l, struct type *r);
+/**
+ * Infer an expression
+ *
+ * @param gamma environment
+ * @param expr expression to infer
+ * @param type σ, the type to infer to
+ * @result substitution
+ */
struct subst *infer_expr(struct gamma *gamma, struct expr *expr, struct type *type);
+/**
+ * Infer a statement
+ *
+ * @param gamma environment
+ * @param stmt statement to infer
+ * @param type σ, the type to infer to
+ * @result substitution
+ */
struct subst *infer_stmt(struct gamma *gamma, struct stmt *stmt, struct type *type);
-struct subst *infer_fundecl(struct gamma *gamma, struct fundecl *fundecl, struct type *ftype);
+/**
+ * Infer a function declaration
+ *
+ * @param gamma environment
+ * @param fundecl function declaration to infer
+ * @param type σ, the type to infer to
+ * @result substitution
+ */
+struct subst *infer_fundecl(struct gamma *gamma, struct fundecl *fundecl, struct type *type);
#endif
#include "../hm.h"
#include "../../ident.h"
+/** abstract type representing the environment */
struct gamma;
+/** abstract type representing an entry in the environment */
struct gamma_entry;
+/**
+ * Initialise an empty environment
+ *
+ * @result environment
+ */
struct gamma *gamma_init();
+/**
+ * Insert an entry in the environment.
+ *
+ * @param gamma environment
+ * @param ident identifier
+ * @param scheme type scheme
+ */
void gamma_insert(struct gamma *gamma, struct ident ident, struct scheme *scheme);
+/**
+ * Increment the internal scope of gamma, used to separate namespaces and
+ * scopes.
+ *
+ * @param gamma environment
+ */
void gamma_increment_scope(struct gamma *gamma);
+/**
+ * Decrement the internal scope of gamma, used to separate namespaces and
+ * scopes.
+ *
+ * @param gamma environment
+ */
void gamma_decrement_scope(struct gamma *gamma);
-void gamma_iter(struct gamma *gamma, void *st, void (*iter)(struct ident, struct scheme *, void *));
+/**
+ * Function to call for each entry while iterating over gamma.
+ *
+ * @param i type variable
+ * @param s type scheme
+ * @param st user state
+ */
+typedef void (*gamma_iterfun)(struct ident i, struct scheme *s, void *st);
+/**
+ * Iterate over all entries in gamma.
+ *
+ * @param gamma environment
+ * @param st pointer to the initial state
+ * @param iter pointer to the iteration function
+ */
+void gamma_iter(struct gamma *gamma, void *st, gamma_iterfun iter);
+
+/**
+ * Lookup an identifier in the environment
+ *
+ * @param gamma environment
+ * @param ident identifier
+ * @result pointer to the type scheme, NULL if not found
+ */
struct scheme *gamma_lookup(struct gamma *gamma, struct ident ident);
+
+/**
+ * Check whether \p ident is free in gamma.
+ *
+ * @param gamma environment
+ * @param ident identifier
+ * @result result
+ */
bool gamma_free_in(struct gamma *gamma, struct ident ident);
+/**
+ * Generate a fresh type variable.
+ *
+ * @param gamma environment
+ * @result fresh type variable
+ */
struct type *gamma_fresh(struct gamma *gamma);
-
+/**
+ * Print the entire enviroment
+ *
+ * @param gamma environment
+ * @param out output stream
+ */
void gamma_print(struct gamma *gamma, FILE *out);
+/**
+ * Recursively free the enviroment
+ *
+ * @param gamma environment
+ */
void gamma_free(struct gamma *gamma);
#endif
#include "../hm.h"
#include "../../ident.h"
+/** Definition of a type scheme */
struct scheme {
- struct type *type;
- int nvar;
- struct ident *var;
+ struct type *type; /** Type */
+ int nvar; /** Number of quantified type variables */
+ struct ident *var; /** array of quantified type variables */
};
+/**
+ * Instantiate a type scheme, i.e. replace the quantified type variables by
+ * fresh type variables.
+ *
+ * @param gamma environment
+ * @param s scheme
+ * @result type
+ */
struct type *scheme_instantiate(struct gamma *gamma, struct scheme *s);
+/**
+ * Create a scheme from a type and assume no type variable is quantified.
+ *
+ * @param t type
+ * @result scheme
+ */
struct scheme *scheme_create(struct type *t);
+/**
+ * Create a scheme by generalising a type, i.e. quantify all free type variables
+ * that are not free in gamma.
+ *
+ * @param gamma environment
+ * @param t type
+ * @result scheme
+ */
struct scheme *scheme_generalise(struct gamma *gamma, struct type *t);
+/**
+ * Check whether \p ident is free in the type scheme.
+ *
+ * @param scheme type scheme
+ * @param ident type variable
+ * @result result
+ */
bool scheme_free_in(struct scheme *scheme, struct ident ident);
-
+/**
+ * Print a type scheme.
+ *
+ * @param scheme type scheme
+ * @param out output stream
+ */
void scheme_print(struct scheme *scheme, FILE *out);
+/**
+ * Free a type scheme.
+ *
+ * @param scheme type scheme
+ */
void scheme_free(struct scheme *scheme);
#endif
#include "../hm.h"
#include "../../ident.h"
+/** Abstract type representing a substitution, a map from type variable to type */
struct subst;
+/**
+ * The identity substitution
+ *
+ * @result the empty substitution
+ */
struct subst *subst_id();
+/**
+ * Extend a substitution.
+ *
+ * @param s substitution to extend
+ * @param ident type variable
+ * @param t substitute type
+ * @result the extended substitution
+ */
struct subst *subst_insert(struct subst *s, struct ident ident, struct type *t);
+/**
+ * Create a singleton substitution.
+ * i.e. substs_singleton(i, t) == subst_insert(subst_id(), i, t)
+ *
+ * @param ident type variable
+ * @param t substitute type
+ * @result substitution
+ */
struct subst *subst_singleton(struct ident ident, struct type *t);
+/**
+ * Take the union of two substitutions. This is destructive, \p l is freed, \p r is
+ * extended with the substitutions from \p l.
+ *
+ * @param l left-hand side substitution
+ * @param r right-hand side substitution
+ * @result union substitution (
+ */
struct subst *subst_union(struct subst *l, struct subst *r);
-
-struct type *subst_apply_t(struct subst *subst, struct type *l);
+/**
+ * Apply a substitution to a type.
+ *
+ * @param subst substitution
+ * @param t type
+ * @result type
+ */
+struct type *subst_apply_t(struct subst *subst, struct type *t);
+/**
+ * Apply a substitution to a type scheme
+ *
+ * @param subst substitution
+ * @param scheme type scheme
+ * @result type scheme
+ */
struct scheme *subst_apply_s(struct subst *subst, struct scheme *scheme);
+/**
+ * Apply a substitution to an environment
+ *
+ * @param subst substitution
+ * @param gamma environment
+ * @result environment
+ */
struct gamma *subst_apply_g(struct subst *subst, struct gamma *gamma);
-
+/**
+ * Print a substitution.
+ *
+ * @param s substitution
+ * @param out output stream
+ */
void subst_print(struct subst *s, FILE *out);
+/**
+ * Free a substitution.
+ *
+ * @param s substitution
+ */
void subst_free(struct subst *s);
#endif
#include "../ast.h"
+/**
+ * Check that there is a main function and that it has the correct type.
+ *
+ * @param ast abstract syntax tree
+ */
void sem_check_main(struct ast *ast);
#endif
#include "../ast.h"
+/**
+ * Check that all functions return that have a non-void return type
+ *
+ * @param ast abstract syntax tree
+ */
void sem_check_return(struct ast *ast);
#endif
*
* Returns NULL when there are invalid edges
*
- * @param number of nodes
- * @param data of the nodes
- * @param number of edges
- * @param data of edges
+ * @param nnodes number of nodes
+ * @param nodedata data of the nodes
+ * @param nedges number of edges
+ * @param edgedata data of edges
+ * @result list of components
*/
struct components *tarjans(
int nnodes, void *nodedata[],
#include "../ast.h"
+/**
+ * Group mutually recursive functions in components.
+ *
+ * @param ast abstract syntax tree
+ */
void sem_check_scc(struct ast *ast);
#endif
break;
}
}
- gamma_print(gamma, stdout);
gamma_free(gamma);
}
#include "../ast.h"
+/**
+ * Infer and check the intire AST
+ *
+ * @param ast abstract syntax tree
+ */
void sem_check_types(struct ast *ast);
#endif
#include "../ast.h"
+/**
+ * Check that vardecls aren't mutually recursive and order them
+ *
+ * @param ast abstract syntax tree
+ */
void sem_check_vardecls(struct ast *ast);
#endif
int res = 0;
switch(l->type) {
case tarrow:
- if ((res = type_cmp(l->data.tarrow.l, r->data.tarrow.l)) != 0)
+ if ((res = type_cmp(l->data.tarrow.l, r->data.tarrow.l)) == 0)
res = type_cmp(l->data.tarrow.r, r->data.tarrow.r);
break;
case tbasic:
res = type_cmp(l->data.tlist, r->data.tlist);
break;
case ttuple:
- if ((res = type_cmp(l->data.ttuple.l, r->data.ttuple.l)) != 0)
+ if ((res = type_cmp(l->data.ttuple.l, r->data.ttuple.l)) == 0)
res = type_cmp(l->data.ttuple.r, r->data.ttuple.r);
break;
case tvar:
#include "ast.h"
#include "ident.h"
+/**
+ * Export the string representations of the basic types enumeration
+ *
+ * @see basictype
+ */
extern const char *basictype_str[];
+/** The basic types */
enum basictype {btbool, btchar, btint, btvoid};
+/** Representation of a type */
struct type {
- enum {tarrow,tbasic,tlist,ttuple,tvar} type;
+ enum {tarrow,tbasic,tlist,ttuple,tvar} type; /** tag of the tagged union */
union {
struct {
- struct type *l;
- struct type *r;
- } tarrow;
- enum basictype tbasic;
- struct type *tlist;
+ struct type *l; /** rhs of the arrow */
+ struct type *r; /** rhs of the arrow */
+ } tarrow; /** Arrow type: (l -> r) */
+ enum basictype tbasic; /** Basic type */
+ struct type *tlist; /** List type: [t] */
struct {
- struct type *l;
- struct type *r;
- } ttuple;
- struct ident tvar;
+ struct type *l; /** rhs of the tuple */
+ struct type *r; /** rhs of the tuple */
+ } ttuple; /** Tuple type: (l, r) */
+ struct ident tvar; /** Type variable */
} data;
};
+/**
+ * Constructor for the arrow type
+ *
+ * @param left left-hand side
+ * @param right right-hand side
+ * @result arrow type
+ */
struct type *type_arrow(struct type *left, struct type *right);
+/**
+ * Constructor for a basic type
+ *
+ * @param type tag of the basic type
+ * @result basic type
+ */
struct type *type_basic(enum basictype type);
+/**
+ * Constructor for a list type
+ *
+ * @param type type of the elements
+ * @result list type
+ */
struct type *type_list(struct type *type);
+/**
+ * Constructor for the tuple type
+ *
+ * @param left left-hand side
+ * @param right right-hand side
+ * @result tuple type
+ */
struct type *type_tuple(struct type *left, struct type *right);
+/**
+ * Constructor for a type variable
+ *
+ * @param ident identifier of the variable
+ * @result type variable
+ */
struct type *type_var(struct ident ident);
+/**
+ * Constructor for a type variable from a string
+ *
+ * @param s string identifier of the variable
+ * @result type variable
+ */
struct type *type_var_str(char *s);
+/**
+ * Constructor for a type variable from an integer
+ *
+ * @param i integer identifier of the variable
+ * @result type variable
+ */
struct type *type_var_int(int i);
+/**
+ * Print a type to the output stream
+ *
+ * @param type type
+ * @param stream stream to print to
+ */
void type_print(struct type *type, FILE *stream);
+/**
+ * Recursively free a type
+ *
+ * @param type type
+ */
void type_free(struct type *type);
+/**
+ * Compare a type
+ *
+ * @param l left-hand side
+ * @param r right-hand side
+ * @result comparison
+ */
int type_cmp(struct type *l, struct type *r);
+/**
+ * Duplicate a type
+ *
+ * @param t type
+ * @result duplicated type
+ */
struct type *type_dup(struct type *t);
+
+/**
+ * Find the free type variables in a type. The provided buffer will be
+ * reallocated whenever a free type variable is found.
+ *
+ * @param r type to search in
+ * @param nftv pointer to an integer representing the number of found free
+ * type variables
+ * @param ftv pointer to a pointer to a buffer for storing the free type
+ * variables
+ */
void type_ftv(struct type *r, int *nftv, struct ident **ftv);
+/**
+ * Predicate to test whether an identifier is free in a type.
+ *
+ * @param type type to search in
+ * @param ident identifier
+ * @result free
+ */
bool type_free_in(struct type *type, struct ident ident);
#endif
#include <stdbool.h>
#include <stdio.h>
-/* exit with an error message */
+/**
+ * Emit the error message and exit with return code 1
+ *
+ * @param msg format string
+ * @param ... format arguments
+ */
void die(const char *msg, ...);
-/* exit with the system's error message prefixed by msg */
+/**
+ * Emit the system's error message prefixed with \p msg and exit with return code
+ * 1
+ *
+ * @param msg message prefix
+ */
void pdie(const char *msg);
-/* if buf == NULL, a fresh buffer is allocated */
+/**
+ * Escape a character, if \p buf == NULL, a fresh buffer is allocated
+ *
+ * @param c character to escape or the name of the escape (e.g. n for newline)
+ * @param buf buffer to store the escape sequence in
+ * @param str string or in a character context (escape " or ')
+ * @result buffer containing the escape sequence
+ */
char *escape_char(char c, char *buf, bool str);
-/* unescaped character will be in position 0 and the rest from position 1 on */
+/**
+ * Unescape the given escape sequence
+ *
+ * @param c buffer starting with the escape sequence
+ * @result same buffer but now unescaped
+ */
char *unescape_char(char *c);
-/* Remove the last and first character from the string */
+/**
+ * Remove the last and first character from a string
+ *
+ * @param c string
+ * @result trimmed string
+ */
char *trimquotes(char *c);
-/* Print indentation */
+/**
+ * Print \p indent indentation level
+ *
+ * @param indent indentation level
+ * @param out output stream
+ */
void pindent(int indent, FILE *out);
-/* Safe wrappers around syscalls */
+/** Call vfprintf but bail out if it fails */
void safe_vfprintf(FILE *out, const char *msg, va_list ap);
+/** Call fprintf but bail out if it fails */
void safe_fprintf(FILE *out, const char *msg, ...);
+/** Call malloc but bail out if it fails */
void *safe_malloc(size_t size);
+/**
+ * Typed variant of safe_malloc
+ *
+ * @param nmemb number of members
+ * @param type type of the members
+ * @result pointer to the allocated buffer
+ */
#define xalloc(nmemb, type) ((type *)safe_malloc((nmemb)*sizeof(type)))
+/** Call remalloc but bail out if it fails */
void *safe_realloc(void *ptr, size_t size);
+/**
+ * Typed variant of safe_remalloc
+ *
+ * @param ptr pointer to the buffer that possibly needs reallocation
+ * @param nmemb number of members
+ * @param type type of the members
+ * @result pointer to the reallocated buffer
+ */
#define xrealloc(ptr, nmemb, type) ((type *)safe_realloc(ptr, (nmemb)*sizeof(type)))
void *safe_strdup(const char *c);
+/** Call fopen but bail out if it fails */
FILE *safe_fopen(const char *path, const char *mode);
+/** Call fclose but bail out if it fails */
void safe_fclose(FILE *file);
#endif
fail=$((fail+1))
else
"$SPLC" $1 -o "$ccode"
- "$CC" -I"$RTSDIR" "$ccode" -o "$base"
+ "$CC" -I"$RTSDIR" "$RTSDIR"/rts.c "$ccode" -o "$base"
./"$base" > "$out"
if ! diff "$out" "$expected"
then
--- /dev/null
+(2,2)(39,44)(84,126)
print(foo(42));
print(transpose((38, 42), (1, 2)));
print(scale((28, 42), 3));
+ print('\n');
}
--- /dev/null
+(39,(44,19))(114,(126,48))
scale(p, scalar) :: (Int, (Int, Int)) Int -> (Int, (Int, Int)) {
return (p.fst * scalar, (p.snd.fst * scalar, p.snd.snd * scalar));
}
+main() {
+ print(transpose((38, (42, 16)), (1, (2, 3))));
+ print(scale((38, (42, 16)), 3));
+ print('\n');
+}
// Adapt this line if your isEmpty is called differently.
isEmpty = blaat;
}
+
+main()
+{
+ f();
+
+}
repositories / ccc.git / commitdiff