M lib/scopes/cgen.sc +185 -54
@@ 4,7 4,10 @@
See LICENSE.md for details.
using import enum
+using import Array
using import String
+using import Option
+using import Rc
using import format
using import inspect
@@ 13,6 16,72 @@ using import inspect
A C code generator. This module is work in progress.
+enum _CValue
+
+CValue := Rc _CValue
+Result := tuple i32 CValue i32
+MaybeResult := Option Result
+
+Cell := Array CValue
+
+HandlerType := function
+ _: (uniqueof MaybeResult -1) (uniqueof String -2)
+ \ i32 (viewof Cell 2) i32
+
+enum _CValue
+ str : String
+ cell : Cell
+ int : i32
+ handler : (@ HandlerType)
+
+ inline __as (cls T)
+ static-if (T == String)
+ inline (v)
+ dispatch v
+ case str (s) s
+ default
+ assert false "string expected"
+ unreachable;
+ elseif (T == i32)
+ inline (v)
+ dispatch v
+ case int (i) i
+ default
+ assert false "string expected"
+ unreachable;
+ #elseif (T == Cell)
+ inline (c)
+ CValue.wrap (_CValue.cell c)
+ #
+ static-if (T == Closure)
+ inline (f)
+ CValue.wrap (_CValue.handler f)
+ elseif (T == String)
+ inline (s)
+ CValue.wrap (_CValue.str s)
+ elseif (T == Cell)
+ inline (c)
+ CValue.wrap (_CValue.cell c)
+
+type+ CValue
+ inline __rimply (T cls)
+ static-if (T == Closure)
+ inline (f)
+ CValue.wrap (_CValue.handler f)
+ elseif (T == i32)
+ inline (i)
+ CValue.wrap (_CValue.int i)
+ elseif (T == String)
+ inline (s)
+ CValue.wrap (_CValue.str s)
+ elseif (T < zarray)
+ inline (s)
+ CValue.wrap (_CValue.str s)
+ elseif (T == Cell)
+ inline (c)
+ CValue.wrap (_CValue.cell c)
+
+
fn tabs (n)
local str : String
'resize str (2 * n) " "
@@ 20,22 89,20 @@ fn tabs (n)
@@ memo
inline separator (begin sep end)
- fn (elem)
- level expr offset := elem
- result := if (offset == 1) begin
- else ""
+ fn (level expr offset)
+ result := if (offset == 1) (String begin)
+ else S""
if (offset >= (countof expr))
- _ none (.. result end)
+ _ (MaybeResult) (.. result end)
else
item := expr @ offset
- result := if (offset > 1) sep
+ result := if (offset > 1) (String sep)
else result
- _ (tuple level item 1) result
+ _ (MaybeResult (Result level (copy item) 1)) result
@@ memo
inline line-separator (begin sep end)
- fn (elem)
- level expr offset := elem
+ fn (level expr offset)
spacing := .. "\n" (tabs level)
begin := if (begin == "") begin
else
@@ 47,17 114,16 @@ inline line-separator (begin sep end)
result := if (offset == 1) begin
else ""
if (offset >= (countof expr))
- _ none (.. result end)
+ _ (MaybeResult) (.. result end)
# else
item := expr @ offset
result := if (offset > 1) sep
else result
- _ (tuple level item 1) result
+ _ (MaybeResult (Result level (copy item) 1)) result
@@ memo
inline block-separator (begin sep end levelofs)
- fn (elem)
- level expr offset := elem
+ fn (level expr offset)
sublevel := level + levelofs
inner-spacing := .. "\n" (tabs sublevel)
outer-spacing := .. "\n" (tabs level)
@@ 65,67 131,132 @@ inline block-separator (begin sep end le
sep := .. sep inner-spacing
end := .. outer-spacing end
result := if (offset == 1) begin
- else ""
+ else S""
if (offset >= (countof expr))
- _ none (.. result end)
+ _ (MaybeResult) (.. result end)
else
item := expr @ offset
result := if (offset > 1) sep
else result
- _ (tuple sublevel item 1) result
-
-fn int (elem)
- level expr offset := elem
- _ none (dec (expr @ 1))
-
-fn intliteral (elem)
- level expr offset := elem
- value := expr @ 1
- none
- .. "0x"
- hex value
- switch (sizeof value)
- case 4 "u"
- case 8 "ull"
- default ""
+ _ (MaybeResult (Result sublevel (copy item) 1)) result
inline char-printable? (c)
(c >= 32:u8) and (c < 127:u8)
-fn quotestr (x)
+fn... quotestr (x : String)
+ local str : String
sz := (countof x)
- s := loop (i s = 0 S"")
+ 'reserve str sz
+ 'append str S"\""
+ loop (i = 0)
if (< i sz)
c := x @ i
c := switch c
- case (char "\n") S"\\n"
- case (char "\t") S"\\t"
- case (char "\r") S"\\r"
- case (char "\"") S"\\\""
- case (char "\\") S"\\\\"
- case (char "\x00") S"\\0"
+ case (char "\n")
+ 'append str S"\\n"
+ case (char "\t")
+ 'append str S"\\t"
+ case (char "\r")
+ 'append str S"\\r"
+ case (char "\"")
+ 'append str S"\\\""
+ case (char "\\")
+ 'append str S"\\\\"
+ case (char "\x00")
+ 'append str S"\\0"
default
if (char-printable? c)
- String c
+ 'append str c
else
- .. (.. "\\x" (hex c)) "\"\""
- repeat (+ i 1) (.. s c)
+ 'append str "\\x"
+ 'append str (hex c)
+ 'append str "\"\""
+ repeat (+ i 1)
else
- break s
- .. "\"" (.. s "\"")
+ break;
+ str ..= "\""
+ str
+
+C := do
+ fn int (level expr offset)
+ (MaybeResult), (dec ((expr @ 1) as i32))
+
+ fn intliteral (level expr offset)
+ value := expr @ 1
+ MaybeResult;
+ .. "0x"
+ hex value
+ switch (sizeof value)
+ case 4 "u"
+ case 8 "ull"
+ default ""
+
+ fn str (level expr offset)
+ (MaybeResult), (quotestr ((@ expr 1) as String))
+
+ fn include (level expr offset)
+ (MaybeResult), (.. "#include " (quotestr ((@ expr 1) as String)))
+
+ fn sysinclude (level expr offset)
+ (MaybeResult), (.. (.. "#include <" (@ expr 1)) ">")
-#C.str = fn (elem)
- level expr offset = elem
- cell empty (C.quotestr (@ expr 1))
+ file := separator "" "\n" "\n"
+ decl := separator "" " " ""
+ let call = (separator "" "" "")
+ args := separator "(" ", " ")"
+ forargs := separator "(" "; " ")"
+ sub := separator "[" " " "]"
+ init := separator "{" ", " "}"
+ stmt := separator "" " " ";"
+ let label = (separator "" " " ":")
+ comment := separator "/* " " " " */"
+ lines := line-separator "" "" ""
+ blockargs := block-separator "(" ", " ")" 1
+ body := block-separator "{" "" "}" 1
+ switchbody := block-separator "{" "" "}" 0
+
+ locals;
+
-#C.include = fn (elem)
- level expr offset = elem
- cell empty (.. "#include " (C.quotestr (@ expr 1)))
-#C.sysinclude = fn (elem)
- level expr offset = elem
- cell empty (.. (.. "#include <" (@ expr 1)) ">")
+fn test_c_format ()
+ : := Cell
+ k := : C.file
+ : C.include "stdio.h"
+ : C.stmt "int" "array" (: C.sub (: C.int 4)) "="
+ : C.init
+ : C.int 10
+ : C.int 20
+ : C.int 30
+ : C.int 40
+ : C.stmt "typedef"
+ : C.decl "struct"
+ : C.body
+ : C.stmt "int" "x"
+ : C.stmt "int" "y"
+ "type_t"
+ ""
+ : C.comment "main function"
+ : C.decl "int" "main"
+ : C.args
+ : C.decl "int" "argc"
+ : C.decl "char*" "argv"
+ : C.body
+ : C.decl "if"
+ : C.args "argc"
+ : C.body
+ : C.comment "print a string"
+ : C.stmt "printf"
+ : C.args
+ : C.str "Hello, world! %i\n"
+ "argc"
+ : C.stmt "return" (: C.int 0)
+ "else"
+ : C.body
+ : C.stmt "return" (: C.int 1)
+ ;
-print (quotestr "this quick brown fox \neh?")
+#(test_c_format)
+#print (quotestr "this quick brown fox \neh?")
do
locals;
M lib/scopes/core.sc +2 -2
@@ 5785,8 5785,8 @@ inline clamp (x mn mx)
let resultT = ('typeof result)
if (resultT != destT)
error
- .. "function does not compile to type " (repr destT)
- \ " but has type " (repr resultT)
+ .. "function does not compile to type\n " (repr destT)
+ \ "\n but has type\n " (repr resultT)
return result
if ('function-pointer? destT)
return `(inline (self) (func->closure self destT))
M lib/scopes/format.sc +4 -4
@@ 62,19 62,19 @@ fn integer->string (value base)
break (String (& (digits @ i)) ((N - i) as usize))
repeat i value
-fn bin (value)
+inline bin (value)
let value = (value as integer)
integer->string value (2 as (typeof value))
-fn oct (value)
+inline oct (value)
let value = (value as integer)
integer->string value (8 as (typeof value))
-fn dec (value)
+inline dec (value)
let value = (value as integer)
integer->string value (10 as (typeof value))
-fn hex (value)
+inline hex (value)
let value = (value as integer)
integer->string value (16 as (typeof value))