diff --git a/examples/sysir/frontend.janet b/examples/sysir/frontend.janet new file mode 100644 index 00000000..ef5f20dc --- /dev/null +++ b/examples/sysir/frontend.janet @@ -0,0 +1,186 @@ +# Make a language frontend for the sysir. +# Dialect: +# TODO - +# * basic types +# * constants +# * sequence (do) +# * basic arithmetic +# * bindings +# * branch (if) +# * looping +# * returns +# * tail call returns +# * function definitions +# * arrays (declaration, loads, stores) +# * ... +# insight - using : inside symbols for types can be used to allow manipulating symbols with macros + +(def slot-to-name @[]) +(def name-to-slot @{}) +(def type-to-name @[]) +(def name-to-type @{}) + +(defn get-slot + [&opt new-name] + (def next-slot (length slot-to-name)) + (array/push slot-to-name new-name) + (if new-name (put name-to-slot new-name next-slot)) + next-slot) + +(defn named-slot + [name] + (assert (get name-to-slot name))) + +(defn make-type + [&opt new-name] + (def next-type (length type-to-name)) + (array/push type-to-name new-name) + (if new-name (put name-to-type new-name next-type)) + next-type) + +(defn named-type + [name] + (def t (get name-to-type name)) + (assert t) + t) + +(defn setup-default-types + [into] + (defn add-prim-type + [name native-name] + (array/push into ~(type-prim ,name ,native-name)) + (make-type name)) + (add-prim-type 'float 'f32) + (add-prim-type 'double 'f64)) + +(defn type-extract + "Given a symbol:type combination, extract the proper name and the type separately" + [combined-name &opt default-type] + (def parts (string/split ":" combined-name 0 1)) + (def [name tp] parts) + [(symbol name) (symbol (or tp default-type))]) + +(var do-binop nil) + +(defn visit1 + "Take in a form and compile code and put it into `into`. Return result slot." + [code into] + (cond + + # Compile a constant + (number? code) + (let [slot (get-slot) + slottype 'double] + (array/push into ~(bind ,slot ,slottype)) + (array/push into ~(constant ,slot ,code)) + slot) + + # Binding + (symbol? code) + (named-slot code) + + # Compile forms + (and (tuple? code) (= :parens (tuple/type code))) + (do + (assert (> (length code) 0)) + (def [op & args] code) + (case op + + # Arithmetic + '+ (do-binop 'add args into) + '- (do-binop 'subtract args into) + '* (do-binop 'multiply args into) + '/ (do-binop 'divide args into) + + # Type hinting + 'the + (do + (assert (= 2 (length args))) + (def [xtype x] args) + (def result (visit1 x into)) + (array/push into ~(bind ,result ,xtype)) + result) + + # Named bindings + # TODO - type inference + 'def + (do + (assert (= 2 (length args))) + (def [full-name value] args) + (assert (symbol? full-name)) + (def [name tp] (type-extract full-name 'double)) + (def result (visit1 value into)) + (def slot (get-slot name)) + (array/push into ~(bind ,slot ,tp)) + (array/push into ~(move ,slot ,result)) + slot) + + # Assignment + 'set + (do + (assert (= 2 (length args))) + (def [to x] args) + (def result (visit1 x into)) + (def toslot (get-slot to)) + (array/push into ~(move ,toslot ,result)) + toslot) + + # Return + 'return + (do + (assert (>= 1 (length args))) + (if (empty? args) + (array/push into '(return)) + (do + (def [x] args) + (array/push into ~(return ,(visit1 x into))))) + nil) + + # Sequence of operations + 'do + (do + (var ret nil) + (each form args (set ret (visit1 form into))) + ret) + (errorf "unknown form %V" code))) + (errorf "cannot compile %V" code))) + +(varfn do-binop + [opcode args into] + (var final nil) + (each arg args + (def right (visit1 arg into)) + (set final + (if final + (let [result (get-slot)] + # TODO - finish type inference - we should be able to omit the bind + # call and sysir should be able to infer the type + (array/push into ~(bind ,result double)) + (array/push into ~(,opcode ,result ,final ,right)) + result) + right))) + (assert final)) + +### +### +### + +(def myprog + '(do + (def xyz (+ 1 2 3)) + (def abc (* 4 5 6)) + (return (/ abc xyz)))) + +(defn dotest + [] + (def ctx (sysir/context)) + (def ir-asm + @['(link-name "entry") + '(parameter-count 0)]) + (setup-default-types ir-asm) + (visit1 myprog ir-asm) + (printf "%.99M" ir-asm) + (sysir/asm ctx ir-asm) + (print (sysir/to-c ctx))) + +(dotest) diff --git a/src/core/sysir.c b/src/core/sysir.c index e6d8471a..d6cf9e4f 100644 --- a/src/core/sysir.c +++ b/src/core/sysir.c @@ -1,5 +1,5 @@ /* -* Copyright (c) 2023 Calvin Rose +* Copyright (c) 2024 Calvin Rose * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to @@ -30,8 +30,10 @@ * [ ] named fields (for debugging mostly) * [x] named registers and types * [x] better type errors (perhaps mostly for compiler debugging - full type system goes on top) + * [ ] switch internal use of uint32_t everywhere to type struct wrappers for safety * [ ] support for switch-case * [ ] x86/x64 machine code target + * [ ] LLVM target * [ ] target specific extensions - custom instructions and custom primitives * [ ] better casting semantics * [x] separate pointer arithmetic from generalized arithmetic (easier to instrument code for safety)? @@ -950,11 +952,59 @@ static void tcheck_equal(JanetSysIR *sysir, uint32_t reg1, uint32_t reg2) { } } +static int tcheck_cast_type(JanetSysIR *sysir, uint32_t td, uint32_t ts) { + JanetSysIRLinkage *linkage = sysir->linkage; + if (td == ts) return 0; /* trivial case */ + JanetPrim primd = linkage->type_defs[td].prim; + JanetPrim prims = linkage->type_defs[ts].prim; + if (primd == prims) { + /* Pointer casting should be stricter than in C - for now, we + * allow casts as long as size and aligment are identical. Also + * no casting between arrays and pointers + * + * TODO - check array and pointer types have same alignment + + switch (primd) { + default: + return -1; + case JANET_PRIM_ARRAY: + return tcheck_cast_type(sysir, linkage->type_defs[td].array.type, linkage->type_defs[ts].array.type); + case JANET_PRIM_POINTER: + return tcheck_cast_type(sysir, linkage->type_defs[td].pointer.type, linkage->type_defs[ts].pointer.type); + } + return 0; + */ + return -1; /* TODO */ + } + /* Check that both src and dest are primitive numerics */ + for (int i = 0; i < 2; i++) { + JanetPrim p = i ? prims : primd; + switch (p) { + default: + break; + case JANET_PRIM_STRUCT: + case JANET_PRIM_UNION: + case JANET_PRIM_UNKNOWN: + case JANET_PRIM_ARRAY: + case JANET_PRIM_POINTER: + return -1; + } + } + return 0; +} + static void tcheck_cast(JanetSysIR *sysir, uint32_t dest, uint32_t src) { (void) sysir; (void) dest; (void) src; - /* TODO - casting rules */ + uint32_t td = sysir->types[dest]; + uint32_t ts = sysir->types[src]; + int notok = tcheck_cast_type(sysir, td, ts); + if (notok) { + janet_panicf("type failure, %V cannot be cast to %V", + tname(sysir, ts), + tname(sysir, td)); + } } static void tcheck_constant(JanetSysIR *sysir, uint32_t dest, Janet c) { @@ -1239,7 +1289,6 @@ static void emit_binop(JanetSysIR *ir, JanetBuffer *buffer, JanetBuffer *tempbuf /* Add nested for loops for any dimensionality of array */ while (linkage->type_defs[operand_type].prim == JANET_PRIM_ARRAY) { - /* TODO - handle fixed_count == SIZE_MAX */ janet_formatb(buffer, "for (size_t _j%u = 0; _j%u < %u; _j%u++) ", index_index, index_index, linkage->type_defs[operand_type].array.fixed_count, @@ -1277,7 +1326,7 @@ void janet_sys_ir_lower_to_c(JanetSysIRLinkage *linkage, JanetBuffer *buffer) { #define EMITBINOP(OP) emit_binop(ir, buffer, tempbuf, instruction, OP) /* Prelude */ - janet_formatb(buffer, "#include \n\n"); + janet_formatb(buffer, "#include \n\n"); /* Emit type defs */ for (uint32_t j = 0; j < (uint32_t) linkage->ir_ordered->count; j++) { @@ -1457,9 +1506,11 @@ void janet_sys_ir_lower_to_c(JanetSysIRLinkage *linkage, JanetBuffer *buffer) { } janet_formatb(buffer, ");\n"); break; - case JANET_SYSOP_CAST: - janet_formatb(buffer, "_r%u = (_t%u) _r%u;\n", instruction.two.dest, ir->types[instruction.two.dest], instruction.two.src); + case JANET_SYSOP_CAST: { + uint32_t to = ir->types[instruction.two.dest]; + janet_formatb(buffer, "_r%u = (_t%u) (_r%u);\n", instruction.two.dest, to, instruction.two.src); break; + } case JANET_SYSOP_MOVE: janet_formatb(buffer, "_r%u = _r%u;\n", instruction.two.dest, instruction.two.src); break; @@ -1517,7 +1568,6 @@ static int sysir_gcmark(void *p, size_t s) { return 0; } - static int sysir_context_gc(void *p, size_t s) { JanetSysIRLinkage *linkage = (JanetSysIRLinkage *)p; (void) s;