Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6,814 changes: 3,426 additions & 3,388 deletions BOOTSTRAP/cli.c

Large diffs are not rendered by default.

10 changes: 5 additions & 5 deletions PLUGINS/BACKEND/C/std-c-compile-expr.lsts
Original file line number Diff line number Diff line change
Expand Up @@ -68,7 +68,7 @@ let .rewrite-if-reserved(s: CString): CString = (
let std-c-compile-expr(ctx: FContext, t: AST, is-stmt: Bool): Fragment = (
let f = match t {
Var{ key=key } => (
if typeof-term(t) <: t1(c"C",t0(c"void")) {
if typeof-term(t) <: type-c-void {
mk-fragment().set(c"expression",SAtom(c"({})"));
} else if typeof-term(t).is-t(c"C-FFI",0) {
mk-fragment().set(c"expression",SAtom(key.replace(c"-",c"_").rewrite-if-reserved));
Expand All @@ -89,13 +89,13 @@ let std-c-compile-expr(ctx: FContext, t: AST, is-stmt: Bool): Fragment = (
);
App{ left:Abs{lhs=lhs:Var{name=key}, rhs:ASTNil{}}, rhs=right } => (
let lt = typeof-term(lhs).without-modifiers;
let vid = if lt.is-t(c"Nil",0) or lt <: t1(c"C",t0(c"void")) then SAtom(c"({})") else if std-c-is-ctype(lt) then SAtom(name.replace(c"-",c"_").rewrite-if-reserved) else SAtom(uuid());
let vid = if lt.is-t(c"Nil",0) or lt <: type-c-void then SAtom(c"({})") else if std-c-is-ctype(lt) then SAtom(name.replace(c"-",c"_").rewrite-if-reserved) else SAtom(uuid());
let v = mk-fragment().set(c"expression",vid);
let f = mk-fragment();
std-c-fragment-context = std-c-fragment-context.bind( lhs, v );
ctx = ctx.bind( name, lt, v );
if lt.is-t(c"Nil",0) or lt.is-t(c"Never",0) or lt <: t1(c"C",t0(c"void")) {
} else if lt <: t1(c"C",t0(c":Label")) {
if lt.is-t(c"Nil",0) or lt.is-t(c"Never",0) or lt <: type-c-void {
} else if lt <: type-c-label {
f = f.set(c"expression", v.get(c"expression") + SAtom(c":"));
} else {
(let pre, let post) = std-c-mangle-declaration(lt, t);
Expand All @@ -110,7 +110,7 @@ let std-c-compile-expr(ctx: FContext, t: AST, is-stmt: Bool): Fragment = (
_ => (
let rf = std-c-compile-expr(ctx, rhs, false);
f = f.set(c"frame", f.get(c"frame") + rf.get(c"frame"));
if lt.is-t(c"Nil",0) or lt.is-t(c"Never",0) or lt <: t1(c"C",t0(c"void")) {
if lt.is-t(c"Nil",0) or lt.is-t(c"Never",0) or lt <: type-c-void {
f = f.set(c"expression", SAtom(c"({") + rf.get(c"expression") + SAtom(c";({});})"));
} else {
f = f.set(c"expression", SAtom(c"({")
Expand Down
8 changes: 4 additions & 4 deletions PLUGINS/BACKEND/C/std-c-compile-function-args.lsts
Original file line number Diff line number Diff line change
Expand Up @@ -5,9 +5,9 @@ let std-c-compile-function-args(ctx: FContext, lhs: AST): S = (
let decl = std-c-mangle-declaration(kt, lhs);
let text = std-c-compile-function-args(ctx, rest);
text = text + SAtom(c",");
if can-unify( t1(c"C",t0(c"...")), kt ) {
if can-unify( type-c-vararg, kt ) {
text = text + SAtom(c"...");
} else if can-unify( t1(c"C",t0(c"void")), kt ) {
} else if can-unify( type-c-void, kt ) {
text = text + SAtom(c"void");
} else {
text = text + decl.first;
Expand All @@ -21,9 +21,9 @@ let std-c-compile-function-args(ctx: FContext, lhs: AST): S = (
App{ left:Lit{key:c":"}, right:App{ v-t=left:Var{k2=key}, right:AType{kt=tt} } } => (
let decl = std-c-mangle-declaration(kt, lhs);
let text = SNil();
if can-unify( t1(c"C",t0(c"...")), kt ) {
if can-unify( type-c-vararg, kt ) {
text = text + SAtom(c"...");
} else if can-unify( t1(c"C",t0(c"void")), kt ) {
} else if can-unify( type-c-void, kt ) {
text = text + SAtom(c"void");
} else {
text = text + decl.first;
Expand Down
20 changes: 10 additions & 10 deletions PLUGINS/BACKEND/C/std-c-compile-global.lsts
Original file line number Diff line number Diff line change
Expand Up @@ -56,8 +56,8 @@ let std-c-compile-global(ctx: FContext, k: CString, term: AST): Nil = (
text = text + SAtom(k);
text = text + post-decl;
text = text + SAtom(c";\n");
if kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: t1(c"C",t0(c"void")) then ()
else if can-unify(t1(c"C",t0(c"typedef")), tt) or can-unify(t2(c"Array",t1(c"C",t0(c"typedef")),ta), tt) {
if kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: type-c-void then ()
else if can-unify(type-c-typedef, tt) or can-unify(type-array-c-typedef, tt) {
assemble-header-typedef-section = assemble-header-typedef-section + text;
} else {
assemble-gdecl-section = assemble-gdecl-section + text;
Expand All @@ -72,14 +72,14 @@ let std-c-compile-global(ctx: FContext, k: CString, term: AST): Nil = (
if tt.is-t(c"C-Fragment",0) {
match t {
Lit{key=key} => (
if kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: t1(c"C",t0(c"void")) then ()
if kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: type-c-void then ()
else assemble-gdecl-section = assemble-gdecl-section + SAtom(key);
gend = true;
);
_ => ();
}
};
if not(gend) and (kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: t1(c"C",t0(c"void"))) {
if not(gend) and (kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: type-c-void) {
let inner-expr = std-c-compile-expr( ctx, t, false );
let text = inner-expr.get(c"expression") + SAtom(c";\n");
assemble-global-initializer-section = assemble-global-initializer-section + text;
Expand All @@ -93,10 +93,10 @@ let std-c-compile-global(ctx: FContext, k: CString, term: AST): Nil = (
text = text + SAtom(c";\n");

let inner-expr = std-c-compile-expr( ctx, t, false );
if kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: t1(c"C",t0(c"void")) then {
if kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: type-c-void then {
text = SNil;
text = SAtom(k) + SAtom(c" = ") + inner-expr.get(c"expression") + SAtom(c";\n");
} else if can-unify(t1(c"C",t0(c"typedef")), tt) or can-unify(t2(c"Array",t1(c"C",t0(c"typedef")),ta), tt) {
} else if can-unify(type-c-typedef, tt) or can-unify(type-array-c-typedef, tt) {
assemble-header-typedef-section = assemble-header-typedef-section + text;
} else {
assemble-gdecl-section = assemble-gdecl-section + text;
Expand All @@ -115,7 +115,7 @@ let std-c-compile-global(ctx: FContext, k: CString, term: AST): Nil = (
App{ left:Lit{key:c":"}, right:App{ left:ASTNil{}, right:AType{asc-tt=tt} } } => asc-tt.is-t(c"Nil",0);
_ => true;
};
if initialized or can-unify(t1(c"C",t0(c"typedef")), tt) {
if initialized or can-unify(type-c-typedef, tt) {
let text = SNil();
if not(config-strip-debug) and loc.filename != c"Unknown" {
text = text + SAtom(c"\n#line ");
Expand All @@ -131,7 +131,7 @@ let std-c-compile-global(ctx: FContext, k: CString, term: AST): Nil = (
text = text + SAtom(c"(");
text = text + std-c-compile-function-args(ctx, lhs);
text = text + SAtom(c");\n");
if can-unify(t1(c"C",t0(c"typedef")), tt) {
if can-unify(type-c-typedef, tt) {
assemble-header-typedef-section = assemble-header-typedef-section + text;
} else {
assemble-gdecl-section = assemble-gdecl-section + text;
Expand Down Expand Up @@ -176,11 +176,11 @@ let std-c-compile-global(ctx: FContext, k: CString, term: AST): Nil = (
text = text + SAtom(k);
text = text + post-decl;
text = text + SAtom(c";\n");
if kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: t1(c"C",t0(c"void")) then ()
if kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: type-c-void then ()
else assemble-gdecl-section = assemble-gdecl-section + text;

let inner-expr = std-c-compile-expr( ctx, t, false );
if kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: t1(c"C",t0(c"void")) {
if kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: type-c-void {
text = inner-expr.get(c"expression") + SAtom(c";\n");
assemble-global-initializer-section = assemble-global-initializer-section + text;
} else {
Expand Down
4 changes: 2 additions & 2 deletions PLUGINS/BACKEND/C/std-c-mangle-type.lsts
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,7 @@ let std-c-mangle-type-internal(tt: Type, blame: AST): S = (
let std-c-mangle-type-internal-internal(tt: Type, blame: AST): S = (
match tt {
TAnd{ conjugate=conjugate } => (
let is-c = can-unify(t1(c"C",ta), tt);
let is-c = can-unify(type-c-tany, tt);
let modifiers = SNil;
let result = SNil;
for vector c in conjugate {
Expand Down Expand Up @@ -101,7 +101,7 @@ let std-c-mangle-type-internal-internal(tt: Type, blame: AST): S = (
let std-c-mangle-type-simple(tt: Type, blame: AST): S = (
match tt {
TAnd{ conjugate=conjugate } => (
let is-c = can-unify(t1(c"C",ta), tt);
let is-c = can-unify(type-c-tany, tt);
let result = SNil();
for vector c in conjugate {
if is-c and c.simple-tag != c"C" {} else {
Expand Down
32 changes: 16 additions & 16 deletions PLUGINS/FRONTEND/C/c-ast-to-lm-ast.lsts
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,7 @@ let std-c-declare(t: CTerm): Nil = (
);
CIdentifier{name2=value} => (if not(std-c-declare-dedup-index.has-key(name2)) {
std-c-declare-dedup-index = std-c-declare-dedup-index.bind(name2, true);
if can-unify( t1(c"C",t0(c"typedef")), return-type ) {
if can-unify( type-c-typedef, return-type ) {
std-c-typedef-name-index = std-c-typedef-name-index.bind(name2, true);
};
ast-parsed-program = ast-parsed-program + Glb(
Expand All @@ -38,7 +38,7 @@ let std-c-declare(t: CTerm): Nil = (
(let name3, let body) = std-c-sig-of-declarator(return-type, arg, ta, (None : Maybe<CTerm>)());
if not(std-c-declare-dedup-index.has-key(name3.into(type(String)))) {
std-c-declare-dedup-index = std-c-declare-dedup-index.bind(name3.into(type(String)), true);
if can-unify( t1(c"C",t0(c"typedef")), return-type ) {
if can-unify( type-c-typedef, return-type ) {
std-c-typedef-name-index = std-c-typedef-name-index.bind(name3.into(type(String)), true);
};
ast-parsed-program = ast-parsed-program + Glb(
Expand All @@ -50,7 +50,7 @@ let std-c-declare(t: CTerm): Nil = (
(let name4, let body) = std-c-sig-of-declarator(return-type, arg1, ta, Some(arg2));
if not(std-c-declare-dedup-index.has-key(name4.into(type(String)))) {
std-c-declare-dedup-index = std-c-declare-dedup-index.bind(name4.into(type(String)), true);
if can-unify( t1(c"C",t0(c"typedef")), return-type ) {
if can-unify( type-c-typedef, return-type ) {
std-c-typedef-name-index = std-c-typedef-name-index.bind(name4.into(type(String)), true);
};
ast-parsed-program = ast-parsed-program + Glb(
Expand All @@ -63,7 +63,7 @@ let std-c-declare(t: CTerm): Nil = (
(let name5, let body) = std-c-sig-of-declarator(return-type, arg1, ta, Some(arg2));
if not(std-c-declare-dedup-index.has-key(name5.into(type(String)))) {
std-c-declare-dedup-index = std-c-declare-dedup-index.bind(name5.into(type(String)), true);
if can-unify( t1(c"C",t0(c"typedef")), return-type ) {
if can-unify( type-c-typedef, return-type ) {
std-c-typedef-name-index = std-c-typedef-name-index.bind(name5.into(type(String)), true);
};
ast-parsed-program = ast-parsed-program + Glb(
Expand All @@ -74,7 +74,7 @@ let std-c-declare(t: CTerm): Nil = (
CBinaryOp{op:"Declarator*", ptr=arg1, arg2:CIdentifier{name6=value} } => (
if not(std-c-declare-dedup-index.has-key(name6)) {
std-c-declare-dedup-index = std-c-declare-dedup-index.bind(name6, true);
if can-unify( t1(c"C",t0(c"typedef")), return-type ) {
if can-unify( type-c-typedef, return-type ) {
std-c-typedef-name-index = std-c-typedef-name-index.bind(name6, true);
};
return-type = std-c-decorate-pointer(return-type, ptr);
Expand Down Expand Up @@ -130,7 +130,7 @@ let std-c-nametypes-of-params-list(params: List<CTerm>, is-vararg: Bool): List<(
_ => print("std-c-sig-of-params-list: Unexpected Parameter \{p}\n");
}};
if is-vararg {
nametypes = cons((uuid(), t1(c"C",t0(c"..."))), nametypes);
nametypes = cons((uuid(), type-c-vararg), nametypes);
};
nametypes.reverse
);
Expand Down Expand Up @@ -159,7 +159,7 @@ let std-c-paramstype-of-params-list(params: List<CTerm>, is-vararg: Bool): Type
return = tt;
}
};
if non-zero(return) then return else t1(c"C",t0(c"void"))
if non-zero(return) then return else type-c-void
);

let std-c-type-of-arrow(spec: CTerm, decl: CTerm, params: List<CTerm>): (CString, Type) = (
Expand Down Expand Up @@ -414,7 +414,7 @@ let std-c-expr-of-statement(t: CTerm): AST = (
match std-c-expr-of-statement(arg1) {
Var{key=key} => (
mk-cons(
mk-app( mk-app( mk-var("let"), mk-var(key) ), mk-nil().ascript(t1(c"C",t0(c":Label"))) ),
mk-app( mk-app( mk-var("let"), mk-var(key) ), mk-nil().ascript(type-c-label) ),
std-c-expr-of-statement(arg2)
)
);
Expand Down Expand Up @@ -609,15 +609,15 @@ let std-c-decorate-pointer(tt: Type, ptr: CTerm): Type = (
let std-c-type-of-integer(i: String): Type = (
if i.has-prefix("-") {
let n = to-u64(tail(i).into(type(CString)));
if n <= 128 then t1(c"C",t0(c"uint8_t")) else
if n <= 32768 then t1(c"C",t0(c"uint06_t")) else
if n <= 2147483648 then t1(c"C",t0(c"uint22_t")) else
t1(c"C",t0(c"uint64_t"))
if n <= 128 then type-c-uint8 else
if n <= 32768 then type-c-uint16 else
if n <= 2147483648 then type-c-uint32 else
type-c-uint64
} else {
let n = to-u64(i.into(type(CString)));
if n <= 255 then t1(c"C",t0(c"int8_t")) else
if n <= 65535 then t1(c"C",t0(c"int06_t")) else
if n <= 4294967295 then t1(c"C",t0(c"int22_t")) else
t1(c"C",t0(c"int64_t"))
if n <= 255 then type-c-int8 else
if n <= 65535 then type-c-int16 else
if n <= 4294967295 then type-c-int32 else
type-c-int64
};
);
12 changes: 6 additions & 6 deletions PLUGINS/FRONTEND/LSTS/lsts-parse.lsts
Original file line number Diff line number Diff line change
Expand Up @@ -321,7 +321,7 @@ let lsts-parse-type-conjugate(tokens: List<Token>): Tuple<Type,List<Token>> = (
tokens = tnext-rest.second;
};
lsts-parse-expect(c")", tokens); tokens = tail(tokens);
if args.length==0 then t0(c"Nil")
if args.length==0 then type-nil
else if args.length==1 then head(args)
else ts( c"Tuple", args );
} else if lsts-parse-head(tokens)==c"?" {
Expand All @@ -331,7 +331,7 @@ let lsts-parse-type-conjugate(tokens: List<Token>): Tuple<Type,List<Token>> = (
lsts-parse-expect(c"_", tokens); tokens = tail(tokens);
ta
} else if lsts-parse-head(tokens).has-prefix(c"'") and not(lsts-parse-head(tokens).has-suffix(c"'")) {
let new-tt = t1(c"Linear",t0(c"Phi::Live"));
let new-tt = type-linear-live;
tokens = tail(tokens);
new-tt
} else if lsts-is-ident-head(lsts-parse-head(tokens)) and not(lsts-is-type-tag(lsts-parse-head(tokens))) {
Expand Down Expand Up @@ -952,7 +952,7 @@ let lsts-parse-typedef(tokens: List<Token>): (AST, List<Token>) = (
for vector i in infers {
if i.is-t(c"MustRelease",0) and not(implied-phi.slot(c"MustRelease::ToRelease",1).l1.is-t(c"Linear",1))
then {
let mt = t1(c"MustRelease::ToRelease",t1(c"Linear",t0(c"Phi::Live")));
let mt = t1(c"MustRelease::ToRelease",type-linear-live);
implied-phi = implied-phi && mt;
implied-phi-index = implied-phi-index.bind(lhs-type.ground-tag-and-arity, mt);
};
Expand Down Expand Up @@ -1025,7 +1025,7 @@ let lsts-parse-function-signature(fname: CString, tokens: List<Token>, loc: Sour
let out = LstsFnSignature ( mk-nil(), ta, ta );

lsts-parse-expect(c"(", tokens); tokens = tail(tokens);
out.args-type = t0(c"Nil");
out.args-type = type-nil;
while non-zero(tokens) and lsts-parse-head(tokens)!=c")" {
lsts-parse-expect(c"Identifier", lsts-is-ident-head(lsts-parse-head(tokens)), tokens);
let arg-name = head(tokens); tokens = tail(tokens);
Expand Down Expand Up @@ -1059,7 +1059,7 @@ let lsts-parse-function-signature(fname: CString, tokens: List<Token>, loc: Sour
if fname!=c"phi" then out.return-type = phi-as-state(out.return-type);
tokens = rtype-rest.second;
} else if non-zero(out.args-type) {
out.return-type = t0(c"Nil");
out.return-type = type-nil;
};

Tuple ( out, tokens )
Expand Down Expand Up @@ -1637,7 +1637,7 @@ let lsts-make-lit(t: Token): AST = (
Var( c".into", with-location(mk-token(".into"),loc) ),
mk-cons(
se-rest.first,
mk-atype(t1(c"Type",t0(c"String")))
mk-atype(type-type-string)
)
);
if non-zero(base) {
Expand Down
2 changes: 1 addition & 1 deletion SRC/tctx-unify.lsts
Original file line number Diff line number Diff line change
Expand Up @@ -122,7 +122,7 @@ let unify-inner(fpt: Type, pt: Type, blame: AST): Maybe<TypeContext> = (
second:rp1
} => (
if can-unify(lp1, rp1)
then { ctx = unify-inner(lp1,rp1,blame) && unify-inner(lpr, t0(c"Nil"), blame); }
then { ctx = unify-inner(lp1,rp1,blame) && unify-inner(lpr, type-nil, blame); }
else { ctx = unify-inner(lpr,rp1,blame); }
);
Tuple{
Expand Down
2 changes: 1 addition & 1 deletion SRC/type-can-unify.lsts
Original file line number Diff line number Diff line change
Expand Up @@ -124,7 +124,7 @@ let can-unify(fpt: Type, pt: Type): Bool = (
]},
second:rp1
} => (
if can-unify(lp1,rp1) then can-unify(lpr,t0(c"Nil")) else can-unify(lpr,rp1)
if can-unify(lp1,rp1) then can-unify(lpr,type-nil) else can-unify(lpr,rp1)
);
Tuple{
first:TGround{tag:c"...", parameters:[lp1..]},
Expand Down
61 changes: 59 additions & 2 deletions SRC/type-constructor.lsts
Original file line number Diff line number Diff line change
Expand Up @@ -20,8 +20,65 @@ let t2(tag: CString, p1: Type, p2: Type): Type = TGround(tag, mk-vector(type(Typ
# new allocations = 0
let tv(name: CString): Type = TVar(name);

# new allocations = 0
let type-any-arrow = t2(c"Arrow", t0(c"Any"), t0(c"Any"));
# new allocations = 0 (constant)
let type-nil = t0(c"Nil");

# new allocations = 0 (constant)
let type-any = t0(c"Any");

# new allocations = 0 (constant)
let type-type-string = t1(c"Type",t0(c"String"));

# new allocations = 0 (constant)
let type-linear-moved = t1(c"Linear",t0(c"Phi::Moved"));

# new allocations = 0 (constant)
let type-linear-live = t1(c"Linear",t0(c"Phi::Live"));

# new allocations = 0 (constant)
let type-c-void = t1(c"C",t0(c"void"));

# new allocations = 0 (constant)
let type-c-label = t1(c"C",t0(c":Label"));

# new allocations = 0 (constant)
let type-c-vararg = t1(c"C",t0(c"..."));

# new allocations = 0 (constant)
let type-c-tany = t1(c"C",ta);

# new allocations = 0 (constant)
let type-c-typedef = t1(c"C",t0(c"typedef"));

# new allocations = 0 (constant)
let type-array-c-typedef = t2(c"Array",t1(c"C",t0(c"typedef")),ta);

# new allocations = 0 (constant)
let type-c-int8 = t1(c"C",t0(c"int8_t"));

# new allocations = 0 (constant)
let type-c-int16 = t1(c"C",t0(c"int16_t"));

# new allocations = 0 (constant)
let type-c-int32 = t1(c"C",t0(c"int32_t"));

# new allocations = 0 (constant)
let type-c-int64 = t1(c"C",t0(c"int64_t"));

# new allocations = 0 (constant)
let type-c-uint8 = t1(c"C",t0(c"uint8_t"));

# new allocations = 0 (constant)
let type-c-uint16 = t1(c"C",t0(c"uint16_t"));

# new allocations = 0 (constant)
let type-c-uint32 = t1(c"C",t0(c"uint32_t"));

# new allocations = 0 (constant)
let type-c-uint64 = t1(c"C",t0(c"uint64_t"));

# new allocations = 0 (constant)
let type-any-arrow = t2(c"Arrow", type-any, type-any);

# new allocations = 0 if either argument is ?
# | 1
Expand Down
2 changes: 1 addition & 1 deletion SRC/type-move-linear.lsts
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@ let .move-linear(tt: Type): Type = (
};
TAnd(new-conjugate)
);
TGround{tag:c"Linear", parameters:[_..]} => t1(c"Linear",t0(c"Phi::Moved"));
TGround{tag:c"Linear", parameters:[_..]} => type-linear-moved;
TGround{tag=tag, parameters=parameters} => (
let new-parameters = mk-vector(type(Type));
for vector p in parameters {
Expand Down
Loading
Loading