From 6f164087ba2a3f6794f1c4a18a260350db4a0a55 Mon Sep 17 00:00:00 2001 From: Gabriel Dos Reis 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/interp') 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