9682e91ff850 — Leonard Ritter tip 16 hours ago
* NOIR frontend: translates function type, dlimport
M lib/scopes/compiler/arcmem/Array.sc +20 -0
@@ 81,6 81,26 @@ typedef+ Array
             inline (i) (self @ (i - 1:usize))
             inline (i) (i - 1:usize)
 
+    inline... offset (self, offset : usize)
+        let T = (typeof self)
+        assert (offset <= (countof self))
+        ptr := getelementptr (storagecast (view self)) offset
+        bitcast (share ptr) T
+
+    inline decons (self count)
+        let T = (typeof self)
+        count := static-if (none? count) 1
+        else count
+        if (count > (countof self))
+            raise;
+        result... := va-map
+            inline (i)
+                @ (getelementptr (storagecast (view self)) i)
+            va-range count
+        ptr := getelementptr (storagecast (view self)) count
+        self := bitcast (share ptr) T
+        (va-join result...) self
+
     """"Implements support for pointer casts, to pass the array to C functions
         for example.
     @@ memo

          
M lib/scopes/compiler/noir/Builder.sc +19 -0
@@ 222,6 222,25 @@ struct Builder
             symbol = name
         f
 
+    fn fntype-indirect (self cconv rtype types)
+        H := uhash.from-integer cconv
+        H := uhash.join H
+            uhash.from-integer rtype
+            sizeof rtype
+        H := fold (H) for T in types
+            uhash.join H
+                uhash.from-integer T
+                sizeof T
+        try
+            copy ('get self._fntypecache H)
+        else
+            id := self._module.c_func
+                cconv = cconv
+                rtype = rtype
+                types = types
+            'set self._fntypecache H id
+            id
+
     fn fntype (self cconv rtype types...)
         H := uhash.from-integer cconv
         H := uhash.join H

          
M lib/scopes/compiler/noir/Module.sc +1 -1
@@ 56,7 56,7 @@ enum IdKind : u8
 
     # inlined constants
 
-    # 56 bit unsigned integer
+    # 48 bit unsigned integer
     IndexAttr = c"u"
     # the nth function argument
     FuncArgIndex = c"a"

          
M lib/scopes/compiler/pilot/DBParser.sc +1 -1
@@ 58,7 58,7 @@ struct ParserDB
         items = ListItems
 
     inline symbol (self str)
-        H := hash str
+        H := hash.from-bytes ('data str)
         try
             copy ('get self.idx_symbol_string H)
         else

          
M lib/scopes/downcast.sc +1 -1
@@ 114,7 114,7 @@ inline typetagof (cls T)
         static-error
             .. "values of type "
                 static-repr cls
-                " can never be downcast to type "
+                " can never be downcast... to type "
                 static-repr T
     tag
 

          
M testing/compiler/frontend.sc +184 -8
@@ 3,7 3,7 @@ 
     This file is distributed under the MIT License.
     See LICENSE.md for details.
 
-unlet exit
+unlet exit Value
 #using import C.stat C.stdlib C.libgen C.string C.stdio C.limits String format print
 using import C.stdio
 

          
@@ 14,14 14,35 @@ using import format compiler.basics
     compiler.printutils
     compiler.noir.Module
     compiler.noir.Builder
+    compiler.noir.printer
     compiler.arcmem.PMap
 
 using import compiler.pilot.DBParser
 
+enum Sugar : u8
+    dlimport
+    fntype
+
+enum Value
+    id : Module.Id
+    op : Module.Operation
+    cconv : CallConv
+    sugar : Sugar
+
+Env := PMap ParserDB.Id.Symbol Value
+
 struct Context
-    db : arc@ ParserDB
+    db : ~arc@ ParserDB
     builder : Builder
     filepath : rawstring
+    assign_token : ParserDB.Id.Symbol
+
+    inline __typecall (cls db filepath)
+        assign_token := 'symbol (@ (view db)) "="
+        super-type.__typecall cls
+            db = db
+            filepath = filepath
+            assign_token = assign_token
 
     inline iterlist (self id)
         'each @self.db id

          
@@ 36,32 57,184 @@ struct Context
             /t
                 /excerpt self.filepath anchor.begin (anchor.end - anchor.begin)
         exit 255
+        unreachable;
+
+    fn decons-cconv (self env aid l)
+        cconv l := try
+            'decons l
+        else
+            'complain self aid "calling convention missing"
+        __ aid := unpack cconv
+        cconv := 'expand self env cconv
+        dispatch cconv
+        case cconv (cconv)
+            return cconv l
+        default;
+        'complain self aid "calling convention expected"
+
+    fn decons-return-type (self env aid l)
+        rtype l := try
+            'decons l
+        else
+            'complain self aid "return type missing"
+        __ aid := unpack rtype
+        rtype := 'expand self env rtype
+        dispatch rtype
+        case id (rtype)
+            try
+                downcast rtype Module.Id.CRetType
+            then (rtype)
+                return rtype l
+            else;
+        default;
+        'complain self aid "return type expected"
+
+    fn decons-element-type (self env aid l)
+        T l := try
+            'decons l
+        else
+            'complain self aid "type missing"
+        __ aid := unpack T
+        T := 'expand self env T
+        dispatch T
+        case id (T)
+            try
+                downcast T Module.Id.CElementType
+            then (T)
+                return T l
+            else;
+        default;
+        'complain self aid "type expected"
+
+    fn expand-list (self env aid l)
+        viewing self env l
+        returning Value
+        head l := try
+            'decons l
+        else
+            'complain self aid "expression is empty"
+        head := 'expand self env head
+        dispatch head
+        case sugar (s)
+            switch s
+            case 'dlimport
+                name l := try
+                    'decons l
+                else
+                    'complain self aid "name missing"
+                name aid := unpack name
+                downcast... name
+                case ParserDB.Id.String (strid)
+                    str := share (self.db.string @ strid . data)
+                    return
+                        Value.id
+                            'dlimport self.builder str
+                default
+                    'complain self aid "string expected"
+            case 'fntype
+                cconv l := 'decons-cconv self env aid l
+                rtype l := 'decons-return-type self env aid l
+                local types : Array Module.Id.CElementType
+                loop (l)
+                    if (empty? l)
+                        break;
+                    T l := 'decons-element-type self env aid l
+                    'append types T
+                    l
+                Value.id
+                    'fntype-indirect self.builder cconv rtype types
+            default
+                report s
+                assert false
+        default
+            report head
+            assert false
+        #do
+            'complain self aid "cannot translate expression"
 
     fn expand (self env expr)
         viewing self env
+        returning Value
 
         id aid := unpack expr
 
         downcast... id
         case ParserDB.Id.Symbol (symid)
             try
-                'get env symid
-                ;
+                copy ('get env symid)
             else
                 'complain self aid "unknown symbol"
-
         case ParserDB.Id.String (strid)
             str := share (self.db.string @ strid . data)
-            'intern self.builder str
+            Value.id
+                'intern self.builder str
         case ParserDB.Id.List (lid)
-            print lid
+            l := self.db.list @ lid . items
+            if (empty? l)
+                'complain self aid "empty expression"
+            count := countof l
+            if (count >= 3)
+                tok := unpack (l @ 1)
+                downcast... tok
+                case ParserDB.Id.Symbol (symid)
+                    # <name> = <expr>
+                    if (symid == self.assign_token)
+                        head := unpack (l @ 0)
+                        downcast... head
+                        case ParserDB.Id.Symbol (headid)
+                            value := if (count == 3)
+                                'expand self env (copy (l @ 2))
+                            else
+                                'expand-list self env aid ('offset l 2)
+                            'set env headid value
+                            return value
+                        default;
+                default;
+            'expand-list self env aid l
         default
             assert false
 
     fn expand-toplevel (self expr)
         viewing self
 
-        local env : PMap ParserDB.Id.Symbol Module.Id
+        local env : Env
+        va-map
+            inline (field)
+                'set env
+                    'symbol @self.db (field.Name as zarray)
+                    Value.op
+                        getattr Module.Operation field.Name
+            Module.Operation.__fields__
+        va-map
+            inline (field)
+                'set env
+                    'symbol @self.db (field.Name as zarray)
+                    Value.cconv
+                        getattr CallConv field.Name
+            CallConv.__fields__
+        va-map
+            inline (field)
+                'set env
+                    'symbol @self.db (field.Name as zarray)
+                    Value.id
+                        'wrap Module.Id.CUnit
+                            getattr CUnitKind field.Name
+            CUnitKind.__fields__
+        va-map
+            inline (field)
+                'set env
+                    'symbol @self.db (field.Name as zarray)
+                    Value.id
+                        'wrap Module.Id.CRetUnit
+                            getattr CRetUnitKind field.Name
+            CRetUnitKind.__fields__
+        va-map
+            inline (field)
+                'set env
+                    'symbol @self.db (field.Name as zarray)
+                    Value.sugar
+                        getattr Sugar field.Name
+            Sugar.__fields__
 
         for expr in ('iterlist self expr)
             expand self env expr

          
@@ 86,6 259,9 @@ fn init (c_main argc argv)
 
     'expand-toplevel ctx tl
 
+    print
+        /module @ctx.builder._module
+
     0
 #
     path := argv @ 1