Plai 5:adding functions to Languae

#lang plai-typed (Define-type EXPRC [NUMC (N:number)] [IdC (S:symbol)] [PLUSC (L:EXPRC) (R:EXPRC)] [MULTC (l    : EXPRC) (R:EXPRC)] [AppC (Fun:symbol) (ARG:EXPRC)]) (Define-type Exprs [NumS (N:number)] [IdS (S:symbol)]  [Pluss (L:exprs) (R:EXPRS)]  [Uminuss (E:EXPRS)]  [Bminuss (L:exprs) (R:EXPRS)]  [Mults (L:exprs) (R:EXPRS)] [AppS (Fun:symbol) (ARG:EXPRS)]) (Define (Desugar [As:exprs]): EXPRC (Type-case Exprs as [NumS (n) (NUMC N)] [IdS (s) (IdC s)] [Pluss (L R) (p LUSC (Desugar L) (Desugar R)] [Mults (L R) (MULTC (Desugar L) (Desugar R)] [Uminuss (E) (Desugar (Mults (numS-1) e)] [Bminuss (L R) (PLUSC (Desugar L) (MULTC (numC-1) (Desugar R))] [AppS (f a) (AppC F (Desugar a))]) (Defin  E (parses [s:s-expression]): Exprs (Cond [(S-exp-number. S) (NumS (S-exp->number s))] [(S-exp-symbol? s) (IdS    (S-exp->symbol s))] [(S-exp-list. s) (Let ([SL (S-exp->list s)]) (Case (S-exp->symbol (first SL))         [(+) (Pluss (parses (second SL)) (parses (third SL))]         [(*) (Mults (parses (second SL)) (parses (third SL))]         [(U) (Uminuss (parses (second SL))]         [(-) (Bminuss (parses (second SL)) (parses (third SL))]    [Else (AppS (S-exp->symbol (first SL)) (parses (second SL))])]    [Else (Error ' parses ' invalid input ')]) (Define-type FUNDEFC [FdC (Name:symbol) (Arg:symbol) (BODY:EXPRC)])  (Define (Get-fundef [N:symbol] [FDS: (Listof FUNDEFC)]): FUNDEFC (Cond (empty FDS) (Error ' Get-fundef ' reference                   to undefined function ")] [(Cons FDS) (cond [(Equal] n (fdc-name (first FDS))] [Else (get-fundef N (rest FDS)]))) (Define (Parse-fundef [s:s-expression]): FUNDEFC (Cond [(s-exp-list. s) (Let ([SL (S-exp->list s)]) (c                        ASE (S-exp->symbol (first SL)) [(define) (FdC (S-exp->symbol (First (s-exp->list (second SL))) (S-exp->symbol (Second (s-exp->list (second SL)))) (Desugar (parses (third SL)))] [Else (E Rror ' parse-fundef "Invalid List")])] [Else (Error ' Parse-fundef "Invalid Input")])) (define (subst [WHAT:EXPRC] [F  Or:symbol] [IN:EXPRC]): EXPRC (Type-case EXPRC in [NUMC (n) in] [IdC (s) (Cond [(symbol=. S for) What] [other in]] [APPC (f a) (APPC F (subst)] [PLUSC (L R) (PLUSC (subst) (su BST)] [MULTC (L R) (MULTC (subst what for L))]) (Define (Interp [E:EXPRC] [FDS: (List of FUNDEFC)]: number (type-case EXPRC e [NUMC (n) n] [IdC (_) (Error ' interpc ' shouldn ' t get here ")] [AppC (f A) (local ([Define FD (Get-fundef F FDS)]) (Interp (subst a (fdc-arg fd) (Fdc-body FD))] [PLUSC (l R)    (+ (Interp l FDS) (Interp R FDS)] [MULTC (L R) (* (Interp l FDS) (Interp R FDS)])) (Define (parse [s:s-expression]): EXPRC (Desugar(parses s))) (Define (main [s:s-expression] [fs: (Listof s-expression)]): Number (Interp (parse s) (Map Parse-fundef FS)) (Define L (List ' (define (f x) (+ x x)) ' (Define (g x) (* x 3))) (define s1 ' (+ (f 2) (* 2 3)) (main s1 L) (Define S2 ' (+ (U (f 2)) (-(G 5) (* 2 (+ 2 4)))) (Main s2 L)

Refer to this article: https://zhuanlan.zhihu.com/p/20475329

Plai 5:adding functions to Languae