SF.net SVN: fricas:[2653] trunk

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

Revision: 2653
http://sourceforge.net/p/fricas/code/2653
Author: whebisch
Date: 2020-03-14 19:23:45 +0000 (Sat, 14 Mar 2020)
Log Message:
-----------
Simplify builtin domains

Modified Paths:
--------------
trunk/ChangeLog
trunk/src/interp/buildom.boot
trunk/src/interp/i-funsel.boot
trunk/src/interp/lisplib.boot
trunk/src/interp/modemap.boot
trunk/src/interp/property.lisp

Modified: trunk/ChangeLog
===================================================================
--- trunk/ChangeLog 2020-03-14 19:08:06 UTC (rev 2652)
+++ trunk/ChangeLog 2020-03-14 19:23:45 UTC (rev 2653)
@@ -1,5 +1,11 @@
2020-03-14 Waldek Hebisch <heb...@math.uni.wroc.pl>

+ * src/interp/buildom.boot, src/interp/i-funsel.boot,
+ src/interp/lisplib.boot, src/interp/modemap.boot,
+ src/interp/property.lisp: Simplify builtin domains
+
+2020-03-14 Waldek Hebisch <heb...@math.uni.wroc.pl>
+
* src/algebra/coerce.spad: Retractable implies
Coercible in opposite direction


Modified: trunk/src/interp/buildom.boot
===================================================================
--- trunk/src/interp/buildom.boot 2020-03-14 19:08:06 UTC (rev 2652)
+++ trunk/src/interp/buildom.boot 2020-03-14 19:23:45 UTC (rev 2653)
@@ -257,6 +257,13 @@

--% INSTANTIATORS

+get_oplist_maker(op) ==
+ op = "Record" => "mkRecordFunList"
+ op = "Union" => "mkUnionFunList"
+ op = "Mapping" => "mkMappingFunList"
+ op = "Enumeration" => "mkEnumerationFunList"
+ false
+
RecordCategory(:x) == constructorCategory ['Record,:x]

EnumerationCategory(:x) == constructorCategory ["Enumeration",:x]
@@ -265,7 +272,7 @@


constructorCategory (title is [op,:.]) ==
- constructorFunction:= GET(op, "makeFunctionList") or
+ constructorFunction := get_oplist_maker(op) or
systemErrorHere '"constructorCategory"
[funlist,.]:= FUNCALL(constructorFunction,"$",title,$CategoryFrame)
oplist:= [[[a,b],true,c] for [a,b,c] in funlist]

Modified: trunk/src/interp/i-funsel.boot
===================================================================
--- trunk/src/interp/i-funsel.boot 2020-03-14 19:08:06 UTC (rev 2652)
+++ trunk/src/interp/i-funsel.boot 2020-03-14 19:23:45 UTC (rev 2653)
@@ -872,7 +872,7 @@
not MEMQ(dcName,'(Record Union Enumeration)) => NIL
fun:= NIL
-- cat := constructorCategory dc
- makeFunc := GET(dcName, "makeFunctionList") or
+ makeFunc := get_oplist_maker(dcName) or
systemErrorHere '"findFunctionInCategory"
[funlist,.] := FUNCALL(makeFunc,"$",dc,$CategoryFrame)
-- get list of implementations and remove sharps

Modified: trunk/src/interp/lisplib.boot
===================================================================
--- trunk/src/interp/lisplib.boot 2020-03-14 19:08:06 UTC (rev 2652)
+++ trunk/src/interp/lisplib.boot 2020-03-14 19:23:45 UTC (rev 2653)
@@ -341,8 +341,8 @@
--% from MODEMAP BOOT

augModemapsFromDomain1(name,functorForm,e) ==
- GET(IFCAR functorForm, "makeFunctionList") =>
- addConstructorModemaps(name,functorForm,e)
+ get_oplist_maker(IFCAR(functorForm)) =>
+ add_builtin_modemaps(name, functorForm, e)
atom functorForm and (catform:= getmode(functorForm,e)) =>
augModemapsFromCategory(name,name,functorForm,catform,e)
mappingForm := getmodeOrMapping(IFCAR functorForm, e) =>

Modified: trunk/src/interp/modemap.boot
===================================================================
--- trunk/src/interp/modemap.boot 2020-03-14 19:08:06 UTC (rev 2652)
+++ trunk/src/interp/modemap.boot 2020-03-14 19:23:45 UTC (rev 2653)
@@ -223,7 +223,7 @@


compCat(form is [functorName,:argl],m,e) ==
- fn := GET(functorName, "makeFunctionList") or return nil
+ fn := get_oplist_maker(functorName) or return nil
[funList,e]:= FUNCALL(fn,form,form,e)
catForm:=
["Join",'(SetCategory),["CATEGORY","domain",:
@@ -241,9 +241,10 @@
e
addModemap0(op, mc, sig, pred, fn, e)

-addConstructorModemaps(name,form is [functorName,:.],e) ==
+add_builtin_modemaps(name,form is [functorName,:.],e) ==
+ $InteractiveMode => BREAK()
e:= putDomainsInScope(name,e) --frame
- fn := GET(functorName, "makeFunctionList")
+ fn := get_oplist_maker(functorName)
[funList,e]:= FUNCALL(fn,name,form,e)
for [op,sig,opcode] in funList repeat
if opcode is [sel,dc,n] and sel='ELT then

Modified: trunk/src/interp/property.lisp
===================================================================
--- trunk/src/interp/property.lisp 2020-03-14 19:08:06 UTC (rev 2652)
+++ trunk/src/interp/property.lisp 2020-03-14 19:23:45 UTC (rev 2653)
@@ -271,14 +271,7 @@
(DOLIST (X '(TENSOR * + AND OR PROGN)) (MAKEPROP X 'NARY T))

(DOLIST (X '(
- (|Record| |mkRecordFunList|)
- (|Union| |mkUnionFunList|)
- (|Mapping| |mkMappingFunList|)
- (|Enumeration| |mkEnumerationFunList|)
-)) (MAKEPROP (CAR X) '|makeFunctionList| (CADR X)))

-(DOLIST (X '(
-
(|and| |parseAnd|)
(CATEGORY |parseCategory|)
(DEF |parseDEF|)

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