Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.postscript > #3147 > unrolled thread

Experiments with multimethods

Back to article view | Back to comp.lang.postscript

Contents

  Experiments with multimethods Carlos <carlos@cvkm.cz> - 2017-07-28 02:58 +0200
    Re: Experiments with multimethods luser droog <luser.droog@gmail.com> - 2017-07-29 09:12 -0700
      Re: Experiments with multimethods luser droog <luser.droog@gmail.com> - 2017-08-01 22:33 -0700
        Re: Experiments with multimethods luser droog <luser.droog@gmail.com> - 2017-08-01 23:37 -0700
          Re: Experiments with multimethods luser droog <luser.droog@gmail.com> - 2017-08-05 17:29 -0700
            Re: Experiments with multimethods Carlos <carlos@cvkm.cz> - 2017-08-06 14:45 +0200
              Re: Experiments with multimethods luser droog <luser.droog@gmail.com> - 2017-08-22 09:25 -0700

#3147 — Experiments with multimethods

This is somewhat related to parameter checking, which is a subject of
the other thread.

Last year there was a discussion about the capabilities of PostScript
as a programming language. It was argued that you can't define custom
overloads for the standard operators, so to prove that you can do
*everything* in PostScript I implemented a small proof-of-concept
library to add multimethods and a type system.

(Of course you can't do *everything* in PostScript, but thanks to the
fact that (1) code is data, and (2) it is garbage collected, you can
do a lot more than in other programming languages.)

Here is that particular message:

  https://groups.google.com/d/msg/comp.lang.postscript/fEyXR90-wq4/OofyLFEJBgAJ

With this library, you can define a new type by adding a constraint to
an existing type. For example,

/starts-with-A-type /stringtype {
    dup length 1 ge { 0 get 65 eq } { false } ifelse
} deftype

GS>(abcd) type ==
stringtype

GS>(Abcd) type ==
starts-with-A-type

GS>/starts-with-A-type ancestors ==
[/starts-with-A-type /stringtype /sequencetype /anytype]

A multimethod is like a method, but it's dispatched on the types of
all its arguments. It's akin to operator overloading.

/add [/sequencetype /sequencetype] {
    2 copy length exch length add
    1 index /basearraytype isa { array } { string } ifelse
    dup 4 -1 roll 1 index copy length 4 -1 roll putinterval
} defmethod

GS>(Abcd) (efgh) add ==
(Abcdefgh)

GS>1 1 add ==
2

(The example with mul in the linked message is maybe more
illustrative.)

The similarity with parameter checking comes from the fact that if a
method isn't found for the given arguments, an error is signaled (just
a message here).

/+ [/numbertype /numbertype] { add } defmethod

GS>1 1 + =
2

GS>(Abcd) (efgh) +
no applicable method

Now I think this "type system" is the wrong way to go for OOP. It's
better to leave built-in types alone and just use dicts for user
objects. It would make the system more efficient and flexible,
allowing multiple inheritance. The constraint based type definition
has maybe its uses, but OOP isn't one. Anyway, I didn't realize it at
the time.

%!PS

% /Inspect /Inspect /ProcSet findresource def

% /ppstack { Inspect /inspectstack get exec = } def


/builtintype systemdict /type get def

/TYPES <<
    /anytype <<
        /NAME /anytype
        /PARENT null
        /SUBTYPES 15 dict
        /CHECK { pop true } bind
    >>
    /~~BUILTIN~~ 15 dict
>> def

%: typename ->
/defbuiltintype {
    2 dict begin
    /typename exch def
    /typedata <<
        /NAME typename
        /PARENT TYPES /anytype get
        /SUBTYPES << >>
        /CHECK [ /builtintype cvx typename /eq cvx ] cvx bind
    >> def
    TYPES typename typedata put
    TYPES /anytype get /SUBTYPES get typename typedata put
    TYPES /~~BUILTIN~~ get typename typedata put
    end
} bind def


[ /arraytype /booleantype /dicttype /filetype /fonttype /gstatetype
  /integertype /marktype /nametype /nulltype /operatortype
  /packedarraytype /realtype /savetype /stringtype
] {
    defbuiltintype
} forall

currentdict /defbuiltintype undef

%: typename parenttypename checkproc ->
/deftype {
    5 dict begin
    /check exch def  /parentname exch def  /name exch def
    /parent TYPES parentname get def
    /typedata <<
        /NAME name   /PARENT parent   /CHECK /check load
        /SUBTYPES << >>
    >> def
    parent /SUBTYPES get name typedata put
    TYPES name typedata put
    end
} bind def

% some adjustments to builtin types:
%   insert numbertype (before real- and integertype),
%       basearraytype (before array- and packedarraytype)
%    and sequencetype (before basearray- and stringtype)

% [... name2 name1] -> dup name1 eq exch dup name2 eq exch ... ... or or
/@eq_to_any {
    2 dict begin
    /arr exch def  /len arr length def
    len 0 gt {
        len 1 gt { /dup cvx } if
        arr len 1 sub get
        /eq cvx
        len 1 gt { /exch cvx } if
        arr 0 len 1 sub getinterval @eq_to_any
        len 1 gt { /or cvx } if
    } if
    end
} bind def

[ /basearraytype [ /arraytype /packedarraytype ]
  /sequencetype  [ /basearraytype /stringtype  ]
  /numbertype    [ /integertype /realtype      ]
] 1 2 2 index length {
    5 dict begin
    /subtypenames 2 index 2 index get def
    /name exch 1 sub 2 index exch get def
    /subtypes [ subtypenames { TYPES exch get } forall ] def
    /check [ /type cvx subtypenames @eq_to_any ] cvx def
    name /anytype /check load deftype
    /t TYPES name get def
    subtypes {
        t /SUBTYPES get 1 index dup /NAME get exch put
        dup /PARENT t put
        TYPES /anytype get /SUBTYPES get exch undef
    } forall
    end
} for pop

currentdict /@eq_to_any undef

%: any -> typename
/type {
    3 dict begin
    /obj exch def
    /typename /obj load builtintype def
    /subtypes TYPES /typename load get /SUBTYPES get def
    true  % exit loop
    {
        subtypes {
            exch pop
            dup /CHECK get /obj load exch exec {
                dup /typename exch /NAME get def
                /subtypes exch /SUBTYPES get def
                pop false  % don't exit loop
                exit
            } {
                pop
            } ifelse
        } forall
        % exit loop?
        { exit } { true } ifelse
    } loop
    /typename load cvx
    end
} bind def

%: typename -> array
/ancestors {
    [
        TYPES 3 -1 roll get
        {
            dup /NAME get exch
            /PARENT get dup null eq { pop exit } if
        } loop
    ]
} bind def

%: any typename -> bool
/isa {
    false 3 -1 roll
    type ancestors {
        2 index eq { pop true exit } if
    } forall
    exch pop
} bind def


/METHODS << >> def

%: name [argtypes] proc ->
/defmethod {
    3 -1 roll
    dup METHODS exch known not {
        dup where {
            1 index get
        } {
            null
        } ifelse
        % stack: [argtypes] proc name originalproc/null
        1 index
        3 dict begin
        /name exch def  /orig exch def  /arity 3 index length def
        METHODS name <<
            /ORIGINAL /orig load
            /ARITY arity
            /DISPATCH << >>
        >> put
        end
    } if
    4 dict begin
    /name exch def  /proc exch def  /argtypes exch def
    /method METHODS name get def
    method /ARITY get argtypes length ne {
        % signal error "invalid arity"
        stop
    } if
    method /DISPATCH get
    argtypes 0 argtypes length 1 sub getinterval {
        2 copy known not {
            2 copy 1 dict put
        } if
        get
    } forall
    argtypes argtypes length 1 sub get /proc load put
    name
    end
    dup [ exch /callmethod cvx ] cvx def
} bind def

%: methodname -> ...
/callmethod {
    dup METHODS exch known {
        METHODS exch get
        dup /ORIGINAL get exch
        dup /DISPATCH get
        exch /ARITY get 1 add -1 2 {
            % stack: argN ... arg1 orig dispatch idx
            index type ancestors false % found?
            exch {
                % stack: ... dispatch false typename
                dup 3 index exch known {
                    3 -1 roll exch get exch pop true
                    exit
                } {
                    pop
                } ifelse
            } forall
            % if found, continue with next argument; else leave
            { } { exit } ifelse
        } for
        dup builtintype /dicttype eq {  % we didn't reach the proc
            pop  dup null eq {  % no fallback function
                % signal error "no applicable method"
                (no applicable method)=
                pop stop
            } {
                exec % call fallback function
            } ifelse
        } {
            exch pop
            exec % call method
        } ifelse
    } {
        % signal error "no such method"
        (no such method (!))=
        stop
    } ifelse
} bind def

-- 

[toc] | [next] | [standalone]

#3149

On Thursday, July 27, 2017 at 7:58:33 PM UTC-5, Carlos wrote:
> This is somewhat related to parameter checking, which is a subject of
> the other thread.
> 
> Last year there was a discussion about the capabilities of PostScript
> as a programming language. It was argued that you can't define custom
> overloads for the standard operators, so to prove that you can do
> *everything* in PostScript I implemented a small proof-of-concept
> library to add multimethods and a type system.
> 
> (Of course you can't do *everything* in PostScript, but thanks to the
> fact that (1) code is data, and (2) it is garbage collected, you can
> do a lot more than in other programming languages.)
> 
> Here is that particular message:
> 
>   https://groups.google.com/d/msg/comp.lang.postscript/fEyXR90-wq4/OofyLFEJBgAJ

I had forgotten that one. Thanks for the link.

> With this library, you can define a new type by adding a constraint to
> an existing type. For example,
> 
> /starts-with-A-type /stringtype {
>     dup length 1 ge { 0 get 65 eq } { false } ifelse
> } deftype
> 
> GS>(abcd) type ==
> stringtype
> 
> GS>(Abcd) type ==
> starts-with-A-type
> 
> GS>/starts-with-A-type ancestors ==
> [/starts-with-A-type /stringtype /sequencetype /anytype]

Now that is really cool. I assume you've read Owen Densmore's paper.
http://web.archive.org/web/20160404161559/https://code.google.com/p/xpost/downloads/detail?name=monterey86.pdf&can=2&q=

> A multimethod is like a method, but it's dispatched on the types of
> all its arguments. It's akin to operator overloading.
> 
> /add [/sequencetype /sequencetype] {
>     2 copy length exch length add
>     1 index /basearraytype isa { array } { string } ifelse
>     dup 4 -1 roll 1 index copy length 4 -1 roll putinterval
> } defmethod
> 
> GS>(Abcd) (efgh) add ==
> (Abcdefgh)
> 
> GS>1 1 add ==
> 2
> 
> (The example with mul in the linked message is maybe more
> illustrative.)
> 
> The similarity with parameter checking comes from the fact that if a
> method isn't found for the given arguments, an error is signaled (just
> a message here).
> 
> /+ [/numbertype /numbertype] { add } defmethod
> 
> GS>1 1 + =
> 2
> 
> GS>(Abcd) (efgh) +
> no applicable method
> 
> Now I think this "type system" is the wrong way to go for OOP. It's
> better to leave built-in types alone and just use dicts for user
> objects. It would make the system more efficient and flexible,
> allowing multiple inheritance. The constraint based type definition
> has maybe its uses, but OOP isn't one. Anyway, I didn't realize it at
> the time.

Using dictionaries exclusively is the way the NeWS classes worked.
I'm curious what you think of that code.

If this becomes useful enough, we could even implement some operators
in the interpreter for speed and suggest it for PS 4.

<snip>

[toc] | [prev] | [next] | [standalone]

#3159

On Saturday, July 29, 2017 at 11:12:42 AM UTC-5, luser droog wrote:
> Now that is really cool. I assume you've read Owen Densmore's paper.
> http://web.archive.org/web/20160404161559/https://code.google.com/p/xpost/downloads/detail?name=monterey86.pdf&can=2&q=
> 

I have a modified version of the code from that paper that runs in gs.
https://github.com/luser-dr00g/xpost/blob/master/data/class.ps


%
% PS Class Implementation inspired by
% http://code.google.com/p/xpost/downloads/detail?name=monterey86.ps
%
%(../../debug.ps/db5.ps)run

%/known { pstack()= known } bind def
%/known { 1 index type /nulltype eq {false}{known} ifelse } bind def
%/null { null cvlit } bind def

/printf { % () []
    { % () ?
        exch % ? ()
        (%) search { % ? post match pre
            print pop exch
            =string cvs print
        }{ % ? ()
            exch pop % ()
            exit
        } ifelse
    } forall % ()
    print
} def

/append { % a b
    dup type /arraytype eq {
        2 copy length exch length add array 3 1 roll  % z a b
        3 copy pop 0 exch putinterval % z' a b
        3 copy exch length exch putinterval % z'' a b
        pop pop
    }{
        exch begin
        {def}forall
        currentdict end
    }ifelse
} def

%[1 2 3] [4] append ==

%
% Objects 'n stuff.
%

/ObjectTemplate <<  % All objects have these fields.
    /parentDict      null  % link to my parent dict; stops at null.
    /parentDictArray null  % complete parent chain to Object!
>> def
/ClassTemplate <<   % Class objects have these fields in addition:
    /instanceVars     null  % this class's additional inst vars
    /instanceVarDict  null  % this class' total inst vars
    /instanceVarExtra 10    % extra space for class var over-rides
    /className        null  % name of the class (as a keyword)
    /subClasses       []    % subclass list (for browsing)
>> def

% Create a sub-class of the given class.
%    The instance variables may be either an array or a dict.
%    The advantage of using a dict is that the variables will be
%    pre-initialized to a value you chose, rather than "null".
/classbegin {   % classname superclass instvars => - (newclass on dict stack)
1 dict begin
    ObjectTemplate {def} forall
    ClassTemplate {def} forall

    /instanceVars exch def
    /parentDict exch def
    /className exch def
} def
/classend {   %  - => classname newclass
    currentdict {
        dup xcheck {parentDict methodcompile def} {pop pop} ifelse
    } forall

    /instanceVarDict instanceVars def
    /parentDictArray [] def

    instanceVarDict type /arraytype eq {
        /instanceVarDict instanceVarDict length dict dup begin
            instanceVarDict {null def} forall
        end def
    } if

    parentDict null ne {
        parentDict /subClasses 2 copy get [className] append put
        /instanceVarDict
            parentDict /instanceVarDict get instanceVarDict append def
        /parentDictArray
            parentDict /parentDictArray get [parentDict] append def
    } if

    className
currentdict end
} def
% Crack open the methods and fix for "super send" and "self send"
/methodcompile { % method parentDict => newmethod
10 dict begin
    /superpending false def
    /selfpending false def
    /parentDict exch def
    [ exch {
        dup xcheck {
            dup /send eq superpending selfpending or and {
                pop pop
                superpending
                    {parentDict /className get cvx /supersend cvx}
                    {cvx} ifelse
            } if
            dup type /arraytype eq {parentDict methodcompile} if

            dup /super eq /superpending exch def
            dup /self eq /selfpending exch def
        } if
    } forall ] cvx
end
} def

% Generic Smalltalk-ish Primitives.
% Send a message to an object.
/send { % <args> message object => <results>
    %pstack()=
    dup /parentDictArray get {begin} forall
    begin
        cvx exec
    parentDictArray length 1 add {end} repeat
} def
% Send a message to super without popping myself.
/supersend { % <args> keywordmessage superclass => <results>
    %pstack()=
    exch { 2 copy known {exit} {exch /parentDict get exch} ifelse } loop
    get exec
} def
% Put me on the operand stack.
/self {/parentDict where pop} def

% Your basic object!
/Object null [] classbegin
    /new { % class  =>  instance
        ObjectTemplate length instanceVarDict length instanceVarExtra
        add add dict dup begin
            instanceVarDict {def} forall
            ObjectTemplate {def} forall
        end
        dup /parentDict currentdict put
        dup /parentDictArray parentDictArray [currentdict] append put
    } def
    /doit { % proc ins  =>  - (compile & execute the proc)
        parentDict /parentDict get methodcompile exec
    } def

    /set { % {/key value ...}  =>  -  stores the values in the object
        mark exch cvx exec
        counttomark 2 idiv {def} repeat pop % store??
    } def
classend def



/smalltalkpage62 {
    /One Object [] classbegin
        /test {1} def
        /result1 { /test self send} def
    classend def

    /Two One [] classbegin
        /test {2} def
    classend def

    /ex1 /new One send def
    /ex2 /new Two send def

    /test ex1 send =
    /result1 ex1 send =
    /test ex2 send =
    /result1 ex2 send =

    /Three Two [] classbegin
        /result2 { /result1 self send} def
        /result3 { /test super send}
        pstack()=
        dup {
            xcheck =
        } forall
    def
    classend def
    /Four Three [] classbegin
        /test {4} def
    classend def

    /ex3 /new Three send def
    /ex4 /new Four send def
    Three {exch =only ( )print ==} forall
    %ex3 {exch =only ( )print ==} forall
    %Four {exch =only ( )print ==} forall
    %ex4 {exch =only ( )print ==} forall

    /test ex3 send =
    /result1 ex4 send =
    /result2 ex3 send =
    /result2 ex4 send =
    /result3 ex3 send =
    /result3 ex4 send =
} def

%/smalltalkpage62 cvx traceon stepon debug
%smalltalkpage62




xpost/data$ gsnd class.ps
GPL Ghostscript 9.18 (2015-10-05)
Copyright (C) 2015 Artifex Software, Inc.  All rights reserved.
This software comes with NO WARRANTY: see the file PUBLIC for details.
GS>smalltalkpage62
1
1
2
2
{/test super send}
/result3

false
true
true
className /Three
result3 {/test Two supersend}
result2 {result1}
parentDictArray [-dict- -dict- -dict-]
instanceVarDict -dict-
subClasses [/Four]
parentDict -dict-
instanceVars []
instanceVarExtra 10
2
4
2
4
2
2
GS>

[toc] | [prev] | [next] | [standalone]

#3160

On Wednesday, August 2, 2017 at 12:33:26 AM UTC-5, luser droog wrote:
> On Saturday, July 29, 2017 at 11:12:42 AM UTC-5, luser droog wrote:
> > Now that is really cool. I assume you've read Owen Densmore's paper.
> > http://web.archive.org/web/20160404161559/https://code.google.com/p/xpost/downloads/detail?name=monterey86.pdf&can=2&q=
> > 
> 
> I have a modified version of the code from that paper that runs in gs.
> https://github.com/luser-dr00g/xpost/blob/master/data/class.ps
> 

Let me pull out two pieces that I think are interesting.
This version of printf takes a control string and an array
of objects and for each % in the control string, it converts
the next object in the array to a string and prints it.


> /printf { % () []
>     { % () ?
>         exch % ? ()
>         (%) search { % ? post match pre
>             print pop exch
>             =string cvs print
>         }{ % ? ()
>             exch pop % ()
>             exit
>         } ifelse
>     } forall % ()
>     print
> } def
> 


And I was complaining about implementing the typed argument syntax
with executable/literal names but methodcompile shows how to scan
through and match a sequence of two things, even though you're doing
a 'forall' which only gives you one thing at a time.

So, that shouldn't be so hard after this example.

> % Crack open the methods and fix for "super send" and "self send"
> /methodcompile { % method parentDict => newmethod
> 10 dict begin
>     /superpending false def
>     /selfpending false def
>     /parentDict exch def
>     [ exch {
>         dup xcheck {
>             dup /send eq superpending selfpending or and {
>                 pop pop
>                 superpending
>                     {parentDict /className get cvx /supersend cvx}
>                     {cvx} ifelse
>             } if
>             dup type /arraytype eq {parentDict methodcompile} if
> 
>             dup /super eq /superpending exch def
>             dup /self eq /selfpending exch def
>         } if
>     } forall ] cvx
> end
> } def


Before I had the above realization, I sketched out a "structure" which
I think accomodates extensible multi-dispatch and local named args.

Just a sketch. The types from top-of-stack down are arranged in a tree
of dictionaries. Descending the tree, matching types against the stack,
as soon as we hit an executable array, then that's the procedure body
and we execute it.

/join { a /arraytype } {
    a dup 0 exch { length add } forall
    string dup 3 2 roll 0 exch {
        3 copy putinterval length add
    } forall pop
} { n /integertype } {
    n array join
} multi def


<<
    /arraytype {a}{ body } func
    /integertype {n}{ body } func
>>



/muladd { x /realtype y /realtype z /realtype }{
    x y mul z add
} multi def

<< /realtype << /realtype << /realtype {x y z}{ body } func
                          >>
             >>
>>



That's what I'm thinking...

[toc] | [prev] | [next] | [standalone]

#3162

On Wednesday, August 2, 2017 at 1:37:47 AM UTC-5, luser droog wrote:

> And I was complaining about implementing the typed argument syntax
> with executable/literal names but methodcompile shows how to scan
> through and match a sequence of two things, even though you're doing
> a 'forall' which only gives you one thing at a time.
> 
> So, that shouldn't be so hard after this example.
> 
<snip> 
> Before I had the above realization, I sketched out a "structure" which
> I think accomodates extensible multi-dispatch and local named args.
> 
> Just a sketch. The types from top-of-stack down are arranged in a tree
> of dictionaries. Descending the tree, matching types against the stack,
> as soon as we hit an executable array, then that's the procedure body
> and we execute it.
> 

> That's what I'm thinking...

Here's a partly-working version of this idea. It works with one function
signature, and only with real types returned by 'type'. The /isa function
understands /anytype and /numbertype (which may be all we need here) but
it's not currently used. 

(struct.ps)run<<
/isa {
    dup /anytype    eq { pop pop true                                 }{
    dup /numbertype eq { pop dup /integertype eq exch /realtype eq or }{
        exch type eq
    } ifelse } ifelse
}
/multi { 2 dict begin
    /body exch def
    /name-pending false def
    [exch{  %% fill in elided "/anytype"s                                                                       
        dup xcheck name-pending and { /anytype exch } if
        dup xcheck /name-pending exch def
    }forall name-pending { /anytype } if ]  /args exch def
    /names [ args 2 { 0 get } fortuple ] def
    /types [ args 2 { 1 get } fortuple ] def
    names /body load func  /body exch def

    types reverse { << exch } forall
    /body load
    types length { >> } repeat

    {
        1 1 max-args {
            index type 2 copy known {
                get
                dup type /arraytype eq { exit } if
            }{
                pop pop /typecheck /multifunc cvx signalerror
            } ifelse
        } for
        exec
    } curry
end }
/max-args 10
>>begin

/muladd { x /integertype y /realtype z /realtype }{
    x y mul z add
} multi def

<< /realtype << /realtype << /integertype {x y z}{ body } func
                          >>
             >>
>> pop

//muladd ===

2 3.0 4.0 muladd =



gsnd -dNOSAFER multi.ps
GPL Ghostscript 9.19 (2016-03-23)
Copyright (C) 2016 Artifex Software, Inc.  All rights reserved.
This software comes with NO WARRANTY: see the file PUBLIC for details.
{<< /realtype << /realtype << /integertype {[z y x] dup length dict begin {exch def} forall x y mul z add end} /.name_order [/integertype] >> /.name_order [/realtype] >> /.name_order [/realtype] >> 1 1 10 {index type 2 copy known {get dup type /arraytype eq {exit} if} {pop pop /typecheck /multifunc cvx signalerror} ifelse} for exec}
10.0
GS>

[toc] | [prev] | [next] | [standalone]

#3163

[luser droog <luser.droog@gmail.com>, 2017-08-05 17:29]
> On Wednesday, August 2, 2017 at 1:37:47 AM UTC-5, luser droog wrote:
> 
> > And I was complaining about implementing the typed argument syntax
> > with executable/literal names but methodcompile shows how to scan
> > through and match a sequence of two things, even though you're doing
> > a 'forall' which only gives you one thing at a time.
> > 
> > So, that shouldn't be so hard after this example.
> >   
> <snip> 
> > Before I had the above realization, I sketched out a "structure" which
> > I think accomodates extensible multi-dispatch and local named args.
> > 
> > Just a sketch. The types from top-of-stack down are arranged in a tree
> > of dictionaries. Descending the tree, matching types against the stack,
> > as soon as we hit an executable array, then that's the procedure body
> > and we execute it.
> >   
> 
> > That's what I'm thinking...  
> 
> Here's a partly-working version of this idea. It works with one function
> signature, and only with real types returned by 'type'. The /isa function
> understands /anytype and /numbertype (which may be all we need here) but
> it's not currently used. 
[...]

I went that way before, but I now don't think it's a good idea. In the
multimethod library a couple messages upthread, if you write, for
instance,

  /add [/stringtype /stringtype] {
      2 copy length exch length add string
      dup 4 -1 roll 1 index copy length 4 -1 roll putinterval
  } defmethod

  /mul [/stringtype /stringtype] {
      exch ( x ) add exch add
  } defmethod

  /mul [/stringtype /integertype] {
      () exch { 1 index add } repeat
      exch pop
  } defmethod

GS>(John) (Mary) mul =
John x Mary
GS>(xx) 5 mul =
xxxxxxxxxx

the METHODS global ends up with

  <<
    /add <<
      /ORIGINAL add
      /ARITY 2
      /DISPATCH <<
        /stringtype <<
          /stringtype { 2 copy length exch length add string
                        dup 4 -1 roll 1 index copy length 4 -1 roll
                        putinterval }
          >>
        >>
      >>
    /mul <<
      /ORIGINAL mul
      /ARITY 2
      /DISPATCH <<
        /stringtype <<
          /stringtype { exch ( x ) add exch add }
          /integertype { () exch {1 index add} repeat
                         exch pop }
        >>
      >>
    >>
  >>

(Only difference with yours is that this one goes left-to-right.)

The problem is that this works well with disjoint types, but bad with
inheritance. If you have "/fn [/anytype] {...} defmethod" and
"/fn [/integertype] {...} defmethod", "1 fn" won't necessarily call
the second method.

There is also the problem when the wrong path is selected. For
instance, with "/fn [/anytype /arraytype] {...}" and
"/fn [/integertype /integertype] {...}", "2 [1 2] fn" should call the
first method, but, having matched the first parameter, the dispatcher
is now committed to the wrong path and ends up signaling type error.

I think the way to go is to match sequentially full parameter lists,
which are ordered from more specific to least specific. (I think
that's how CLOS (the inspiration of this multimethod thing) does it.)

-- 

[toc] | [prev] | [next] | [standalone]

#3164

On Sunday, August 6, 2017 at 7:45:27 AM UTC-5, Carlos wrote:
> [luser droog <luser.droog@gmail.com>, 2017-08-05 17:29]
> > On Wednesday, August 2, 2017 at 1:37:47 AM UTC-5, luser droog wrote:
> > 
> > > And I was complaining about implementing the typed argument syntax
> > > with executable/literal names but methodcompile shows how to scan
> > > through and match a sequence of two things, even though you're doing
> > > a 'forall' which only gives you one thing at a time.
> > > 
> > > So, that shouldn't be so hard after this example.
> > >   
> > <snip> 
> > > Before I had the above realization, I sketched out a "structure" which
> > > I think accomodates extensible multi-dispatch and local named args.
> > > 
> > > Just a sketch. The types from top-of-stack down are arranged in a tree
> > > of dictionaries. Descending the tree, matching types against the stack,
> > > as soon as we hit an executable array, then that's the procedure body
> > > and we execute it.
> > >   
> > 
> > > That's what I'm thinking...  
> > 
> > Here's a partly-working version of this idea. It works with one function
> > signature, and only with real types returned by 'type'. The /isa function
> > understands /anytype and /numbertype (which may be all we need here) but
> > it's not currently used. 
> [...]
> 
> I went that way before, but I now don't think it's a good idea. In the
> multimethod library a couple messages upthread, if you write, for
> instance,
> 
>   /add [/stringtype /stringtype] {
>       2 copy length exch length add string
>       dup 4 -1 roll 1 index copy length 4 -1 roll putinterval
>   } defmethod
> 
>   /mul [/stringtype /stringtype] {
>       exch ( x ) add exch add
>   } defmethod
> 
>   /mul [/stringtype /integertype] {
>       () exch { 1 index add } repeat
>       exch pop
>   } defmethod
> 
> GS>(John) (Mary) mul =
> John x Mary
> GS>(xx) 5 mul =
> xxxxxxxxxx
> 
> the METHODS global ends up with
> 
>   <<
>     /add <<
>       /ORIGINAL add
>       /ARITY 2
>       /DISPATCH <<
>         /stringtype <<
>           /stringtype { 2 copy length exch length add string
>                         dup 4 -1 roll 1 index copy length 4 -1 roll
>                         putinterval }
>           >>
>         >>
>       >>
>     /mul <<
>       /ORIGINAL mul
>       /ARITY 2
>       /DISPATCH <<
>         /stringtype <<
>           /stringtype { exch ( x ) add exch add }
>           /integertype { () exch {1 index add} repeat
>                          exch pop }
>         >>
>       >>
>     >>
>   >>
> 
> (Only difference with yours is that this one goes left-to-right.)
> 
> The problem is that this works well with disjoint types, but bad with
> inheritance. If you have "/fn [/anytype] {...} defmethod" and
> "/fn [/integertype] {...} defmethod", "1 fn" won't necessarily call
> the second method.
> 
> There is also the problem when the wrong path is selected. For
> instance, with "/fn [/anytype /arraytype] {...}" and
> "/fn [/integertype /integertype] {...}", "2 [1 2] fn" should call the
> first method, but, having matched the first parameter, the dispatcher
> is now committed to the wrong path and ends up signaling type error.
> 
> I think the way to go is to match sequentially full parameter lists,
> which are ordered from more specific to least specific. (I think
> that's how CLOS (the inspiration of this multimethod thing) does it.)
> 

After much distraction and thought I begin to understand what you're
saying about this setup not working with inheritance. ISTM that you 
need to sort the function "signatures" (or prototypes) based on the
topography of the type tree. 

I'm not at all sure how to go about doing that. But I think that's
the correct mathematical name for what we need, a topographical sort.

[toc] | [prev] | [standalone]

Back to top | Article view | comp.lang.postscript

csiph-web