From e248226f442f289f3b7399411cdfd127a0de4d1a Mon Sep 17 00:00:00 2001
From: Mirek Kratochvil <exa.exa@gmail.com>
Date: Sat, 12 Nov 2022 19:02:45 +0100
Subject: [PATCH] o hello prlg

---
 app/Builtins.hs    | 15 +++++++++++----
 app/Code.hs        | 15 +++++++++++----
 app/Interpreter.hs |  4 ++++
 3 files changed, 26 insertions(+), 8 deletions(-)

diff --git a/app/Builtins.hs b/app/Builtins.hs
index b4d6b8d..eb62526 100644
--- a/app/Builtins.hs
+++ b/app/Builtins.hs
@@ -6,6 +6,11 @@ import qualified Data.Map as M
 import Env
 import qualified Operators as O
 
+import Debug.Trace
+
+hello :: BuiltinFunc
+hello = BuiltinFunc $ trace "hllo prlg"
+
 addBuiltins :: PrlgEnv ()
 addBuiltins = do
   a1 <- findStruct "a" 1
@@ -13,19 +18,21 @@ addBuiltins = do
   b <- findAtom "b"
   c <- findAtom "c"
   b0 <- findStruct "b" 0
-  any <- findStruct "any" 1
-  eq <- findStruct "=" 2
+  any1 <- findStruct "any" 1
+  eq2 <- findStruct "=" 2
+  hello0 <- findStruct "hello" 0
   modify $ \s ->
     s
       { defs =
           M.fromList
-            [ (eq, [[U (LocalRef 0 Nothing), U (LocalRef 0 Nothing), NoGoal]])
+            [ (eq2, [[U (LocalRef 0 Nothing), U (LocalRef 0 Nothing), NoGoal]])
             , (a1, [[U (Atom a), NoGoal], [U (Atom b), NoGoal]])
             , ( b0
               , [ [Goal, U (Struct a1), U (Atom c), LastCall]
                 , [Goal, U (Struct a1), U (Atom b), LastCall]
                 ])
-            , (any, [[U (VoidRef Nothing), NoGoal]])
+            , (any1, [[U (VoidRef Nothing), NoGoal]])
+            , (hello0, [[Builtin hello]])
             ]
       , ops = [(O.xfy "," 1000), (O.xfx "=" 700)]
       }
diff --git a/app/Code.hs b/app/Code.hs
index 94e8ce3..53d2e8f 100644
--- a/app/Code.hs
+++ b/app/Code.hs
@@ -11,12 +11,19 @@ data Datum
   | HeapRef Int (Maybe Int) -- heap structure idx
   deriving (Show, Eq, Ord)
 
+data BuiltinFunc =
+  BuiltinFunc (Interp -> Interp)
+
+instance Show BuiltinFunc where
+  show _ = "BuiltinFunc _"
+
 data Instr
   = U Datum -- something unifiable
-  | NoGoal -- trivial goal
-  | Goal -- we start a new goal, set up backtracking etc
-  | Call -- all seems okay, call the goal
-  | LastCall -- tail call the goal
+  | NoGoal -- trivial goal (directly after head)
+  | Builtin BuiltinFunc -- trivial goal (directly after head)
+  | Goal -- a new goal (set head)
+  | Call -- all seems okay, call the head's hoal
+  | LastCall -- tail call the head's goal
   | Cut -- remove all alternative clauses of the current goal
   deriving (Show)
 
diff --git a/app/Interpreter.hs b/app/Interpreter.hs
index da00301..ebec859 100644
--- a/app/Interpreter.hs
+++ b/app/Interpreter.hs
@@ -215,6 +215,10 @@ proveStep c f i = go i
                                 }
                 , cho = chos
                 }
+      {- invoke a built-in (this gets replaced by NoGoal by default but the
+       - builtin can actually do whatever it wants with the code -}
+      | [Builtin (BuiltinFunc bf)] <- hed =
+        c (bf i {cur = cur {hed = [NoGoal]}})
       {- top-level success -}
       | [NoGoal] <- hed
       , Just nchos <- tailcut gol chos cut