I have now better patch that changes interprter coercion and
passes type to all formatters except for FortranFormat.
--
Waldek Hebisch
--
You received this message because you are subscribed to the Google Groups
"FriCAS - computer algebra system" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to [email protected].
To view this discussion on the web visit
https://groups.google.com/d/msgid/fricas-devel/ZTMS6W3huT/7UF56%40fricas.org.
)package "BOOT"
any_to_string(u) == WRITE_-TO_-STRING(u)
arg_to_OutputForm(arg, t, c) ==
c => constructor_to_OutputForm(arg)
isValidType(t) and PAIRP(t) and
(GETDATABASE(first(t),'CONSTRUCTORKIND) = 'domain) =>
(val := coerceInteractive(objNewWrap(arg, t), $OutputForm)) =>
objValUnwrap(val)
-- Wrong, but we try to produce something
any_to_string(arg)
-- Wrong, but we try to produce something
any_to_string(arg)
prefix_to_string(con) ==
u := prefix2String(con)
atom(u) => u
concatenateStringList([object2String(x) for x in u])
-- fake, to catch possible use
mkCategory_to_OutputForm(argl) ==
throwMessage('"mkCategory_to_OutputForm called")
-- fake, to catch possible use
Join_to_OutputForm(argl) ==
throwMessage('"Join_to_OutputForm called")
Record_to_OutputForm(argl) ==
rres := []
for [":", name, type] in argl repeat
r1 := ['CONCAT, name, '":", constructor_to_OutputForm(type)]
rres := cons(r1, rres)
cons('Record, reverse(rres))
Union_to_OutputForm(argl) ==
not(null(argl)) and (first(argl) is [":", name, type]) =>
-- new style Union
nargs := [['CONCAT, name, '":", constructor_to_OutputForm(type)]
for [":", name, type] in argl]
['Union, :nargs]
-- old style
nargs := [constructor_to_OutputForm(arg) for arg in argl]
['Union, :nargs]
Mapping_to_OutputForm(argl) ==
-- should we allow this ???
null(argl) => ['PAREN, ['CONCAT, '"()", "->", '"()"]]
rt := constructor_to_OutputForm(first(argl))
nargs := [constructor_to_OutputForm(arg) for arg in rest(argl)]
if #nargs > 1 then
nargs := ['PAREN, ['AGGLST, :nargs]]
else if null(nargs) then
nargs := '"()"
else
nargs := first(nargs)
['PAREN, ['CONCAT, nargs, "->", rt]]
constructor_to_OutputForm(con) ==
if VECTORP(con) then
con := devaluate(con)
STRINGP(con) => CONCAT("_"", con, "_"")
ATOM(con) =>
con = $EmptyMode => '"?"
-- Wrong, but we try to produce something printable
any_to_string(con)
op := first(con)
argl := rest(con)
op = 'Join => Join_to_OutputForm(argl)
op = 'mkCategory => mkCategory_to_OutputForm(argl)
op = 'Record => Record_to_OutputForm(argl)
op = 'Union => Union_to_OutputForm(argl)
op = 'Mapping => Mapping_to_OutputForm(argl)
(abb := constructor?(op)) =>
null(argl) => constructorName(op)
con_sig := getConstructorSignature(op)
cosig := GETDATABASE(op,'COSIG)
null(con_sig) or null(cosig) =>
-- Wrong, but we try to produce something
prefix_to_string(con)
con_sig := rest(con_sig)
cosig := rest(cosig)
if not freeOfSharpVars(con_sig) then
con_sig := SUBLIS([[s_var, :val]
for s_var in $FormalMapVariableList
for val in argl], con_sig)
n_argl := [arg_to_OutputForm(arg, t, c) for arg in argl
for t in con_sig for c in cosig]
[constructorName(op), :n_argl]
-- Wrong, but we try to produce something
prefix_to_string(con)
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 72d19ac8..42798fdb 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -29,7 +29,7 @@ OBJ_files= macros setq \
i-coerce i-coerfn i-eval i-funsel i-intern \
i-map i-output i-resolv i-spec1 i-spec2 i-syscmd \
i-toplev incl interop int-top lisplib macex match \
- msg msgdb nlib nrunfast \
+ msg msgdb nformat nlib nrunfast \
nrungo nrunopt pathname pf2sex pile \
posit ptrees rulesets scan \
serror server setvars sfsfun simpbool slam \
diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot
index a489a7aa..2512ebdb 100644
--- a/src/interp/i-coerce.boot
+++ b/src/interp/i-coerce.boot
@@ -741,7 +740,7 @@ typeIsASmallInteger x == (x = $SingleInteger)
typeToInputForm(t) == typeToForm(t, '(InputForm))
-typeToOutputForm(t) == typeToForm(t, $OutputForm)
+typeToOutputForm(t) == constructor_to_OutputForm(t)
typeToForm(t, toForm) ==
t0 := devaluate(t)
diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot
index c0d19100..0c40b688 100644
--- a/src/interp/i-output.boot
+++ b/src/interp/i-output.boot
@@ -1310,25 +1328,24 @@ formattedFormat expr ==
FORCE_-OUTPUT(get_formatted_stream())
NIL
+do_formatters(x, was_type) ==
+ if $fortranFormat and not(was_type) then fortranFormat(x)
+ if $algebraFormat then mathprintWithNumber(x)
+ if $texFormat then texFormat(x)
+ if $mathmlFormat then mathmlFormat(x)
+ if $texmacsFormat then texmacsFormat(x)
+ if $htmlFormat then htmlFormat(x)
+ if $formattedFormat then formattedFormat(x)
+
output(expr,domain) ==
$resolve_level : local := 0
if isWrapped expr then expr := unwrap expr
isMapExpr expr and not(domain is ["FunctionCalled", .]) => BREAK()
- categoryForm? domain or domain = ["Mode"] =>
- if $algebraFormat then
- mathprintWithNumber outputDomainConstructor expr
- if $texFormat then
- texFormat outputDomainConstructor expr
+ categoryForm?(domain) or domain = ["Mode"] =>
+ do_formatters(constructor_to_OutputForm(expr), true)
T := coerceInteractive(objNewWrap(expr,domain),$OutputForm) =>
- x := objValUnwrap T
- if $fortranFormat then fortranFormat x
- if $algebraFormat then
- mathprintWithNumber x
- if $texFormat then texFormat x
- if $mathmlFormat then mathmlFormat x
- if $texmacsFormat then texmacsFormat x
- if $htmlFormat then htmlFormat x
- if $formattedFormat then formattedFormat x
+ x := objValUnwrap T
+ do_formatters(x, false)
(FUNCTIONP(opOf domain)) and (not(SYMBOLP(opOf domain))) and
(printfun := compiledLookup("<<",'(TextWriter TextWriter %), evalDomain domain))
and (textwrit := compiledLookup("print", '(%), TextWriter())) =>
