ed740ce1653f — Leonard Ritter tip 7 hours ago
* small improvement to error message when trying to cast functions
3 files changed, 191 insertions(+), 60 deletions(-)

M lib/scopes/cgen.sc
M lib/scopes/core.sc
M lib/scopes/format.sc
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))