SF.net SVN: fricas:[2646] trunk

[wheb...@users.sourceforge.net]

Revision: 2646
http://sourceforge.net/p/fricas/code/2646
Author: whebisch
Date: 2020-03-10 18:28:04 +0000 (Tue, 10 Mar 2020)
Log Message:
-----------
Convert few function to Boot

Modified Paths:
--------------
trunk/ChangeLog
trunk/src/interp/g-util.boot
trunk/src/interp/macros.lisp
trunk/src/interp/scwrap2.boot

Modified: trunk/ChangeLog
===================================================================
--- trunk/ChangeLog 2020-03-09 12:26:40 UTC (rev 2645)
+++ trunk/ChangeLog 2020-03-10 18:28:04 UTC (rev 2646)
@@ -1,3 +1,8 @@
+2020-03-10 Waldek Hebisch <heb...@math.uni.wroc.pl>
+
+ * src/interp/g-util.boot, src/interp/macros.lisp,
+ src/interp/scwrap2.boot: Convert few function to Boot
+
2020-03-09 Waldek Hebisch <heb...@math.uni.wroc.pl>

* src/algebra/mring.spad: Simplify and generalize

Modified: trunk/src/interp/g-util.boot
===================================================================
--- trunk/src/interp/g-util.boot 2020-03-09 12:26:40 UTC (rev 2645)
+++ trunk/src/interp/g-util.boot 2020-03-10 18:28:04 UTC (rev 2646)
@@ -45,6 +45,34 @@
GENVAR() ==
INTERNL1('"$", STRINGIMAGE($GENNO := $GENNO + 1))

+contained_eq(x, y) ==
+ ATOM(y) => EQ(x, y)
+ contained_eq(x, first(y)) or contained_eq(x, rest(y))
+
+contained_equal(x, y) ==
+ x = y => true
+ ATOM(y) => false
+ contained_equal(x, first(y)) or contained_equal(x, rest(y))
+
+CONTAINED(x, y) ==
+ SYMBOLP(x) => contained_eq(x, y)
+ contained_equal(x, y)
+
+ELEMN(l, n, def_val) ==
+ for i in 1..(n - 1) repeat
+ NULL(l) => return def_val
+ l := rest(l)
+ NULL(l) => def_val
+ first(l)
+
+LISTOFATOMS1(l, rl) ==
+ NULL(l) => rl
+ ATOM(l) => CONS(l, rl)
+ rl := LISTOFATOMS1(first(l), rl)
+ LISTOFATOMS1(rest(l), rl)
+
+LISTOFATOMS(l) == NREVERSE(LISTOFATOMS1(l, []))
+
Identity x == x

length1? l == PAIRP l and not PAIRP QCDR l

Modified: trunk/src/interp/macros.lisp
===================================================================
--- trunk/src/interp/macros.lisp 2020-03-09 12:26:40 UTC (rev 2645)
+++ trunk/src/interp/macros.lisp 2020-03-10 18:28:04 UTC (rev 2646)
@@ -324,16 +324,6 @@

; 15.2 Lists

-(defun ELEMN (X N DEFAULT)
- (COND ((NULL X) DEFAULT)
- ((EQL N 1) (CAR X))
- ((ELEMN (CDR X) (- N 1) DEFAULT))))
-
-(defun LISTOFATOMS (X)
- (COND ((NULL X) NIL)
- ((ATOM X) (LIST X))
- ((NCONC (LISTOFATOMS (CAR X)) (LISTOFATOMS (CDR X))))))
-
(DEFUN LASTATOM (L) (if (ATOM L) L (LASTATOM (CDR L))))

(defun DROP (N X &aux m)
@@ -373,27 +363,6 @@

; 15.5 Using Lists as Sets

-;;; The [[CONTAINED]] predicate is used to walk internal structures
-;;; such as modemaps to see if the $X$ object occurs within $Y$. One
-;;; particular use is in a function called [[isPartialMode]] (see
-;;; i-funsel.boot) to decide
-;;; if a modemap is only partially complete. If this is true then the
-;;; modemap will contain the constant [[$EmptyMode]]. So the call
-;;; ends up being [[CONTAINED |$EmptyMode| Y]].
-(DEFUN CONTAINED (X Y)
- (if (symbolp x)
- (contained\,eq X Y)
- (contained\,equal X Y)))
-
-(defun contained\,eq (x y)
- (if (atom y) (eq x y)
- (or (contained\,eq x (car y)) (contained\,eq x (cdr y)))))
-
-(defun contained\,equal (x y)
- (cond ((atom y) (equal x y))
- ((equal x y) 't)
- ('t (or (contained\,equal x (car y)) (contained\,equal x (cdr y))))))
-
(DEFUN |set_sum| (X Y)
(COND ((ATOM Y) X)
((ATOM X) Y)
@@ -606,13 +575,6 @@
(DEFUN |rightBindingPowerOf| (X IND &AUX (Y (GET X IND)))
(IF Y (ELEMN Y 4 105) 105))

-(defun |make_BF| (MT EP) (LIST |$BFtag| MT EP))
-
-(defun |make_float| (int frac fraclen exp)
- (if (= frac 0)
- (|make_BF| int exp)
- (|make_BF| (+ (* int (expt 10 fraclen)) frac) (- exp fraclen)) ))
-
(defun |print_full2| (expr stream)
(let ((*print-circle* t) (*print-array* t) *print-level* *print-length*)
(print expr stream)

Modified: trunk/src/interp/scwrap2.boot
===================================================================
--- trunk/src/interp/scwrap2.boot 2020-03-09 12:26:40 UTC (rev 2645)
+++ trunk/src/interp/scwrap2.boot 2020-03-10 18:28:04 UTC (rev 2646)
@@ -12,6 +12,12 @@
addBinding('$Information, nil,
makeInitialModemapFrame())))

+make_BF(mant, expo) == [$BFtag, mant, expo]
+
+make_float(int, frac, fraclen, expo) ==
+ frac = 0 => make_BF(int, expo)
+ make_BF(int*EXPT(10, fraclen) + frac, expo - fraclen)
+
current_line_number() ==
tok := current_token()
tok =>

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.