Paste: cours1

! Ce vocabulaire (a.k.a. module) doit être placé dans le fichier
! work/inf355/cours1/cours1.factor pour pouvoir être trouvé par Factor
! lorsqu'on fait.
!
!  USE: inf355.cours1
!

! Nom du vocabulaire.

IN: inf355.cours1

! Vocabulaires utilisés.

USING: accessors io kernel math sequences ;

! Opérations de base.

: square ( x -- y ) dup * ;

: cube ( x -- y ) dup square * ;

! Création d'un nouveau vecteur à chaque appel à "myvec".

: myvec ( -- vec ) V{ } clone ;

! Utilisation du combinateur "bi" pour utiliser deux fois
! les données qui se trouvent sur la pile.

: mean ( seq -- n )
    [ sum ] [ length ] bi / ;

! Une autre méthode avec "dup" au lieu de "bi".

: mean' ( seq -- n )
    dup sum swap length / ;

! Implémentation classique d'un calcul de factorielle récursif.

: fact ( n -- n' )
    dup 2 > [
        [ 1 - fact ] [ * ] bi
    ] when ;

! Affichage de la parité d'un nombre.

: print-parity ( n -- )
    [ "it was " ] dip odd?
    "odd" "even" ? append print ;

! Utilisation de "bi*" pour inverser une liste. "unclip" est
! bien pratique ici.

: rev ( seq -- seq' )
    dup length 2 >= [
        unclip
        [ rev ] [ suffix ] bi*
    ] when ;

! Réimplémentation de "sum" avec "reduce".

: mysum ( seq -- n )
    0 [ + ] reduce ;

! Création d'un type "person".

TUPLE: person { first initial: "John" } { last initial: "Doe" } ;

! Définition d'un constructeur pour ce type. C'est équivalent à
!   : <person> ( first last -- person ) person boa ;
! ou à
!   : <person> ( first last -- person ) [ person new ] 2dip >>first >>last ;

C: <person> person

! La classe "student" est dérivée de "person" et ajoute un champ
! "grade" avec une valeur initiale de 0.

TUPLE: student < person { grade initial: 0 } ;

! Définition d'un type "course" et de son constructeur.

TUPLE: course name teacher { students initial: { } } ;

: <course> ( name teacher -- course )
    { } course boa ;

! Ajout d'un étudiant à un cours.

: add-student ( course student -- course )
    [ suffix ] curry change-students ;

: add-named-student ( course first last -- course )
    0 student boa add-student ;

! Déclaration d'une fonction générique "name" permettant de récupérer
! nom d'une personne, puis définition pour une "person" et pour un
! "student".

GENERIC: name ( person -- str )

M: person name
    [ first>> ] [ last>> ] bi
    " " glue ;

M: student name
    call-next-method "The small " prepend ;

! Un "good-student" est un "student" avec une note supérieure ou égale
! à 10.

PREDICATE: good-student < student
    grade>> 10 >= ;

! On spécialise "name" pour un "good-student".

M: good-student name
    call-next-method " (and great!)" append ;

! Un enseignant a un bureau.

TUPLE: teacher < person office ;

! Un membre de l'université est soit un étudiant soit un enseignant.

UNION: university-member student teacher ;

! Définition d'une fonction donnant le nom à l'envers (nom de famille
! en premier et prénom ensuite) et implémentation pour un membre de
! l'université.

GENERIC: reverse-name ( u -- str )

M: university-member reverse-name
    [ last>> ] [ first>> ] bi " " glue ;

! Définition d'un type mixin "graded" représentant ceux qui peuvent avoir
! une note.

MIXIN: graded

! "grade" et "final-grade" sont génériques.

GENERIC: grade ( p -- n )
GENERIC: final-grade ( p -- n )

! Par défaut, la note est 20.

M: graded grade drop 20 ;

! Par défaut, la note finale est égale à la note.

M: graded final-grade grade ;

! Pour un étudiant, la note est la note obtenue.

M: student grade grade>> ;

! Pour un bon étudiant, la note finale est la note augmentée de la demi-différence
! avec 20.

M: good-student final-grade call-next-method 20 + 2 / ;

! Les étudiants et les enseignants peuvent avoir une note.

INSTANCE: teacher graded
INSTANCE: student graded

! On peut aussi étendre les notes aux nombres : la note est le nombre lui-même.

M: number grade ;

INSTANCE: number graded