From 6f164087ba2a3f6794f1c4a18a260350db4a0a55 Mon Sep 17 00:00:00 2001
From: Gabriel Dos Reis <gdr@axiomatics.org>
Date: Sat, 26 Dec 2015 02:10:51 -0800
Subject: Introduce opcode '%constant' in lieu of IDENTITY.

---
 src/interp/br-op1.boot       | 2 +-
 src/interp/c-doc.boot        | 2 +-
 src/interp/functor.boot      | 2 +-
 src/interp/g-opt.boot        | 2 +-
 src/interp/lisp-backend.boot | 3 ++-
 src/interp/nruncomp.boot     | 2 +-
 src/interp/showimp.boot      | 2 +-
 7 files changed, 8 insertions(+), 7 deletions(-)

(limited to 'src')

diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot
index 94f1f937..a383f0e3 100644
--- a/src/interp/br-op1.boot
+++ b/src/interp/br-op1.boot
@@ -954,7 +954,7 @@ getDomainOpTable(dom,fromIfTrue,:options) ==
           [f,:r] := cell
           f is 'nowhere => 'nowhere           --see replaceGoGetSlot
           f is 'makeSpadConstant => 'constant
-          f = function IDENTITY => 'constant
+          f is '%constant => 'constant
           f is 'newGoGet => substitute('_$,domname,devaluate first r)
           not vector? r => systemError devaluateList r
           substitute('_$,domname,devaluate r)
diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot
index ba640875..b6cc0e66 100644
--- a/src/interp/c-doc.boot
+++ b/src/interp/c-doc.boot
@@ -1043,7 +1043,7 @@ checkSayBracket x ==
 checkBeginEnd u ==
   beginEndStack := nil
   while u repeat
-    IDENTITY
+    do
       x := first u
       string? x and x.0 = $charBack and #x > 2 and not tableValue($htMacroTable,x)
         and not (x is '"\spadignore") and IFCAR IFCDR u = $charLbrace
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index 5aac19c4..78864f8a 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -527,7 +527,7 @@ SetFunctionSlots(sig,body,flag,mode) == --mode is either "original" or "adding"
   for catImplem in findOperatorImplementations sig repeat
     catImplem is [q,.,index] and q in '(ELT CONST) =>
       if q = 'CONST and body is ['CONS,a,b] then
-         body := ['CONS,'IDENTITY,['FUNCALL,a,b]]
+         body := ['CONS,'%constant,['FUNCALL,a,b]]
       body:= ['%store,['%tref,'$,index],body]
       not vector? $SetFunctions => nil --packages don't set it
       TruthP vectorRef($SetFunctions,index) =>   -- the function was already assigned
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 0cf42d43..4dd126e3 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2013, Gabriel Dos Reis.
+-- Copyright (C) 2007-2015, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot
index d036d240..3232f9fe 100644
--- a/src/interp/lisp-backend.boot
+++ b/src/interp/lisp-backend.boot
@@ -1,4 +1,4 @@
--- Copyright (C) 2011-2013, Gabriel Dos Reis.
+-- Copyright (C) 2011-2015, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -661,6 +661,7 @@ for x in [
     ['%exit,     :'EXIT],
     ['%when,     :'COND],
     ['%scope,    :'BLOCK],
+    ['%constant, :['FUNCTION,'IDENTITY]],
 
     -- I/O stream functions
     ['%writeString,  :'WRITE_-STRING],
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 32d1ca72..e35db5a9 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -338,7 +338,7 @@ descendCodeTran(db,u,condList) ==
       u.first := '%list
       u.rest := nil
       domainRef(dbTemplate db,i) :=
-        fn is 'IDENTITY => a
+        fn is '%constant => a
         fn is ['dispatchFunction,fn'] => fn'
         fn
     nil   --code for this will be generated by the instantiator
diff --git a/src/interp/showimp.boot b/src/interp/showimp.boot
index ce18ef0c..a02346fc 100644
--- a/src/interp/showimp.boot
+++ b/src/interp/showimp.boot
@@ -364,7 +364,7 @@ dcOpPrint(op,index) ==
     slotNumber = 1 => '"missing"
     name := $infovec.0.slotNumber
     name isnt [.,:.] => name
-    name is ["CONS","IDENTITY",
+    name is ["CONS",'%constant,
               ["FUNCALL", ["dispatchFunction", impl],"$"]] =>
       kind := 'CONST
       impl
-- 
cgit v1.2.3