1
0
mirror of https://github.com/janet-lang/janet synced 2024-11-16 05:34:48 +00:00

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.
This commit is contained in:
Calvin Rose 2024-09-29 15:55:10 -05:00
parent f36d544deb
commit ea332ff81e
4 changed files with 137 additions and 55 deletions

View File

@ -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))])

View File

@ -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)

View File

@ -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);
}
}
}

View File

@ -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