6b2e7f79a878 — Leonard Ritter 24 days ago
* renoir: extended CFUNCTION, added CVARIADIC, VATYPEPARAM, ANCHOROF
* compiler: proper handling of captured VA in closures, validate pcall argument count
M lib/scopes/compiler/noir/renoir.sc +201 -1
@@ 153,6 153,7 @@ struct FactorType
     next-func-function := toplevel-iterator-helper Module.Id.Function 'func 'funcid
     next-procid-function := toplevel-iterator-helper Module.Id.Procedure 'proc 'procid
     next-cfunctionid-function := toplevel-iterator-helper Module.Id.CFunction 'c_func 'cfunctionid
+    next-cvariadic-function := toplevel-iterator-helper Module.Id.CVariadic 'c_va 'cvariadic
 
     @@ memo
     inline next-op-function (cls mask)

          
@@ 745,9 746,11 @@ FACTOR_TYPES := do
     struct CCONV < IdKindFactorType (Id := Module.Id.CConv)
     struct CRETTYPE < IdKindFactorType (Id := Module.Id.CRetType)
     struct CELEMENTTYPE < IdKindFactorType (Id := Module.Id.CElementType)
-    struct CFUNCTION < IdKindFactorType (Id := Module.Id.CFunction)
     struct GLOBAL < NotIdKindFactorType (Id := Module.Id.Instruction)
 
+    #struct CFUNCTION < IdKindFactorType (Id := Module.Id.CFunction)
+    #struct CVARIADIC < IdKindFactorType (Id := Module.Id.CVariadic)
+
     struct OP < MaybeInstructionFactorType
         @@ memo
         inline match-configs (cls)

          
@@ 910,6 913,83 @@ FACTOR_TYPES := do
                         return false
                     return true
 
+    struct ANCHOROF < MaybeInstructionFactorType
+        @@ memo
+        inline match-configs (cls)
+            using cls.Bits
+            (convolve-flags anchorid)
+                super-type.match-configs cls
+
+        @@ memo
+        inline template-configs (cls)
+            using cls.Bits
+            pass fully-defined
+
+        anchorid : Module.Id.Anchor
+
+        inline next (cls reducer factor state builder procid id anchorid)
+            module := @builder._module
+            module-index := @builder._index
+            from cls let Bits
+            'dispatch-match cls factor
+                inline "#hidden" (mask)
+                    next-procid-id := 'next-procid-id-function cls mask builder state procid id
+                    inline next-anchorid ()
+                        loop ()
+                            procid id := next-procid-id ()
+                            id := imply id Module.Id
+                            try
+                                downcast id Module.Id.Instruction
+                            then (id)
+                                md := 'scheduleof module-index procid
+                                try
+                                    copy ('get md.debuginfo id)
+                                then (aid)
+                                    anchorid = aid
+                                    break;
+                            else
+                                try
+                                    downcast id Module.Id.Anchorable
+                                then (id)
+                                    try
+                                        copy ('get module-index.debuginfo id)
+                                    then (aid)
+                                        anchorid = aid
+                                        break;
+                                    else;
+                                else;
+                    try
+                        next-anchorid ()
+                    else
+                        return false
+                    return true
+
+        inline apply (cls reducer rule vars factor builder procid id anchorid)
+            from cls let Bits
+            'dispatch-template cls factor
+                inline "#hidden" (mask)
+                    procid := try! downcast procid Module.Id.Procedure
+                    anchorid := try! downcast anchorid Module.Id.Anchor
+                    try
+                        downcast id Module.Id.Instruction
+                    then (id)
+                        'di builder procid id anchorid
+                        'proc-changed reducer procid
+                        'trace-change reducer rule factor procid id
+                        return;
+                    else
+                        try
+                            downcast id Module.Id.Anchorable
+                        then (id)
+                            'di builder procid id anchorid
+                            module := @builder._module
+                            module-index := @builder._index
+                            'update-debuginfo module-index
+                            return;
+                        else;
+                    'remark reducer factor.aid "anchor can only be set on anchorable"
+                    raise;
+
     struct ARG < InstructionFactorType
         @@ memo
         inline match-configs (cls)

          
@@ 1825,6 1905,66 @@ FACTOR_TYPES := do
                             row.proc = copy procid
                     ;
 
+    struct CFUNCTION < FactorType
+        @@ memo
+        inline match-configs (cls)
+            using cls.Bits
+            pass
+                | cconv rtype count
+                | cfunctionid cconv rtype count
+
+        cfunctionid : Module.Id.CFunction
+        cconv : Module.Id.CConv
+        rtype : Module.Id.CRetType
+        count : Module.Id.IndexAttr
+
+        inline next (cls reducer factor state builder cfunctionid cconv rtype count)
+            module := @builder._module
+            from cls let Bits
+            'dispatch-match cls factor
+                inline "#hidden" (mask)
+                    next-funcid := 'next-cfunctionid-function cls mask builder state cfunctionid
+                    inline next-type ()
+                        funcid := next-funcid ()
+                        row := module.c_func @ funcid
+                        cconv = imply row.cconv Module.Id.CConv
+                        rtype = row.rtype
+                        count = 'wrap Module.Id.IndexAttr (countof row.types)
+                    try
+                        next-type ()
+                    else
+                        return false
+                    return true
+
+    struct CVARIADIC < FactorType
+        @@ memo
+        inline match-configs (cls)
+            using cls.Bits
+            pass
+                | funcid count
+                | cvariadic funcid count
+
+        cvariadic : Module.Id.CVariadic
+        funcid : Module.Id.CFunction
+        count : Module.Id.IndexAttr
+
+        inline next (cls reducer factor state builder cvariadic funcid count)
+            module := @builder._module
+            from cls let Bits
+            'dispatch-match cls factor
+                inline "#hidden" (mask)
+                    next-varid := 'next-cvariadic-function cls mask builder state cvariadic
+                    inline next-type ()
+                        varid := next-varid ()
+                        row := module.c_va @ varid
+                        funcid = row.func
+                        count = 'wrap Module.Id.IndexAttr (countof row.types)
+                    try
+                        next-type ()
+                    else
+                        return false
+                    return true
+
     struct FNTYPEPARAM < FactorType
         @@ memo
         inline match-configs (cls)

          
@@ 1885,6 2025,66 @@ FACTOR_TYPES := do
                         return false
                     return true
 
+    struct VATYPEPARAM < FactorType
+        @@ memo
+        inline match-configs (cls)
+            using cls.Bits
+            (convolve-flags fully-defined cvariadic)
+                (convolve-flags fully-defined index)
+                    \ fully-defined typeid
+
+        cvariadic : Module.Id.CVariadic
+        index : Module.Id.IndexAttr
+        typeid : Module.Id.CElementType
+
+        inline next (cls reducer factor state builder cvariadic index T)
+            module := @builder._module
+            from cls let Bits
+            'dispatch-match cls factor
+                inline "#hidden" (mask)
+                    next-varid := 'next-cvariadic-function cls mask builder state cvariadic
+                    next-varid-type := static-if (Bits.index in mask)
+                        inline ()
+                            loop ()
+                                bit := state.init & Bits.index
+                                varid idx := if (bit == 0)
+                                    varid := next-varid ()
+                                    pass varid 0:usize
+                                else
+                                    state.init ^= bit
+                                    varid := try! downcast (copy cvariadic) Module.Id.CVariadic
+                                    pass varid ((index as usize) + 1)
+                                row := module.c_va @ varid
+                                if (idx >= (countof row.types))
+                                    repeat;
+                                state.init |= Bits.index
+                                index = 'wrap Module.Id.IndexAttr idx
+                                break varid (copy (row.types @ idx))
+                    else
+                        inline ()
+                            loop ()
+                                varid := next-varid ()
+                                row := module.c_va @ varid
+                                idx := index as usize
+                                if (idx >= (countof row.types))
+                                    repeat;
+                                break varid (copy (row.types @ idx))
+                    next-type := static-if (Bits.typeid in mask)
+                        inline ()
+                            varid t := next-varid-type ()
+                            T = t
+                    else
+                        inline ()
+                            loop ()
+                                varid t := next-varid-type ()
+                                if (t == T)
+                                    break;
+                    try
+                        next-type ()
+                    else
+                        return false
+                    return true
+
     struct KINDOF < FactorType
         @@ memo
         inline match-configs (cls)

          
M lib/scopes/compiler/noir/rules-reducer.sx +89 -6
@@ 1,3 1,53 @@ 
+# available factors:
+
+    EQ|NE $x $a $b
+    LE|LT|GE|GT $x $a $b
+    ADD|SUB|MUL|DIV $x $a $b
+    IDPAIR $ab $a $b
+    CONST|MACRO $value
+    NAMEABLE|CCONV|CRETTYPE|CELEMENTTYPE|GLOBAL $value
+    CFUNCTION $cfunction $cconv $rtype $numargs
+    FNTYPEPARAM $cfunction $index $type
+    CVARIADIC $cvariadic $cfunction $numargs
+    VATYPEPARAM $cvariadic $index $type
+    OP $macro $effect $op
+    ARGCOUNT $macro $effect $op
+    ARG $macro $effect $index $value
+    FOLLOW $macro $value $target
+    NDEP $macro $effect $value $mode
+    DEP $macro $effect $value $mode
+    SIZEOF $macro $value $size
+    ANCHOROF $macro $value $anchor
+    TYPESIZEOF $T $size
+    FOLDOP $x $op $a $b
+    EXPORT $macro $key $value
+    REPLACEOF $macro $value
+    VAMAP $va_index $key $value
+    VA $va_index $key $value
+    VACOUNT $index $count
+    RANGE $i $begin $end
+    RRANGE $i $begin $end
+    FUNC $func $ftype $macro
+    SYMINFO $target $name
+    KINDOF $value $T
+    INDEXOF $value $index
+    METAOP? $op $is_meta
+    SIDEOP? $op $is_side
+    CONSTDATA $const $sym
+    INDEXDATA $index $sym
+    INSTANCE $destmacro $sourcemacro $key
+
+# template only:
+
+    COMPLAIN|CGENERROR|EXPLAIN|REMARK $macro $value $symbol
+    DUMP $value
+    DUMPVA $index
+    TRACE $macro $value
+    FNTYPEVA $type $cconv $rtype $index
+    VATYPEVA $type $ftype $index
+    DLIMPORT $dlsym $name
+    ALIAS $macro $value $target
+
 # TODO:
     an unreachable instance effect using a macro that has no side effects can be
     removed.

          
@@ 99,7 149,7 @@ VATYPE
         OP $ctx $id VATYPE
         ARG $ctx $id 0 $ftype_
         FOLLOW $ctx $ftype_ $ftype
-        CFUNCTION $ftype
+        KINDOF $ftype CFunction
         ARGCOUNT $ctx $id $argcount
         RULE () ((VACOUNT 0 0))
         RULE

          
@@ 120,7 170,7 @@ FUNC
         OP $ctx $id FUNC
         ARG $ctx $id 0 $ftype_
         FOLLOW $ctx $ftype_ $ftype
-        CFUNCTION $ftype
+        KINDOF $ftype CFunction
         ARG $ctx $id 1 $macro_
         FOLLOW $ctx $macro_ $macro
         MACRO $macro

          
@@ 275,9 325,41 @@ FUNC-MACRO-instance
                 OP $instance $id inattr
                 ARG $instance $id 1 $sz
         FUNC $funcid _ $instance
-CLOSURE-inline-global
-    # inline constant upattrs into macro;
-        we assume that each closure is uniquely used, saving the instance
+CLOSURE-resolve-va-upattr
+    # rewrite UPATTR->VA[n] as VA->UPATTR[0..n]
+        we assume that the closure is uniquely used and do not instance it
+    ;
+        OP $ctx $id CLOSURE
+        ARG $ctx $id 0 $macro_
+        FOLLOW $ctx $macro_ $macro
+        MACRO $macro
+        OP $macro $mid UPATTR
+        ARG $macro $mid 0 $i_
+        ADD $i $i_ 1
+        ARG $ctx $id $i $value_
+        FOLLOW $ctx $value_ $value
+        OP $ctx $value VA
+    ;
+        OP $macro $mid VA
+        ARGCOUNT $macro $mid 0
+        RULE
+            ;
+                ARG $ctx $value $k $va_arg
+                ARGCOUNT $ctx $id $nexti
+                SUB $upi $nexti 1
+            ;
+                ARG $ctx $id $nexti $va_arg
+                OP $macro $newmid UPATTR
+                ARG $macro $newmid 0 $upi
+                ARG $macro $mid $k $newmid
+                RULE
+                    ;
+                        ANCHOROF $ctx $va_arg $anchor
+                    ;
+                        ANCHOROF $macro $newmid $anchor
+CLOSURE-resolve-upattr
+    # resolve constant upattrs;
+        we assume that the closure is uniquely used and do not instance it
     ;
         OP $ctx $id CLOSURE
         ARG $ctx $id 0 $macro_

          
@@ 603,12 685,13 @@ DEP-fold
             ;
                 NDEP $ctx $id $src_ $mode
 VA
-    # proper reduction of variadic lists containing other variadic lists
+    # for any real instruction, VA or APPLY with VA arguments, elide VA.
     ;
         OP $ctx $id $op #VA
         NOT
             METAOP? $op true
             EQ false $op VA
+            EQ false $op APPLY
         ARGCOUNT $ctx $id $n
         ARG $ctx $id $i $arg_
         FOLLOW $ctx $arg_ $arg

          
M lib/scopes/compiler/noir/rules-validator.sx +46 -17
@@ 1,29 1,29 @@ 
 #rule-test
     ;
-        OP $proc $id
-        ARG $proc $id 0 $target
+        OP $ctx $id
+        ARG $ctx $id 0 $target
     ;
-        COMPLAIN $proc $id "this is a complaint about {$id} in {$proc} calling {$target}"
-        REMARK $proc $id "this is a remark"
-        EXPLAIN $proc $target "here is some context"
+        COMPLAIN $ctx $id "this is a complaint about {$id} in {$ctx} calling {$target}"
+        REMARK $ctx $id "this is a remark"
+        EXPLAIN $ctx $target "here is some context"
 typed-macro-rules
     ;
         RULE # add roots to VA 1
             ;
-                FUNC $f _ $proc
+                FUNC $f _ $ctx
                 NOT # if not visited
-                    VAMAP 0 $proc _
+                    VAMAP 0 $ctx _
             ;
-                VAMAP 0 $proc true # mark visited
-                VA 1 _ $proc # append to list
+                VAMAP 0 $ctx true # mark visited
+                VA 1 _ $ctx # append to list
         # enumerate the growing VA 1
-        VA 1 _ $proc
+        VA 1 _ $ctx
         RULE
             ;
                 # find references to other macros in effects
-                OP $proc $id $op
+                OP $ctx $id $op
                 METAOP? $op false
-                ARG $proc $id _ $target
+                ARG $ctx $id _ $target
                 MACRO $target
                 NOT
                     VAMAP 0 $target _

          
@@ 32,18 32,47 @@ typed-macro-rules
                 VA 1 _ $target
     ;
         RULE
+            # pcall signature checks
+            ;
+                OP $ctx $id pcall
+                ARG $ctx $id 0 $type_
+                FOLLOW $ctx $type_ $type
+                ARGCOUNT $ctx $id $count_
+                SUB $count $count_ 2
+            ;
+                RULE
+                    # non-variadic pcall: check argument count
+                    ;
+                        KINDOF $type CFunction
+                        CFUNCTION $type _ _ $argcount
+                        NE true $count $argcount
+                    ;
+                        COMPLAIN $ctx $id "argument count mismatch in pcall \
+                            ({$argcount} expected, {$count} provided)"
+                RULE
+                    # variadic pcall: check argument count
+                    ;
+                        KINDOF $type CVariadic
+                        CVARIADIC $type $ftype $numargs
+                        CFUNCTION $ftype _ _ $funcargs
+                        ADD $argcount $numargs $funcargs
+                        NE true $count $argcount
+                    ;
+                        COMPLAIN $ctx $id "argument count mismatch in variadic \
+                            pcall ({$argcount} expected, {$count} provided)"
+        RULE
             # unresolved upattrs
             ;
-                OP $proc $id UPATTR
+                OP $ctx $id UPATTR
             ;
-                COMPLAIN $proc $id "toplevel functions may only capture constants"
+                COMPLAIN $ctx $id "toplevel functions may only capture constants"
         RULE
             # non-meta effects that do not have a valid size
             ;
-                OP $proc $id $op
+                OP $ctx $id $op
                 METAOP? $op false
                 NOT
-                    SIZEOF $proc $id $sz
+                    SIZEOF $ctx $id $sz
             ;
-                CGENERROR $proc $id "failed to compute size of {$op} effect \
+                CGENERROR $ctx $id "failed to compute size of {$op} effect \
                     in {$proc}."

          
M testing/noir/hello.sc +3 -1
@@ 3,6 3,7 @@ printf = dlimport 'printf
 printf-type = fntype auto s32 ptr
 printf_ = vatype printf-type
 printf_s32 = vatype printf-type s32
+printf_s32_s32_s32 = vatype printf-type s32 s32 s32
 
 TRACE
     x := VA 0 1 2 3 4 5 6 7 8 9

          
@@ 20,10 21,11 @@ fn main : s32
     argc : s32
     argv : ptr
     do
-        pcall printf_s32 printf "hell(o) world! %i %i %i\n" x
+        pcall printf_s32_s32_s32 printf "hell(o) world! %i %i %i\n" x
         if (ieq argc 2)
             pcall printf_ printf "two arguments passed\n"
         else
             pcall printf_ printf "one argument passed\n"
         pcall printf_ printf "third line!\n"
         pass 0
+