提交: 3c16c3b79096f4a6c757e06af58bb81d68910725 - cammy (git)

A categorical programming language

Commit MetaInfo

• 修订版: 3c16c3b79096f4a6c757e06af58bb81d68910725 (tree)
• 时间: 2023-01-10 09:15:42
• 作者: Corbin <cds@corb...>
• Commiter: Corbin

Log Message

Use a macro to simplify some append°.

This is a 40% efficient abstraction (5 lines added, 2 lines removed); it
is not worthwhile on its own. It might be more useful in a few minutes,
though.

更改概述

• modified: movelist/cammy-wasm.scm

差异

--- a/movelist/cammy-wasm.scm
+++ b/movelist/cammy-wasm.scm
@@ -4,6 +4,16 @@
 
 (import (cammyo))
 
+; Flatten an arbitrary number of lists into one list by repeated appending.
+; This is not as cheap as flatten°, but it correctly preserves nested
+; structure. It's mostly meant as syntax sugar. Note that the arguments are
+; backwards from appendo: (concat° out x1 x2 x3 …)
+(define-syntax concat°
+  (syntax-rules ()
+    ((_ xs) (nullo xs))
+    ((_ xs x) (== xs x))
+    ((_ xs x1 x2 . rest) (fresh (l) (appendo x1 x2 l) (concat° xs l . rest)))))
+
 ; Give a WASM type to a single atomic value.
 ; Cammy Ty <-> WAT Ty
 (define (atomic-type° cty wty)
@@ -108,6 +118,11 @@
     ((== expr 'succ) (== insts '((i32.const 1) (i32.add))))
     ))
 
+; Create a fresh symbol ala (gensym s) and bind it to a logic variable.
+; Meant for creating fresh locals for WASM.
+; string -> WAT Symbol
+(define (sym° s v) (conda ((== v (gensym s))) ((symbolo v))))
+
 ; Relate expressions to operations and input+output port contexts.
 ; Cammy <-> WAT Insts × Port × Port
 (define (ops-ports° expr insts input output)
@@ -120,25 +135,20 @@
      (context-prim° expr input output)
      (port-ctx° ip _ls1 ictx) (port-ctx° op _ls2 octx)
      (get-locals° get ip) (save-locals° save op)
-     (appendo get temp insts) (appendo body save temp)))
+     (concat° insts get body save)))
     ; Composition of stackful portful operations.
     ((fresh (f g finsts ginsts ctx)
             (== expr `(comp ,f ,g)) (appendo finsts ginsts insts)
             (ops-ports° f finsts input ctx) (ops-ports° g ginsts ctx output)))
     ))
 
-; Create a fresh symbol ala (gensym s) and bind it to a logic variable.
-; Meant for creating fresh locals for WASM.
-; string -> WAT Symbol
-(define (sym° s v) (conda ((== v (gensym s))) ((symbolo v))))
-
 ; Compile code which operates on the WASM stack and also accesses some fresh
 ; locals. (WASM toolchains require declaring all locals before usage.)
 ; Cammy <-> WAT Insts × WAT Locals
 (define (local-ops° expr ops locals)
   (conde
     ((stack-ops° expr ops) (nullo locals))
-    ((fresh (x f done loop i v t xty xops fops xlocals flocals xflocals block loop1 loop2)
+    ((fresh (x f done loop i v t xty xops fops xlocals flocals block loopbody)
             (== expr `(pr ,x ,f)) (cammy° expr 'N t) (atomic-type° t xty)
             (local-ops° x xops xlocals) (local-ops° f fops flocals)
             (sym° "$done" done) (sym° "$loop" loop) (sym° "$i" i) (sym° "$v" v)
@@ -146,18 +156,17 @@
             (appendo xops
               `((local.set ,v) (block ,done ,loop1) (local.get ,v))
               block)
-            (appendo
-              `(loop ,loop
-                (local.get ,i) (i32.eqz) (br_if ,done)
-                (local.get ,v))
-              loop2 loop1)
-            (appendo fops
-              `((local.set ,v)
-                (local.get ,i) (i32.const 1) (i32.sub) (local.set ,i)
-                (br ,loop))
-              loop2)
-            (appendo xlocals flocals xflocals)
-            (appendo `((local ,v ,xty) (local ,i i32)) xflocals locals)))
+            (concat° loopbody
+                     `(loop ,loop
+                            (local.get ,i) (i32.eqz) (br_if ,done)
+                            (local.get ,v))
+                     fops
+                     `((local.set ,v)
+                       (local.get ,i) (i32.const 1) (i32.sub) (local.set ,i)
+                       (br ,loop)))
+            (concat° locals
+                     `((local ,v ,xty) (local ,i i32)) xlocals flocals)
+            ))
     ))
 
 ; Types for a row of variables on the stack.
@@ -185,15 +194,14 @@
 ; Relationally compile to WASM.
 ; Cammy <-> string × WAT Func
 (define (wasm-func° expr name func)
-  (fresh (source target ops params locals results decls ps rs plen prelude body)
+  (fresh (source target ops params locals results ps rs plen prelude)
          (cammy° expr source target)
          (local-ops° expr ops locals)
          (row° source params) (row° target results)
          (conso 'param params ps) (conso 'result results rs)
-         (appendo `(func ,name ,ps ,rs) locals decls)
          ; We have to load each param to the stack at the beginning of the function.
-         (lengtho params plen) (prelude° plen prelude) (appendo prelude ops body)
-         (appendo decls body func)
+         (lengtho params plen) (prelude° plen prelude)
+         (concat° func `(func ,name ,ps ,rs) locals prelude ops)
          ))
 
 ; The relational boundary for compiling a single function.