From 38ff55045521392e060a28db0bcb44fb46c28771 Mon Sep 17 00:00:00 2001
From: Kartik Agaram <vc@akkartik.com>
Date: Tue, 20 Oct 2020 10:02:31 -0700
Subject: 7083

Defining functions mostly working. But we still need to fix the cursor
afterwards.
---
 apps/tile/environment.mu | 17 +++++++++++++++--
 apps/tile/word.mu        | 28 ++++++++++++++++++++++++++++
 2 files changed, 43 insertions(+), 2 deletions(-)

(limited to 'apps/tile')

diff --git a/apps/tile/environment.mu b/apps/tile/environment.mu
index 0fdb5e75..80b749ff 100644
--- a/apps/tile/environment.mu
+++ b/apps/tile/environment.mu
@@ -654,15 +654,21 @@ fn copy-unbound-words-to-args _functions: (addr handle function) {
   {
     compare curr, 0
     break-if-=
-    $copy-unbound-words-to-args:unbound: {
+    $copy-unbound-words-to-args:loop-iter: {
+      # is it a number?
       {
         var is-int?/eax: boolean <- word-is-decimal-integer? curr
         compare is-int?, 0  # false
-        break-if-!= $copy-unbound-words-to-args:unbound
+        break-if-!= $copy-unbound-words-to-args:loop-iter
       }
+      # is it a pre-existing function?
       var bound?/ebx: boolean <- bound-function? curr, functions-ah
       compare bound?, 0  # false
       break-if-!=
+      # is it already bound as an arg?
+      var dup?/ebx: boolean <- arg-exists? _functions, curr  # _functions = target-ah
+      compare dup?, 0  # false
+      break-if-!= $copy-unbound-words-to-args:loop-iter
       # push copy of curr before dest-ah
       var rest-h: (handle word)
       var rest-ah/ecx: (addr handle word) <- address rest-h
@@ -700,6 +706,13 @@ fn bound-function? w: (addr word), functions-ah: (addr handle function) -> resul
   result <- copy found?
 }
 
+fn arg-exists? _f-ah: (addr handle function), arg: (addr word) -> result/ebx: boolean {
+  var f-ah/eax: (addr handle function) <- copy *_f-ah
+  var f/eax: (addr function) <- lookup *f-ah
+  var args-ah/eax: (addr handle word) <- get f, args
+  result <- word-exists? args-ah, arg
+}
+
 # construct a call to `f` with copies of exactly its args
 fn construct-call _f-ah: (addr handle function), _dest-ah: (addr handle word) {
   var f-ah/eax: (addr handle function) <- copy _f-ah
diff --git a/apps/tile/word.mu b/apps/tile/word.mu
index 80fd6f3e..697e6c40 100644
--- a/apps/tile/word.mu
+++ b/apps/tile/word.mu
@@ -279,6 +279,34 @@ fn copy-words _src-ah: (addr handle word), _dest-ah: (addr handle word) {
   copy-words next-src-ah, next-dest-ah
 }
 
+# ABSOLUTELY GHASTLY
+fn word-exists? _haystack-ah: (addr handle word), _needle: (addr word) -> result/ebx: boolean {
+  var needle-name-storage: (handle addr byte)
+  var needle-name-ah/eax: (addr handle array byte) <- address needle-name-storage
+  word-to-string _needle, needle-name-ah  # profligate leak
+  var _needle-name/eax: (addr array byte) <- lookup *needle-name-ah
+  var needle-name/edi: (addr array byte) <- copy _needle-name
+  # base case
+  result <- copy 0   # false
+  var haystack-ah/esi: (addr handle word) <- copy _haystack-ah
+  var curr/eax: (addr word) <- lookup *haystack-ah
+  compare curr, 0
+  break-if-=
+  # check curr
+  var curr-name-storage: (handle addr byte)
+  var curr-name-ah/ecx: (addr handle array byte) <- address curr-name-storage
+  word-to-string curr, curr-name-ah  # profligate leak
+  var curr-name/eax: (addr array byte) <- lookup *curr-name-ah
+  var found?/eax: boolean <- string-equal? needle-name, curr-name
+  result <- copy found?
+  compare result, 0
+  break-if-!=
+  # recurse
+  var curr/eax: (addr word) <- lookup *haystack-ah
+  var next-haystack-ah/eax: (addr handle word) <- get curr, next
+  result <- word-exists? next-haystack-ah, _needle
+}
+
 fn copy-words-in-reverse _src-ah: (addr handle word), _dest-ah: (addr handle word) {
   var src-ah/eax: (addr handle word) <- copy _src-ah
   var _src-a/eax: (addr word) <- lookup *src-ah
-- 
cgit 1.4.1-2-gfad0