/pliant/language/debug/check.pli
 
 1  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 2  # 
 3  # This program is free software; you can redistribute it and/or 
 4  # modify it under the terms of the GNU General Public License version 2 
 5  # as published by the Free Software Foundation. 
 6  # 
 7  # This program is distributed in the hope that it will be useful, 
 8  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 9  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 10  # GNU General Public License for more details. 
 11  # 
 12  # You should have received a copy of the GNU General Public License 
 13  # version 2 along with this program; if not, write to the Free Software 
 14  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 15   
 16  scope "/pliant/language/" "/pliant/install/" 
 17  module "/pliant/install/ring2.pli" 
 18   
 19   
 20  function 'pliant check' cond id msg 
 21    arg CBool cond ; arg ErrorID id ; arg Str msg 
 22    has_no_side_effect 
 23    if not cond 
 24      error id msg 
 25     
 26  meta check e 
 27    if e:size<or e:size>or not (e:cast CBool) 
 28      return 
 29    if e:size>=and not (e:cast ErrorID) 
 30      return 
 31    if e:size>=and not (e:(e:size-1) cast Str) 
 32      return 
 33    if pliant_debugging_level_variable>=2 
 34      suckup e:0 
 35      var Link:Argument id 
 36      if e:size>=3 
 37        suckup e:1 
 38        id :> e:result 
 39      else 
 40        id :> argument constant ErrorID error_id_check 
 41      var Link:Argument msg 
 42      if e:size>=2 
 43        suckup e:(e:size-1) 
 44        msg :> e:(e:size-1) result 
 45      else 
 46        msg :> argument constant Str "seems to be a bug at "+e:position 
 47      add (instruction (the_function 'pliant check' CBool ErrorID Str) e:0:result id msg) 
 48    set_void_result 
 49   
 50   
 51  alias check check in "/pliant/language/basic/safe.pli"