From ea332ff81ee244b1c3343575cec05e496a888f5f Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 29 Sep 2024 15:55:10 -0500 Subject: [PATCH] More work on making the temporary frontend a little nicer. We need to create abstractions around more of the backend to properly test and experiment with things, even if the frontend is not final. --- examples/sysir/frontend.janet | 90 +++++++++++++++++++++++++++------ examples/sysir/samples.janet | 93 +++++++++++++++++++++-------------- src/core/sysir.c | 7 ++- src/core/tuple.c | 2 +- 4 files changed, 137 insertions(+), 55 deletions(-) diff --git a/examples/sysir/frontend.janet b/examples/sysir/frontend.janet index a6aa9a3d..2ee5738a 100644 --- a/examples/sysir/frontend.janet +++ b/examples/sysir/frontend.janet @@ -1,16 +1,6 @@ # 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) (defdyn *ret-type* "Current function return type") @@ -20,6 +10,7 @@ (def type-to-name @[]) (def name-to-type @{}) (def slot-types @{}) +(def functions @{}) (defn get-slot [&opt new-name] @@ -263,9 +254,14 @@ # Assume function call (do (def slots @[]) + (def signature (get functions op)) + (assert signature (string "unknown function " op)) (def ret (if no-return nil (get-slot))) - (each arg args - (array/push slots (visit1 arg into))) + (when ret + (array/push into ~(bind ,ret ,(first signature))) + (assign-type ret (first signature))) + (each [arg-type arg] (map tuple (drop 1 signature) args) + (array/push slots (visit1 arg into false arg-type))) (array/push into ~(call :default ,ret [pointer ,op] ,;slots)) ret))) @@ -345,6 +341,57 @@ (def [head & rest] form) (case head + # Declare a struct + 'defstruct + (do + (def into @[]) + (def [name & fields] rest) + (assert (even? (length fields)) "expected an even number of fields for struct definition") + (def field-types @[]) + (each [field-name typ] (partition 2 fields) + # TODO - don't ignore field names + (array/push field-types typ)) + (array/push into ~(type-struct ,name ,;field-types)) + # (eprintf "%.99M" into) + (sysir/asm ctx into)) + + # Declare a union + 'defunion + (do + (def into @[]) + (def [name & fields] rest) + (assert (even? (length fields)) "expected an even number of fields for struct definition") + (def field-types @[]) + (each [field-name typ] (partition 2 fields) + # TODO - don't ignore field names + (array/push field-types typ)) + (array/push into ~(type-union ,name ,;field-types)) + # (eprintf "%.99M" into) + (sysir/asm ctx into)) + + # Declare an array type + 'defarray + (do + (def into @[]) + (def [name element cnt] rest) + (assert (and (pos? cnt) (int? cnt)) "expected positive integer for array count") + (array/push into ~(type-array ,name ,element ,cnt)) + # (eprintf "%.99M" into) + (sysir/asm ctx into)) + + # External function + 'defn-external + (do + (def [name args] rest) + (assert (tuple? args)) + (def [fn-name fn-tp] (type-extract name 'void)) + (def pcount (length args)) #TODO - more complicated signatures + (def signature @[fn-tp]) + (each arg args + (def [name tp] (type-extract arg 'int)) + (array/push signature tp)) + (put functions fn-name (freeze signature))) + # Top level function definition 'defn (do @@ -354,23 +401,26 @@ (array/clear slot-to-name) (def [name args & body] rest) (assert (tuple? args)) - (def [fn-name fn-tp] (type-extract name 'int)) + (def [fn-name fn-tp] (type-extract name 'void)) (def pcount (length args)) #TODO - more complicated signatures (def ir-asm @[~(link-name ,(string fn-name)) ~(parameter-count ,pcount)]) + (def signature @[fn-tp]) (each arg args (def [name tp] (type-extract arg 'int)) (def slot (get-slot name)) (assign-type name tp) + (array/push signature tp) (array/push ir-asm ~(bind ,slot ,tp))) (with-dyns [*ret-type* fn-tp] (each part body (visit1 part ir-asm true))) - (eprintf "%.99M" ir-asm) + (put functions fn-name (freeze signature)) + # (eprintf "%.99M" ir-asm) (sysir/asm ctx ir-asm)) - (errorf "unknown form %v" form))) + (errorf "unknown form %p" form))) ### ### Setup @@ -398,3 +448,13 @@ (defn dumpc [] (print (sysir/to-c ctx))) + +### +### Top Level aliases +### + +(defmacro defstruct [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defstruct ,;args))]) +(defmacro defunion [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defunion ,;args))]) +(defmacro defarray [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defarray ,;args))]) +(defmacro defn-external [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defn-external ,;args))]) +(defmacro defsys [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defn ,;args))]) diff --git a/examples/sysir/samples.janet b/examples/sysir/samples.janet index 016da05f..71c9eebc 100644 --- a/examples/sysir/samples.janet +++ b/examples/sysir/samples.janet @@ -1,50 +1,67 @@ (use ./frontend) -(def square - '(defn square:int [num:int] - (return (* 1 num num)))) +(defstruct vec3 + a float + b float + c float) -(def simple - '(defn simple:int [x:int] - (def xyz:int (+ 1 2 3)) - (return (* x 2 x)))) +(defunion myunion + a float + b double + c long) -(def myprog - '(defn myprog:int [] - (def xyz:int (+ 1 2 3)) - (def abc:int (* 4 5 6)) - (def x:boolean (= xyz 5)) - (var i:int 0) - (while (< i 10) - (set i (+ 1 i)) - (printf "i = %d\n" i)) - (printf "hello, world!\n%d\n" (the int (if x abc xyz))) - #(return (* abc xyz)))) - (return (the int (simple (* abc xyz)))))) +(defarray myvec float 4) -(def doloop - '(defn doloop [x:int y:int] - (var i:int x) - (while (< i y) - (set i (the int (+ 1 i))) - (printf "i = %d\n" (the int i))) - (myprog) - (return x))) +(defn-external printf:int [fmt:pointer x:int]) # TODO varargs -(def main-fn - '(defn _start:void [] - #(syscall 1 1 "Hello, world!\n" 14) - (doloop 10 20) - (exit (the int 0)) - (return))) +(defn-external exit:void [x:int]) + +(defsys square:int + [num:int] + (return (* 1 num num))) + +(defsys simple:int [x:int] + (def xyz:int (+ 1 2 3)) + (return (* x 2 x))) + +(defsys myprog:int [] + (def xyz:int (+ 1 2 3)) + (def abc:int (* 4 5 6)) + (def x:boolean (= xyz 5)) + (var i:int 0) + (while (< i 10) + (set i (+ 1 i)) + (printf "i = %d\n" i)) + (printf "hello, world!\n%d\n" (if x abc xyz)) + (return (simple (* abc xyz)))) + +(defsys doloop [x:int y:int] + (var i:int x) + (while (< i y) + (set i (the int (+ 1 i))) + (printf "i = %d\n" i)) + (myprog) + (return x)) + +(defsys _start:void [] + #(syscall 1 1 "Hello, world!\n" 14) + (doloop 10 20) + (exit (the int 0)) + (return)) + +(defsys test_inttypes:ulong [] + (def x:ulong 123:u) + (return (+ x x))) + +(defsys test_arrays:myvec [a:myvec b:myvec] + (return (+ a b))) + +(defsys make_array:myvec [] + (def vec:myvec 0) + (return vec)) #### -(compile1 square) -(compile1 simple) -(compile1 myprog) -(compile1 doloop) -(compile1 main-fn) #(dump) (dumpc) #(dumpx64) diff --git a/src/core/sysir.c b/src/core/sysir.c index 7308c8bf..bcd38217 100644 --- a/src/core/sysir.c +++ b/src/core/sysir.c @@ -1256,7 +1256,12 @@ static void op_or_const(JanetSysIR *ir, JanetBuffer *buf, uint32_t reg) { janet_formatb(buf, "_r%u", reg); } else { uint32_t constant_id = reg - JANET_SYS_CONSTANT_PREFIX; - janet_formatb(buf, "%v", ir->constants[constant_id].value); + if (janet_checktype(ir->constants[constant_id].value, JANET_ABSTRACT)) { + /* Allow printing int types */ + janet_formatb(buf, "%V", ir->constants[constant_id].value); + } else { + janet_formatb(buf, "%v", ir->constants[constant_id].value); + } } } diff --git a/src/core/tuple.c b/src/core/tuple.c index c67c94a0..97aa483f 100644 --- a/src/core/tuple.c +++ b/src/core/tuple.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