1;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. 2;; All rights reserved. 3;; 4;; Redistribution and use in source and binary forms, with or without 5;; modification, are permitted provided that the following conditions are 6;; met: 7;; 8;; - Redistributions of source code must retain the above copyright 9;; notice, this list of conditions and the following disclaimer. 10;; 11;; - Redistributions in binary form must reproduce the above copyright 12;; notice, this list of conditions and the following disclaimer in 13;; the documentation and/or other materials provided with the 14;; distribution. 15;; 16;; - Neither the name of The Numerical ALgorithms Group Ltd. nor the 17;; names of its contributors may be used to endorse or promote products 18;; derived from this software without specific prior written permission. 19;; 20;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS 21;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED 22;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 23;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER 24;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 25;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 26;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 27;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 28;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 29;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 30;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 32;;; 33;;; FOAM Operations for Common Lisp 34;;; 35 36;; 37;; Client files should begin with 38;; (in-package "FOAM-USER" :use '("FOAM" "LISP")) 39;; 40;; 41;; To Do: 42;; Test cases. 43;; Scan and format functions need to be rewritten to handle complete syntax. 44;; Deftypes for each Foam type? 45;; 46 47(in-package "FOAM") 48 49(eval-when (:execute :compile-toplevel :load-toplevel) 50(export '( 51 compile-as-file cases 52 53 |Clos| |Char| |Bool| |Byte| |HInt| |SInt| |BInt| |SFlo| |DFlo| |Ptr| 54 |Word| |Arb| |Env| |Level| |Arr| |Record| |Nil| 55 56 |ClosInit| |CharInit| |BoolInit| |ByteInit| |HIntInit| |SIntInit| 57 |BIntInit| |SFloInit| |DFloInit| |PtrInit| |WordInit| |ArbInit| |EnvInit| 58 |ArrInit| |RecordInit| |LevelInit| 59 60 |BoolFalse| |BoolTrue| |BoolNot| |BoolAnd| |BoolOr| |BoolEQ| |BoolNE| 61 62 |CharSpace| |CharNewline| |CharMin| |CharMax| |CharIsDigit| 63 |CharIsLetter| |CharEQ| |CharNE| |CharLT| |CharLE| 64 |CharLower| |CharUpper| |CharOrd| |CharNum| |CharCode0| 65 66 |SFlo0| |SFlo1| |SFloMin| |SFloMax| |SFloEpsilon| |SFloIsZero| 67 |SFloIsNeg| |SFloIsPos| |SFloEQ| |SFloNE| |SFloLT| 68 |SFloLE| |SFloNegate| |SFloPrev| |SFloNext| |SFloPlus| 69 |SFloMinus| |SFloTimes| |SFloTimesPlus| |SFloDivide| 70 |SFloRPlus| |SFloRMinus| |SFloRTimes| |SFloRTimesPlus| 71 |SFloRDivide| |SFloDissemble| |SFloAssemble| 72 73 |DFlo0| |DFlo1| |DFloMin| |DFloMax| |DFloEpsilon| 74 |DFloIsZero| |DFloIsNeg| |DFloIsPos| |DFloEQ| |DFloNE| 75 |DFloLT| |DFloLE| |DFloNegate| |DFloPrev| |DFloNext| 76 |DFloPlus| |DFloMinus| |DFloTimes| |DFloTimesPlus| 77 |DFloDivide| |DFloRPlus| |DFloRMinus| |DFloRTimes| 78 |DFloRTimesPlus| |DFloRDivide| |DFloDissemble| 79 |DFloAssemble| |Byte0| |Byte1| |ByteMin| |ByteMax| 80 81 |HInt0| |HInt1| |HIntMin| |HIntMax| 82 83 |SInt0| |SInt1| |SIntMin| |SIntMax| |SIntIsZero| |SIntIsNeg| 84 |SIntIsPos| |SIntIsEven| |SIntIsOdd| |SIntEQ| |SIntNE| 85 |SIntLT| |SIntLE| |SIntNegate| |SIntPrev| |SIntNext| 86 |SIntPlus| |SIntMinus| |SIntTimes| |SIntTimesPlus| 87 |SIntMod| |SIntQuo| |SIntRem| |SIntDivide| |SIntGcd| 88 |SIntPlusMod| |SIntMinusMod| |SIntTimesMod| 89 |SIntTimesModInv| |SIntLength| |SIntShiftUp| 90 |SIntShiftDn| |SIntBit| |SIntNot| |SIntAnd| |SIntOr| 91 92 |WordTimesDouble| |WordDivideDouble| |WordPlusStep| |WordTimesStep| 93 94 |BInt0| |BInt1| |BIntIsZero| |BIntIsNeg| |BIntIsPos| |BIntIsEven| 95 |BIntIsOdd| |BIntIsSingle| |BIntEQ| |BIntNE| |BIntLT| 96 |BIntLE| |BIntNegate| |BIntPrev| |BIntNext| |BIntPlus| 97 |BIntMinus| |BIntTimes| |BIntTimesPlus| |BIntMod| 98 |BIntQuo| |BIntRem| |BIntDivide| |BIntGcd| 99 |BIntSIPower| |BIntBIPower| |BIntLength| |BIntShiftUp| 100 |BIntShiftDn| |BIntBit| 101 102 |PtrNil| |PtrIsNil| |PtrMagicEQ| |PtrEQ| |PtrNE| 103 104 |FormatSFlo| |FormatDFlo| |FormatSInt| |FormatBInt| 105 |fgetss| |fputss| 106 107 |ScanSFlo| |ScanDFlo| |ScanSInt| |ScanBInt| 108 109 |SFloToDFlo| |DFloToSFlo| |ByteToSInt| |SIntToByte| |HIntToSInt| 110 |SIntToHInt| |SIntToBInt| |BIntToSInt| |SIntToSFlo| 111 |SIntToDFlo| |BIntToSFlo| |BIntToDFlo| |PtrToSInt| 112 |SIntToPtr| |BoolToSInt| 113 114 |ArrToSFlo| |ArrToDFlo| |ArrToSInt| |ArrToBInt| 115 116 |PlatformRTE| |PlatformOS| |Halt| 117 118 |Clos| |CCall| |ClosEnv| |ClosFun| |SetClosEnv| |SetClosFun| 119 |DDecl| |RNew| |ANew| |RElt| |EElt| |AElt| |Lex| 120 |SetLex| |SetRElt| |SetAElt| |SetEElt| 121 |FoamFree| 122 123 declare-prog declare-type 124 defprog ignore-var block-return 125 defspecials file-exports file-imports 126 typed-let foamfn |FoamProg| |alloc-prog-info| 127 128 |MakeEnv| |EnvLevel| |EnvNext| |EnvInfo| |SetEnvInfo| |FoamEnvEnsure| 129 |MakeLit| |MakeLevel| 130 |printNewLine| |printChar| |printString| |printSInt| |printBInt| |printSFloat| 131 |printDFloat| 132 |strLength| |formatSInt| |formatBInt| |formatSFloat| |formatDFloat| 133 134 |ProgHashCode| |SetProgHashCode| |ProgFun| 135 |G-mainArgc| |G-mainArgv| 136 |stdinFile| |stdoutFile| |stderrFile| 137 |fputc| |fputs| |foamfun| 138 139 140 ;; trancendental functions 141 |sqrt| |pow| |log| |exp| |sin| |cos| |tan| |sinh| |cosh| |tanh| 142 |asin| |acos| |atan| |atan2| 143 144 ;; debuging 145 |fiSetDebugVar| |fiGetDebugVar| |fiSetDebugger| |fiGetDebugger| 146 ;; Blatent hacks.. 147 |G-stdoutVar| |G-stdinVar| |G-stderrVar| 148 |fiStrHash| 149 150 axiomxl-file-init-name 151 axiomxl-global-name 152)) 153) 154 155 156;; type defs for Foam types 157(deftype |Char| () 'character) 158(deftype |Clos| () 'list) 159(deftype |Bool| () '(member t nil)) 160(deftype |Byte| () 'unsigned-byte) 161(deftype |HInt| () '(integer #.(- (expt 2 15)) #.(1- (expt 2 15)))) 162(deftype |SInt| () '(integer #.(- (expt 2 31)) #.(1- (expt 2 31)))) 163 164#+:GCL 165(deftype |BInt| () t) 166#-:GCL 167(deftype |BInt| () 'integer) 168 169(deftype |SFlo| () 'short-float) 170 171#+:GCL 172(deftype |DFlo| () t) 173#-:GCL 174(deftype |DFlo| () 'double-float) 175 176(deftype |Level| () t) ;; structure?? 177 178(deftype |Nil| () t) 179(deftype |Ptr| () t) 180(deftype |Word| () t) 181(deftype |Arr| () t) 182(deftype |Record| () t) 183(deftype |Arb| () t) 184(deftype |Env| () t) ; (or cons nil) 185 186;; default values for types. Used as initializers in lets. 187(defconstant |CharInit| (the |Char| '#\Space)) 188(defconstant |ClosInit| (the |Clos| nil)) 189(defconstant |BoolInit| (the |Bool| nil)) 190(defconstant |ByteInit| (the |Byte| 0)) 191(defconstant |HIntInit| (the |HInt| 0)) 192(defconstant |SIntInit| (the |SInt| 0)) 193(defconstant |BIntInit| (the |BInt| 0)) 194(defconstant |SFloInit| (the |SFlo| 0.0s0)) 195(defconstant |DFloInit| (the |DFlo| 0.0d0)) 196(defconstant |PtrInit| (the |Ptr| nil)) 197(defconstant |ArrInit| (the |Arr| nil)) 198(defconstant |RecordInit| (the |Record| nil)) 199(defconstant |WordInit| (the |Word| nil)) 200(defconstant |ArbInit| (the |Arb| nil)) 201(defconstant |EnvInit| (the |Env| nil)) 202(defconstant |LevelInit| (the |Level| nil)) 203 204;; Bool values are assumed to be either 'T or NIL. 205;; Thus non-nil values are canonically represented. 206(defmacro |BoolFalse| () NIL) 207(defmacro |BoolTrue| () 'T) 208(defmacro |BoolNot| (x) `(NOT ,x)) 209(defmacro |BoolAnd| (x y) 210 `(let ((xx ,x) (yy ,y)) (AND xx yy))) ;; force evaluation of both args 211(defmacro |BoolOr| (x y) 212 `(let ((xx ,x) (yy ,y)) (OR xx yy))) ;; force evaluation of both args 213(defmacro |BoolEQ| (x y) `(EQ ,x ,y)) 214(defmacro |BoolNE| (x y) `(NOT (|BoolEQ| ,x ,y))) 215 216(defconstant |CharCode0| (code-char 0)) 217 218(defmacro |CharSpace| () '#\Space) 219(defmacro |CharNewline| () '#\Newline) 220(defmacro |CharMin| () |CharCode0|) 221(defmacro |CharMax| () #.(code-char (1- char-code-limit))) 222(defmacro |CharIsDigit| (x) `(if (DIGIT-CHAR-P (the |Char| ,x)) 't nil)) 223(defmacro |CharIsLetter|(x) `(ALPHA-CHAR-P (the |Char| ,x))) 224(defmacro |CharLT| (x y) `(CHAR< (the |Char| ,x) (the |Char| ,y))) 225(defmacro |CharLE| (x y) `(CHAR<= (the |Char| ,x) (the |Char| ,y))) 226(defmacro |CharEQ| (x y) `(CHAR= (the |Char| ,x) (the |Char| ,y))) 227(defmacro |CharNE| (x y) `(CHAR/= (the |Char| ,x) (the |Char| ,y))) 228(defmacro |CharLower| (x) `(the |Char| (CHAR-DOWNCASE (the |Char| ,x)))) 229(defmacro |CharUpper| (x) `(the |Char| (CHAR-UPCASE (the |Char| ,x)))) 230(defmacro |CharOrd| (x) `(CHAR-CODE (the |Char| ,x))) 231(defmacro |CharNum| (x) `(CODE-CHAR (the |SInt| ,x))) 232 233(defmacro |SFlo0| () 0.0s0) 234(defmacro |SFlo1| () 1.0s0) 235(defmacro |SFloMin| () most-negative-short-float) 236(defmacro |SFloMax| () most-positive-short-float) 237(defmacro |SFloEpsilon| () short-float-epsilon) 238(defmacro |SFloIsZero| (x) `(zerop (the |SFlo| ,x))) 239(defmacro |SFloIsNeg| (x) `(minusp (the |SFlo| ,x))) 240(defmacro |SFloIsPos| (x) `(plusp (the |SFlo| ,x))) 241(defmacro |SFloLT| (x y) `(< (the |SFlo| ,x) (the |SFlo| ,y))) 242(defmacro |SFloLE| (x y) `(<= (the |SFlo| ,x) (the |SFlo| ,y))) 243(defmacro |SFloEQ| (x y) `(= (the |SFlo| ,x) (the |SFlo| ,y))) 244(defmacro |SFloNE| (x y) `(/= (the |SFlo| ,x) (the |SFlo| ,y))) 245(defmacro |SFloNegate| (x) `(the |SFlo| (- (the |SFlo| ,x)))) 246(defmacro |SFloNext| (x) `(the |SFlo| (+ (the |SFlo| ,x) 1.0s0))) 247(defmacro |SFloPrev| (x) `(the |SFlo| (- (the |SFlo| ,x) 1.0s0))) 248(defmacro |SFloMinus| (x y) `(the |SFlo| (- (the |SFlo| ,x) (the |SFlo| ,y)))) 249(defmacro |SFloTimes| (x y) `(the |SFlo| (* (the |SFlo| ,x) (the |SFlo| ,y)))) 250(defmacro |SFloTimesPlus| (x y z) 251 `(the |SFlo| (+ (* (the |SFlo| ,x) (the |SFlo| ,y)) (the |SFlo| ,z)))) 252(defmacro |SFloDivide| (x y) `(the |SFlo| (/ (the |SFlo| ,x) (the |SFlo| ,y)))) 253(defmacro |SFloRPlus| (x y r) `(error "unimplemented operation -- SFloRPlus")) 254(defmacro |SFloRMinus| (x y r) `(error "unimplemented operation -- SFloRTimes")) 255(defmacro |SFloRTimes| (x y r) `(error "unimplemented operation -- SFloRTimes")) 256(defmacro |SFloRTimesPlus| (x y z r) `(error "unimplemented operation -- SFloTimesPlus")) 257(defmacro |SFloRDivide|(x y r) `(error "unimplemented operation -- SFloDivide")) 258(defmacro |SFloDissemble| (x) `(error "unimplemented operation -- SFloDissemble")) 259(defmacro |SFloAssemble| (w x y) `(error "unimplemented operation -- SFloAssemble")) 260 261;; These are no longer foam builtins 262;;(defmacro |SFloRound| (x) `(the |BInt| (round (the |SFlo| ,x)))) 263;;(defmacro |SFloTruncate| (x) `(the |BInt| (truncate (the |SFlo| ,x)))) 264;;(defmacro |SFloFloor| (x) `(the |BInt| (floor (the |SFlo| ,x)))) 265;;(defmacro |SFloCeiling| (x) `(the |BInt| (ceiling (the |SFlo| ,x)))) 266 267(defmacro |DFlo0| () 0.0d0) 268(defmacro |DFlo1| () 1.0d0) 269(defmacro |DFloMin| () most-negative-double-float) 270(defmacro |DFloMax| () most-positive-double-float) 271(defmacro |DFloEpsilon| () double-float-epsilon) 272(defmacro |DFloIsZero| (x) `(zerop (the |DFlo| ,x))) 273(defmacro |DFloIsNeg| (x) `(minusp (the |DFlo| ,x))) 274(defmacro |DFloIsPos| (x) `(plusp (the |DFlo| ,x))) 275(defmacro |DFloLE| (x y) `(<= (the |DFlo| ,x) (the |DFlo| ,y))) 276(defmacro |DFloEQ| (x y) `(= (the |DFlo| ,x) (the |DFlo| ,y))) 277(defmacro |DFloLT| (x y) `(< (the |DFlo| ,x) (the |DFlo| ,y))) 278(defmacro |DFloNE| (x y) `(/= (the |DFlo| ,x) (the |DFlo| ,y))) 279(defmacro |DFloNegate| (x) `(the |DFlo| (- (the |DFlo| ,x)))) 280(defmacro |DFloNext| (x) `(the |DFlo| (+ (the |DFlo| ,x) 1.0d0))) 281(defmacro |DFloPrev| (x) `(the |DFlo| (- (the |DFlo| ,x) 1.0d0))) 282(defmacro |DFloPlus| (x y) `(the |DFlo| (+ (the |DFlo| ,x) (the |DFlo| ,y)))) 283(defmacro |DFloMinus| (x y) `(the |DFlo| (- (the |DFlo| ,x) (the |DFlo| ,y)))) 284(defmacro |DFloTimes| (x y) `(the |DFlo| (* (the |DFlo| ,x) (the |DFlo| ,y)))) 285(defmacro |DFloDivide| (x y) `(the |DFlo| (/ (the |DFlo| ,x) (the |DFlo| ,y)))) 286(defmacro |DFloTimesPlus| (x y z) 287 `(the |DFlo| (+ (* (the |DFlo| ,x) (the |DFlo| ,y)) (the |DFlo| ,z)))) 288 289(defmacro |DFloRPlus| (x y r) `(error "unimplemented operation -- DFloRPlus")) 290(defmacro |DFloRMinus| (x y r) `(error "unimplemented operation -- DFloRTimes")) 291(defmacro |DFloRTimes| (x y r) `(error "unimplemented operation -- DFloRTimes")) 292(defmacro |DFloRTimesPlus| (x y z r) `(error "unimplemented operation -- DFloTimesPlus")) 293(defmacro |DFloRDivide|(x y r) `(error "unimplemented operation -- DFloDivide")) 294 295(defmacro |DFloDissemble| (x) `(error "unimplemented operation -- DFloDissemble")) 296(defmacro |DFloAssemble| (w x y z) `(error "unimplemented operation -- DFloAssemble")) 297 298;; Not builtins anymore 299;;(defmacro |DFloRound| (x) `(the |BInt| (round (the |DFlo| ,x)))) 300;;(defmacro |DFloTruncate| (x) `(the |BInt| (truncate (the |DFlo| ,x)))) 301;;(defmacro |DFloFloor| (x) `(the |BInt| (floor (the |DFlo| ,x)))) 302;;(defmacro |DFloCeiling| (x) `(the |BInt| (ceiling (the |DFlo| ,x)))) 303 304(defmacro |Byte0| () 0) 305(defmacro |Byte1| () 1) 306(defmacro |ByteMin| () 0) 307(defmacro |ByteMax| () 255) 308 309(defmacro |HInt0| () 0) 310(defmacro |HInt1| () 1) 311(defmacro |HIntMin| () #.(- (expt 2 15))) 312(defmacro |HIntMax| () #.(1- (expt 2 15))) 313 314(defmacro |SInt0| () 0) 315(defmacro |SInt1| () 1) 316(defmacro |SIntMin| () `(the |SInt| #.(- (expt 2 31)))) 317(defmacro |SIntMax| () `(the |SInt| #.(1- (expt 2 31)))) 318(defmacro |SIntIsZero| (x) `(zerop (the |SInt| ,x))) 319(defmacro |SIntIsNeg| (x) `(minusp (the |SInt| ,x))) 320(defmacro |SIntIsPos| (x) `(plusp (the |SInt| ,x))) 321(defmacro |SIntIsEven| (x) `(evenp (the |SInt| ,x))) 322(defmacro |SIntIsOdd| (x) `(oddp (the |SInt| ,x))) 323(defmacro |SIntLE| (x y) `(<= (the |SInt| ,x) (the |SInt| ,y))) 324(defmacro |SIntEQ| (x y) `(= (the |SInt| ,x) (the |SInt| ,y))) 325(defmacro |SIntLT| (x y) `(< (the |SInt| ,x) (the |SInt| ,y))) 326(defmacro |SIntNE| (x y) `(/= (the |SInt| ,x) (the |SInt| ,y))) 327(defmacro |SIntNegate| (x) `(the |SInt| (- (the |SInt| ,x)))) 328(defmacro |SIntPrev| (x) `(the |SInt| (1- (the |SInt| ,x)))) 329(defmacro |SIntNext| (x) `(the |SInt| (1+ (the |SInt| ,x)))) 330(defmacro |SIntPlus| (x y) `(the |SInt| (+ (the |SInt| ,x) (the |SInt| ,y)))) 331(defmacro |SIntMinus| (x y) `(the |SInt| (- (the |SInt| ,x) (the |SInt| ,y)))) 332(defmacro |SIntTimes| (x y) `(the |SInt| (* (the |SInt| ,x) (the |SInt| ,y)))) 333(defmacro |SIntTimesPlus| (x y z) 334 `(the |SInt| (+ (* (the |SInt| ,x) (the |SInt| ,y)) (the |SInt| ,z)))) 335(defmacro |SIntMod| (x y) `(the |SInt| (mod(the |SInt| ,x)(the |SInt| ,y)))) 336(defmacro |SIntQuo| (x y) 337 `(the |SInt| (values (truncate (the |SInt| ,x) (the |SInt| ,y))))) 338(defmacro |SIntRem| (x y) `(the |SInt| (rem(the |SInt| ,x)(the |SInt| ,y)))) 339;;! declare all let variables 340(defmacro |SIntDivide| (x y) `(truncate (the |SInt| ,x) (the |SInt| ,y))) 341(defmacro |SIntGcd| (x y) `(the |SInt| (gcd (the |SInt| ,x) (the |SInt| ,y)))) 342 343(defmacro |SIntPlusMod| (a b c) 344 `(the |SInt| (mod (+ (the |SInt| ,a) (the |SInt| ,b)) (the |SInt| ,c)))) 345(defmacro |SIntMinusMod| (a b c) 346 `(the |SInt| (mod (- (the |SInt| ,a) (the |SInt| ,b)) (the |SInt| ,c)))) 347(defmacro |SIntTimesMod| (a b c) 348 `(the |SInt| (mod (* (the |SInt| ,a) (the |SInt| ,b)) (the |SInt| ,c)))) 349;; |SIntTimesModInv| 350(defmacro |SIntLength| (x) `(the |SInt| (integer-length (the |SInt| ,x)))) 351(defmacro |SIntShiftUp| (x y) `(the |SInt| (ash (the |SInt| ,x) (the |SInt| ,y)))) 352(defmacro |SIntShiftDn| (x y) `(the |SInt| (ash (the |SInt| ,x) (the |SInt| (- (the |SInt| ,y)))))) 353 354(defmacro |SIntBit| (x i) 355 `(let ((xx ,x) (ii ,i)) (declare (type |SInt| xx ii)) (logbitp ii xx))) 356(defmacro |SIntNot| (a) `(the |SInt| (lognot (the |SInt| ,a)))) 357(defmacro |SIntAnd| (a b) 358 `(the |SInt| (logand (the |SInt| ,a) (the |SInt| ,b)))) 359(defmacro |SIntOr| (a b) 360 `(the |SInt| (logior (the |SInt| ,a) (the |SInt| ,b)))) 361 362;; WordTimesDouble 363;; WordDivideDouble 364;; WordPlusStep 365;; WordTimesStep 366 367(defmacro |SIntSIPower| (x y) 368 `(let ((xx ,x) (yy ,y)) 369 (declare (type |SInt| xx yy)) 370 (if (minusp yy) (error "cannot raise integers to negative powers") 371 (the |SInt| (expt xx yy))))) 372(defmacro |SIntBIPower| (x y) 373 `(let ((xx ,x) (yy ,y)) 374 (declare (type |SInt| xx)) 375 (declare (type |BInt| yy)) 376 (if (minusp yy) (error "cannot raise integers to negative powers") 377 (the |SInt| (expt xx yy))))) 378 379(defmacro |BInt0| () 0) 380(defmacro |BInt1| () 1) 381(defmacro |BIntIsZero| (x) `(zerop (the |BInt| ,x))) 382(defmacro |BIntIsNeg| (x) `(minusp(the |BInt| ,x))) 383(defmacro |BIntIsPos| (x) `(plusp (the |BInt| ,x))) 384(defmacro |BIntIsEven| (x) `(evenp (the |BInt| ,x))) 385(defmacro |BIntIsOdd| (x) `(oddp (the |BInt| ,x))) 386(defmacro |BIntIsSingle| (x) `(typep ,x '|SInt|)) 387(defmacro |BIntLE| (x y) `(<= (the |BInt| ,x) (the |BInt| ,y))) 388(defmacro |BIntEQ| (x y) `(= (the |BInt| ,x) (the |BInt| ,y))) 389(defmacro |BIntLT| (x y) `(< (the |BInt| ,x) (the |BInt| ,y))) 390(defmacro |BIntNE| (x y) `(/= (the |BInt| ,x) (the |BInt| ,y))) 391(defmacro |BIntNegate| (x) `(the |BInt| (- (the |BInt| ,x)))) 392(defmacro |BIntPrev| (x) `(the |BInt| (1- (the |BInt| ,x)))) 393(defmacro |BIntNext| (x) `(the |BInt| (1+ (the |BInt| ,x)))) 394(defmacro |BIntPlus| (x y) `(the |BInt| (+ (the |BInt| ,x) (the |BInt| ,y)))) 395(defmacro |BIntMinus| (x y) `(the |BInt| (- (the |BInt| ,x) (the |BInt| ,y)))) 396(defmacro |BIntTimes| (x y) `(the |BInt| (* (the |BInt| ,x) (the |BInt| ,y)))) 397(defmacro |BIntTimesPlus| (x y z) 398 `(the |BInt| (+ (* (the |BInt| ,x) (the |BInt| ,y)) (the |BInt| ,z)))) 399(defmacro |BIntMod| (x y) `(the |BInt| (mod(the |BInt| ,x)(the |BInt| ,y)))) 400(defmacro |BIntQuo| (x y) 401 `(the |BInt| (values (truncate (the |BInt| ,x) (the |BInt| ,y))))) 402(defmacro |BIntRem| (x y) 403 `(the |BInt| (rem (the |BInt| ,x) (the |BInt| ,y)))) 404(defmacro |BIntDivide| (x y) `(truncate (the |BInt| ,x) (the |BInt| ,y))) 405(defmacro |BIntGcd| (x y) 406 `(the |BInt| (gcd (the |BInt| ,x) (the |BInt| ,y)))) 407(defmacro |BIntSIPower| (x y) 408 `(let ((xx ,x) (yy ,y)) 409 (declare (type |BInt| xx)) 410 (declare (type |SInt| yy)) 411 (if (minusp yy) (error "cannot raise integers to negative powers") 412 (the |BInt| (expt xx yy))))) 413(defmacro |BIntBIPower| (x y) 414 `(let ((xx ,x) (yy ,y)) 415 (declare (type |BInt| xx)) 416 (declare (type |BInt| yy)) 417 (if (minusp yy) (error "cannot raise integers to negative powers") 418 (the |BInt| (expt xx yy))))) 419(defmacro |BIntLength| (x) `(the |SInt| (integer-length (the |BInt| ,x)))) 420(defmacro |BIntShiftUp| (x y) `(the |BInt| (ash (the |BInt| ,x)(the |SInt| ,y)))) 421(defmacro |BIntShiftDn| (x y) `(the |BInt| (ash (the |BInt| ,x) (the |SInt| (- (the |SInt| ,y)))))) 422 423(defmacro |BIntBit| (x i) 424 `(let ((xx ,x) (ii ,i)) (declare (type |BInt| xx) (type |SInt| ii)) 425 (logbitp ii xx))) 426;;(defmacro |BIntAbs| (x) `(the |BInt| (abs (the |BInt| ,x)))) 427 428(defmacro |PtrNil| () ()) 429(defmacro |PtrIsNil| (x) `(NULL ,x)) 430(defmacro |PtrEQ| (x y) `(eq ,x ,y)) 431(defmacro |PtrNE| (x y) `(not (eq ,x ,y))) 432 433;; |WordTimesDouble| |WordDivideDouble| |WordPlusStep| |WordTimesStep| 434 435 436;;(defvar |FoamOutputString| 437;; (make-array 80 :element-type 'string-char :adjustable t :fill-pointer 0)) 438(defun |FormatNumber| (c arr i) 439 (setq str (format nil "~a" c)) 440 (replace arr str :start1 i) 441;; (incf i (fill-pointer |FoamOutputString|)) 442;; (if (> i (length arr)) (error "not enough space")) 443;; (setf (fill-pointer |FoamOutputString|) 0) 444 (+ i (length str))) 445 446(defmacro |FormatSFlo| (c arr i) `(|FormatNumber| ,c ,arr ,i)) 447(defmacro |FormatDFlo| (c arr i) `(|FormatNumber| ,c ,arr ,i)) 448(defmacro |FormatSInt| (c arr i) `(|FormatNumber| ,c ,arr ,i)) 449(defmacro |FormatBInt| (c arr i) `(|FormatNumber| ,c ,arr ,i)) 450 451(set-syntax-from-char (code-char 0) #\space) ;;makes null char act like white space 452 453(defmacro |ScanSFlo| (arr i) 454 `(read-from-string ,arr nil (|SFlo0|) 455 :start ,i :preserve-whitespace t)) 456(defmacro |ScanDFlo| (arr i) 457 `(read-from-string ,arr nil (|DFlo0|) 458 :start ,i :preserve-whitespace t)) 459(defmacro |ScanSInt| (arr i) 460 `(parse-integer ,arr :start ,i :junk-allowed t)) 461(defmacro |ScanBInt| (arr i) 462 `(parse-integer ,arr :start ,i :junk-allowed t)) 463 464;; 18/8/93: Evil bug in genfoam---nil generated. 465(defmacro hacked-the (type x) 466 (if x `(the ,type ,x) `(the ,type 0))) 467 468(defmacro |ByteToSInt| (x) `(coerce (hacked-the |Byte| ,x) '|SInt|)) 469(defmacro |BoolToSInt| (x) `(if ,x 1 0)) 470(defmacro |BIntToSInt| (x) `(hacked-the |SInt| ,x)) 471(defmacro |SIntToBInt| (x) `(hacked-the |BInt| ,x)) 472(defmacro |SIntToSFlo| (x) `(coerce (hacked-the |SInt| ,x) '|SFlo|)) 473(defmacro |SIntToByte| (x) `(coerce (hacked-the |SInt| ,x) '|Byte|)) 474(defmacro |SIntToHInt| (x) `(coerce (hacked-the |SInt| ,x) '|HInt|)) 475(defmacro |SIntToDFlo| (x) `(coerce (hacked-the |SInt| ,x) '|DFlo|)) 476(defmacro |BIntToSFlo| (x) `(coerce (hacked-the |BInt| ,x) '|SFlo|)) 477(defmacro |BIntToDFlo| (x) `(coerce (hacked-the |BInt| ,x) '|DFlo|)) 478(defmacro |ArrToSFlo| (x) `(read-from-string ,x nil (|SFlo0|))) 479(defmacro |ArrToDFlo| (x) `(read-from-string ,x nil (|DFlo0|))) 480(defmacro |ArrToSInt| (x) `(read-from-string ,x nil (|SInt0|))) 481(defmacro |ArrToBInt| (x) `(read-from-string ,x nil (|BInt0|))) 482 483(defmacro |Clos| (x y) `(let ((xx ,x) (yy #',y)) (cons yy xx))) 484(defmacro |ClosFun| (x) `(car ,x)) 485(defmacro |ClosEnv| (x) `(cdr ,x)) 486(defmacro |SetClosFun| (x y) `(rplaca ,x ,y)) 487(defmacro |SetClosEnv| (x y) `(rplacd ,x ,y)) 488 489(defmacro |MakeEnv| (x y) 490 `(let ((xx ,x) (yy ,y)) (cons yy (cons xx nil)))) 491 492(defmacro |EnvLevel| (x) `(car ,x)) 493(defmacro |EnvNext| (x) `(cadr ,x)) 494(defmacro |EnvInfo| (x) `(if (and (consp ,x) (consp (cdr ,x))) 495 (cddr ,x) nil)) 496(defmacro |SetEnvInfo| (x val) `(rplacd (cdr ,x) ,val)) 497 498(defmacro |FoamEnvEnsure| (e) 499 `(if (|EnvInfo| ,e) (|CCall| (|EnvInfo| ,e)) nil)) 500 501(defparameter null-char-string (string (code-char 0))) 502(defmacro |MakeLit| (s) `(concatenate 'string ,s null-char-string)) 503 504;; functions are represented by symbols, with the symbol-value being some 505;; information, and the symbol-function is the function itself. 506;; 1-valued lisp should represent progs as either a pair or defstruct. 507 508(defmacro |FunProg| (x) x) 509 510(defstruct FoamProgInfoStruct 511 (funcall #'(lambda () (error "FoamProgInfoStruct: funcall not assigned")) :type function) 512 (hashval 0 :type |SInt|)) 513 514(defun |ProgHashCode| (x) 515 (let ((aa (foam-function-info x))) 516 (if (null aa) 0 517 (FoamProgInfoStruct-hashval aa)))) 518 519(defun |SetProgHashCode| (x y) 520 (let ((aa (foam-function-info x))) 521 (if (null aa) 0 522 (setf (FoamProgInfoStruct-hashval aa) y)))) 523 524;; In a hurry -> O(n) lookup.. 525(defvar foam-function-list ()) 526 527(defun alloc-prog-info (fun val) 528 (setq foam-function-list (cons (cons fun val) foam-function-list))) 529 530(defun foam-function-info (fun) 531 (let ((xx (assoc fun foam-function-list))) 532 (if (null xx) nil 533 (cdr xx)))) 534 535;; Accessors and constructors 536(defmacro |DDecl| (name &rest args) 537 (setf (get name 'struct-args) args) 538 `(defstruct ,name ,@(insert-types args))) 539 540(defun insert-types (slots) 541 (mapcar #'(lambda (slot) 542 `(,(car slot) ,(type2init (cadr slot)) 543 :type ,(cadr slot))) 544 slots)) 545 546(defmacro |RNew| (name) 547 (let* ((struct-args (get name 'struct-args)) 548 (init-args (mapcar #'(lambda (x) (type2init (cadr x))) 549 struct-args)) 550 (count (length struct-args))) 551 (cond ((> count 2) `(vector ,@init-args)) 552 ((= count 2) `(cons ,@init-args)) 553 (t `(list ,@init-args))))) 554 555(defmacro |RElt| (name field index rec) 556 (let ((count (length (get name 'struct-args)))) 557 (cond ((> count 2) `(svref ,rec ,index)) 558 ((= count 2) 559 (if (zerop index) `(car ,rec) `(cdr ,rec))) 560 (t `(car ,rec))))) 561 562(defmacro |SetRElt| (name field index rec val) 563 (let ((count (length (get name 'struct-args)))) 564 (cond ((> count 2) `(setf (svref ,rec ,index) ,val)) 565 ((= count 2) 566 (if (zerop index) `(rplaca ,rec ,val) `(rplacd ,rec ,val))) 567 (t `(rplaca ,rec ,val))))) 568 569(defmacro |AElt| (name index) 570 `(aref ,name ,index)) 571 572(defmacro |SetAElt| (name index val) 573 `(setf (aref ,name ,index) ,val)) 574 575(defmacro |MakeLevel| (builder struct) 576 (if (get struct 'struct-args) 577 `(,builder) 578 'nil)) 579 580 581(defmacro |EElt| (accessor n var) 582 `(,accessor ,var)) 583 584(defmacro |SetEElt| (accessor n var val) 585 `(setf (,accessor ,var) ,val)) 586 587(defmacro |Lex| (accessor n var) 588 `(,accessor ,var)) 589 590(defmacro |SetLex| (accessor n var val) 591 `(progn ;; (print ',accessor) 592 (setf (,accessor ,var) ,val))) 593 594;; Atomic arguments for fun don't need a let to hold the fun. 595;; CCall's with arguments need a let to hold the prog and the env. 596(defmacro |CCall| (fun &rest args) 597 (cond ((and (atom fun) (null args)) 598 `(funcall (|FunProg| (|ClosFun| ,fun)) (|ClosEnv| ,fun))) 599 ((null args) 600 `(let ((c ,fun)) 601 (funcall (|FunProg| (|ClosFun| c)) (|ClosEnv| c)))) 602 ((atom fun) 603 `(let ((fun (|FunProg| (|ClosFun| ,fun))) 604 (env (|ClosEnv| ,fun))) 605 (funcall fun ,@args env))) 606 (t 607 `(let ((c ,fun)) 608 (let ((fun (|FunProg| (|ClosFun| c))) 609 (env (|ClosEnv| c))) 610 (funcall fun ,@args env)))))) 611 612(defmacro |FoamFree| (o) '()) 613 614;; macros for defining things 615 616;; name-result is a list, the car is the name of the function to be declared, 617;; the cdr is the list of return values 618;; params is a list of pairs, the car of each is the name of the argument, the 619;; cdr is its type. 620 621;; in the ANSI Common Lisp ftype function declaration, the names of the 622;; arguments do not appear, actually. In GCL, they did. 623 624;; Example: 625;; (declare-prog 626;; (|C25-csspecies-generBaseFn| |Clos| |Clos| |Clos| |Clos|) 627;; ((|e1| |Env|))) 628(defmacro declare-prog (name-result params) 629 `(proclaim '(ftype (function 630 ,(mapcar #'cadr params) 631 (values ,@(cdr name-result))) 632 ,(car name-result)))) 633 634(defmacro declare-type (name type) 635 `(proclaim '(type ,name ,type))) 636 637(defmacro defprog (type temps &rest body) 638 `(progn (defun ,(caar type) ,(mapcar #'car (cadr type)) 639 (typed-let ,temps ,@body)) 640 (alloc-prog-info #',(caar type) (make-FoamProgInfoStruct)))) 641 642(defmacro defspecials (&rest lst) 643 `(proclaim '(special ,@lst))) 644 645(defmacro top-level-define (&rest junk) 646 `(setq ,@junk)) 647 648;; Runtime macros 649 650;; control transfer 651(defmacro block-return (obj val) 652 `(return-from ,obj ,val)) 653 654(defmacro typed-let (letvars &rest forms) 655 `(let ,(mapcar #'(lambda (var) 656 (list (car var) (type2init (cadr var)))) 657 letvars ) 658 (declare ,@(mapcar #'(lambda (var) 659 (list 'type (cadr var) (car var))) 660 letvars)) 661 ,@forms)) 662 663(defmacro cases (&rest junk) 664 `(case ,@junk)) 665 666 667;;; Boot macros 668(defmacro file-exports (lst) 669 `(eval-when (load eval) 670 (when (fboundp 'process-export-entry) 671 (mapcar #'process-export-entry ,lst)) 672 nil)) 673 674(defmacro file-imports (lst) 675 `(eval-when (load eval) 676 (when (fboundp 'process-import-entry) 677 (mapcar #'process-import-entry ,lst)) 678 nil)) 679 680(defmacro ignore-var (var) 681 `(declare (ignore ,var))) 682 683(defmacro |ANew| (type size) 684 (if (eq type '|Char|) 685 `(make-string ,size) 686 `(make-array ,size 687 :element-type ',type 688 :initial-element ,(type2init type)))) 689 690(defun type2init (x) 691 (cond 692 ((eq x '|Char|) '|CharInit|) 693 ((eq x '|Clos|) '|ClosInit|) 694 ((eq x '|Bool|) '|BoolInit|) 695 ((eq x '|Byte|) '|ByteInit|) 696 ((eq x '|HInt|) '|HIntInit|) 697 ((eq x '|SInt|) '|SIntInit|) 698 ((eq x '|BInt|) '|BIntInit|) 699 ((eq x '|SFlo|) '|SFloInit|) 700 ((eq x '|DFlo|) '|DFloInit|) 701 ((eq x '|Ptr|) '|PtrInit|) 702 ((eq x '|Word|) '|WordInit|) 703 ((eq x '|Arr|) '|ArrInit|) 704 ((eq x '|Record|) '|RecordInit|) 705 ((eq x '|Arb|) '|ArbInit|) 706 ((eq x '|Env|) '|EnvInit|) 707 ((eq x '|Level|) '|LevelInit|) 708 ((eq x '|Nil|) nil) 709 (t nil))) 710 711;; opsys interface 712(defvar |G-mainArgc| 0) 713(defvar |G-mainArgv| (vector)) 714(defmacro |stdinFile| () '*standard-input*) 715(defmacro |stdoutFile| () '*standard-output*) 716(defmacro |stderrFile| () '*error-output*) 717 718;; Format functions 719;needs to stop when it gets a null character 720(defun |strLength| (s) 721 (dotimes (i (length s)) 722 (let ((c (schar s i))) 723 (if (char= c |CharCode0|) 724 (return i)))) 725 (length s)) 726 727(defun |formatSInt| (n) (format nil "~D" n)) 728(defun |formatBInt| (n) (format nil "~D" n)) 729(defun |formatSFloat| (x) (format nil "~G" x)) 730(defun |formatDFloat| (x) (format nil "~G" x)) 731 732 733;; Printing functions 734(defun |printNewLine| (cs) (terpri cs)) 735(defun |printChar| (cs c) (princ c cs)) 736 737;needs to stop when it gets a null character 738(defun |printString| (cs s) 739 (dotimes (i (length s)) 740 (let ((c (schar s i))) 741 (if (char= c |CharCode0|) 742 (return i) 743 (princ c cs))))) 744 745(defun |printSInt| (cs n) (format cs "~D" n)) 746(defun |printBInt| (cs n) (format cs "~D" n)) 747(defun |printSFloat| (cs x) (format cs "~G" x)) 748(defun |printDFloat| (cs x) (format cs "~G" x)) 749 750(defun |fputc| (si cs) 751 (|printChar| cs (code-char si)) 752 si) 753 754(defun |fputs| (s cs) 755 (|printString| cs s)) 756 757;; read a string into s starting at pos i1, ending at i2 758;; we should probably macro-out cases where args are constant 759 760;; fill s[i1..i2] with a null terminated string read from 761;; the given input stream 762(defun |fgetss| (s i1 i2 f) 763 (labels ((aux (n) 764 (if (= n i2) 765 (progn (setf (schar s n) (code-char 0)) 766 (- n i1)) 767 (let ((c (read-char f))) 768 (setf (schar s n) c) 769 (if (equal c #\newline) 770 (progn (setf (char s (+ n 1)) (code-char 0)) 771 (- n i1)) 772 (aux (+ n 1))))))) 773 (aux i1))) 774 775;; write s[i1..i2) to the output stream f 776;; stop on any null characters 777 778(defun |fputss| (s i1 i2 f) 779 (labels ((aux (n) 780 (if (= n i2) (- n i1) 781 (let ((c (schar s n))) 782 (if (equal (code-char 0) c) 783 (- n i1) 784 (progn (princ c f) 785 (aux (+ n 1)))))))) 786 (setq i2 (if (minusp i2) (|strLength| s) 787 (min i2 (|strLength| s)))) 788 (aux i1))) 789 790;; function for compiling and loading from lisp 791 792(defun compile-as-file (file &optional (opts nil)) 793 (let* ((path (pathname file)) 794 (name (pathname-name path)) 795 (dir (pathname-directory path)) 796 (type (pathname-type path)) 797 (lpath (make-pathname :name name :type "l")) 798 (cpath (make-pathname :name name :type "o"))) 799 (if (null type) 800 (setq path (make-pathname :directory dir :name name :type "as"))) 801 (if opts 802 (OBEY (format nil "aldor ~A -Flsp ~A" opts (namestring path))) 803 (OBEY (format nil "aldor -Flsp ~A" (namestring path)))) 804 (compile-file (namestring lpath)) 805 (load (namestring cpath)))) 806 807 808;; given the name of a file (a string), return the name of the AXIOM-XL function 809;; that initialises the file. 810(defun axiomxl-file-init-name (filename) 811 (intern (format nil "G-~a" filename) 'foam-user)) 812 813;; given the name of the file, id name, and hashcode, return the 814;; AXIOM-XL identifier for that object 815 816(defun axiomxl-global-name (file id hashcode) 817 (intern (format nil "G-~a_~a_~9,'0d" file id hashcode) 'foam-user)) 818 819;; double float elementary functions 820(defmacro |sqrt| (x) `(sqrt ,x)) 821(defmacro |pow| (a b) `(expt ,a ,b)) 822(defmacro |log| (a) `(log ,a)) 823(defmacro |exp| (a) `(exp ,a)) 824 825(defmacro |sin| (a) `(sin ,a)) 826(defmacro |cos| (a) `(cos ,a)) 827(defmacro |tan| (a) `(tan ,a)) 828 829(defmacro |sinh| (a) `(sinh ,a)) 830(defmacro |cosh| (a) `(cosh ,a)) 831(defmacro |tanh| (a) `(tanh ,a)) 832 833(defmacro |asin| (a) `(asin ,a)) 834(defmacro |acos| (a) `(acos ,a)) 835(defmacro |atan| (a) `(atan ,a)) 836(defmacro |atan2| (a b) `(atan ,a ,b)) 837 838(defun |Halt| (n) 839 (error (cond ((= n 101) "System Error: Unfortunate use of dependant type") 840 ((= n 102) "User error: Reached a 'never'") 841 ((= n 103) "User error: Bad union branch") 842 ((= n 104) "User error: Assertion failed") 843 (t (format nil "Unknown halt condition ~a" n))))) 844;; debuging 845(defvar *foam-debug-var* nil) 846(defun |fiGetDebugVar| () *foam-debug-var*) 847 848(defun |fiSetDebugVar| (x) (setq *foam-debug-var* x)) 849(defun |fiSetDebugger| (x y) ()) 850(defun |fiGetDebugger| (x) ()) 851 852;; Output ports 853(setq |G-stdoutVar| t) 854(setq |G-stdinVar| t) 855(setq |G-stderrVar| t) 856 857;; !! Not portable !! 858(defun foam::|fiStrHash| (x) (boot::|hashString| (subseq x 0 (- (length x) 1)))) 859 860;; These three functions check that two cons's contain identical entries. 861;; We use EQL to test numbers and EQ everywhere else. If the structure 862;; of the two items is different, or any elements are different, we 863;; return false. 864(defmacro |politicallySound| (u v) 865 `(or (eql ,u ,v) (eq ,u ,v))) 866 867(defun |PtrMagicEQ| (u v) 868;; I find (as-eg4) that these buggers can be numbers 869 (cond ( (or (NULL u) (NULL v)) nil) 870 ( (and (ATOM u) (ATOM v)) (eql u v)) 871 ( (or (ATOM u) (ATOM v)) nil) 872;; removed for Aldor integration 873;; ( (equal (length u) (length v)) (|magicEq1| u v)) 874 (t (eq u v) ))) 875 876(defun |magicEq1| (u v) 877 (cond ( (and (atom u) (atom v)) (|politicallySound| u v)) 878 ( (or (atom u) (atom v)) nil) 879 ( (|politicallySound| (car u) (car v)) (|magicEq1| (cdr u) (cdr v))) 880 (t nil) )) 881 882 883(in-package "FOAM-USER") 884 885 886;; Literals should be null-terminated strings 887 888;; SingleInteger 889 890(defmacro |AXL-LiteralToSingleInteger| (l) 891 `(parse-integer ,l :junk-allowed t)) 892 893(defmacro |AXL-LiteralToInteger| (l) 894 `(parse-integer ,l :junk-allowed t)) 895 896(defmacro |AXL-LiteralToDoubleFloat| (l) 897 `(read-from-string ,l nil (|DFlo0|) 898 :preserve-whitespace t)) 899 900(defmacro |AXL-LiteralToString| (l) 901 `(subseq ,l 0 (- (length ,l) 1))) 902 903(defmacro |AXL-SingleIntegerToInteger| (si) 904 `(coerce (the |SInt| ,si) |BInt|)) 905 906(defmacro |AXL-StringToFloat| (s) 907 `(boot::|string2Float| ,s)) 908 909(defmacro |AXL-IntegerIsNonNegative| (i) 910 `(not (< ,i 0))) 911 912(defmacro |AXL-IntegerIsPositive| (i) 913 `(< 0 (the |BInt| ,i))) 914 915(defmacro |AXL-plusInteger| (a b) 916 `(the |BInt| (+ (the |BInt| ,a) 917 (the |BInt| ,b)))) 918 919(defmacro |AXL-minusInteger| (a b) 920 `(the |BInt| (- (the |BInt| ,a) 921 (the |BInt| ,b)))) 922 923(defmacro |AXL-timesInteger| (a b) 924 `(the |BInt| (* (the |BInt| ,a) 925 (the |BInt| ,b)))) 926 927(defmacro |AXL-eqInteger| (a b) 928 `(= (the |BInt| ,a) 929 (the |BInt| ,b))) 930 931(defmacro |AXL-ltInteger| (a b) 932 `(< (the |BInt| ,a) 933 (the |BInt| ,b))) 934 935(defmacro |AXL-leInteger| (a b) 936 `(<= (the |BInt| ,a) 937 (the |BInt| ,b))) 938 939(defmacro |AXL-gtInteger| (a b) 940 `(> (the |BInt| ,a) 941 (the |BInt| ,b))) 942 943(defmacro |AXL-geInteger| (a b) 944 `(>= (the |BInt| ,a) 945 (the |BInt| ,b))) 946 947(defmacro |AXL-plusSingleInteger| (a b) 948 `(the |SInt| (+ (the |SInt| ,a) 949 (the |SInt| ,b)))) 950 951(defmacro |AXL-minusSingleInteger| (a b) 952 `(the |SInt| (- (the |SInt| ,a) 953 (the |SInt| ,b)))) 954 955(defmacro |AXL-timesSingleInteger| (a b) 956 `(the |SInt| (* (the |SInt| ,a) 957 (the |SInt| ,b)))) 958 959(defmacro |AXL-eqSingleInteger| (a b) 960 `(= (the |SInt| ,a) 961 (the |SInt| ,b))) 962 963(defmacro |AXL-ltSingleInteger| (a b) 964 `(< (the |SInt| ,a) 965 (the |SInt| ,b))) 966 967(defmacro |AXL-leSingleInteger| (a b) 968 `(<= (the |SInt| ,a) 969 (the |SInt| ,b))) 970 971(defmacro |AXL-gtSingleInteger| (a b) 972 `(> (the |SInt| ,a) 973 (the |SInt| ,b))) 974 975(defmacro |AXL-geSingleInteger| (a b) 976 `(>= (the |SInt| ,a) 977 (the |SInt| ,b))) 978 979(defmacro |AXL-incSingleInteger| (i) 980 `(the |SInt| (+ (the |SInt| ,i) 1))) 981 982(defmacro |AXL-decSingleInteger| (i) 983 `(- (the |SInt| ,i) 984 (the |SInt| 1))) 985 986(defmacro |AXL-onefnSingleInteger| () '(the |SInt| 1)) 987(defmacro |AXL-zerofnSingleInteger| () '(the |SInt| 0)) 988 989(defmacro |AXL-cons| (x y) 990 `(cons ,x ,y)) 991 992(defmacro |AXL-nilfn| () nil) 993 994(defmacro |AXL-car| (x) `(car ,x)) 995 996(defmacro |AXL-cdr| (x) `(cdr ,x)) 997 998(defmacro |AXL-null?| (x) `(null ,x)) 999 1000(defmacro |AXL-rplaca| (x y) `(rplaca ,x ,y)) 1001 1002(defmacro |AXL-rplacd| (x y) `(rplacd ,x ,y)) 1003 1004(defmacro |AXL-error| (msg) `(error ,msg)) 1005 1006;; arrays 1007;; 0 based! 1008(defmacro |AXL-arrayRef| (arr i) 1009 `(|AElt| ,arr ,i)) 1010 1011(defmacro |AXL-arraySet| (arr i v) 1012 `(setf (|AElt| ,arr ,i) ,v)) 1013 1014(defmacro |AXL-arrayToList| (x) 1015 `(coerce ,x 'list)) 1016 1017(defmacro |AXL-arraySize| (x) 1018 `(length ,x)) 1019 1020(defmacro |AXL-arrayNew| (n) 1021 `(make-array ,n)) 1022 1023(defmacro |AXL-arrayCopy| (x) 1024 `(copy-seq ,x)) 1025 1026;; Vectors 1027 1028 1029;; Testing 1030 1031(defun |AXL-spitSInt| (x) 1032 (print x)) 1033 1034;; tacky but means we can run programs 1035 1036(eval-when (:execute :compile-toplevel :load-toplevel) 1037 (defun H-integer (l e) 1038 (|AXL-LiteralToInteger| l)) 1039 1040 (defun H-string (l e) 1041 (|AXL-LiteralToString| l)) 1042 1043 (defun H-error (l e) 1044 (|AXL-error| l)) 1045) 1046 1047(eval-when (:execute :load-toplevel) 1048 (DEFCONST |G-axclique_string_305639517| (cons #'H-String nil)) 1049 (DEFCONST |G-axclique_integer_685864888| (cons #'H-integer nil)) 1050 (DEFCONST |G-axclique_error_011667951| (cons #'H-error nil)) 1051) 1052 1053;; hashCombine for the code generated by the Aldor compiler 1054 1055(defun |SIntHashCombine| (x y) 1056 (boot::|hashCombine| x y)) 1057