(* Lexical Syntax *) datatype token = LEQ (* <= *) | ARROW (* -> *) | DARROW (* => *) | ADD (* + *) | SUB (* - *) | MUL (* * *) | LPAR (* ( *) | RPAR (* ) *) | COLON (* : *) | ICON of int (* integer constant *) | IF (* if *) | THEN (* then *) | ELSE (* else *) | FN (* fn *) | REC (* rec *) | FALSE (* false *) | TRUE (* true *) | ID of string (* identifier *) exception Error val ord0 = ord #"0" fun lexA' "if" = IF | lexA' "then" = THEN | lexA' "else" = ELSE | lexA' "fn" = FN | lexA' "rec" = REC | lexA' "false" = FALSE | lexA' "true" = TRUE | lexA' s = ID s fun lex' ts nil = rev ts | lex' ts (#" " ::cs) = lex' ts cs | lex' ts (#"\n"::cs) = lex' ts cs | lex' ts (#"\t"::cs) = lex' ts cs | lex' ts (#"<" :: #"=" ::cs) = lex' (LEQ::ts) cs | lex' ts (#"-" :: #">" ::cs) = lex' (ARROW::ts) cs | lex' ts (#"=" :: #">" ::cs) = lex' (DARROW::ts) cs | lex' ts (#"+" ::cs) = lex' (ADD::ts) cs | lex' ts (#"-" ::cs) = lex' (SUB::ts) cs | lex' ts (#"*" ::cs) = lex' (MUL::ts) cs | lex' ts (#"(" ::cs) = lex' (LPAR::ts) cs | lex' ts (#")" ::cs) = lex' (RPAR::ts) cs | lex' ts (#":" ::cs) = lex' (COLON::ts) cs | lex' ts (c ::cs) = if Char.isDigit c then lexNum ts 1 0 (c::cs) else if c = #"~" andalso not(null cs) then lexNum ts ~1 0 cs else if Char.isAlpha c then lexA ts [c] cs else raise Error and lexNum ts s n cs = if not(null cs) andalso Char.isDigit (hd cs) then lexNum ts s (10*n + (ord(hd cs) - ord0)) (tl cs) else lex'(ICON(s*n)::ts) cs and lexA ts xs cs = if not(null cs) andalso Char.isAlphaNum(hd cs) then lexA ts (hd cs::xs) (tl cs) else lex'(lexA'(implode(rev xs)) :: ts) cs fun lex s =lex' nil (explode s) val potenzTok = lex ("(rec f(x:int):int->int => fn n:int =>" ^ "if n<=0 then 1 else x*f x (n-1)) 2 10") val fac10Tok = lex "(rec f(n:int):int=>if n<=1then 1else n*f(n-1))10" (* Abstract Syntax *) datatype con = False | True | IC of int type id = string datatype ops = Add | Sub | Mul | Leq datatype ty = Bool | Int | Arrow of ty * ty datatype exp = Con of con | Id of id | Op of exp * ops * exp | If of exp * exp * exp | Abs of id * ty * exp | App of exp * exp | Rec of id * id * ty * ty * exp (* Phrasal Syntax aty = "int" | "bool" | "(" ty ")" ty = aty ["->" ty] atexp = constant | identifier | "(" exp ")" apexp = atexp apexp' apexp' = [atexp apexp'] mulexp = apexp mulexp' mulexp' = ["*" apexp mulexp'] asexp = mulexp asexp' asexp' = [("+" | "-") mulexp asexp'] exp = "if" exp "then" exp "else" exp | "fn" identifier ":" ty "=>" exp | "rec" identifier "(" identifier ":" ty ")" ":" ty "=>" exp | asexp ["<=" asexp] *) fun match (a,ts) t = if null ts orelse hd ts <> t then raise Error else (a, tl ts) fun combine a ts p f = let val (a',tr) = p ts in (f(a,a'), tr) end fun atty (ID"int" ::ts) = (Int ,ts) | atty (ID"bool"::ts) = (Bool,ts) | atty (LPAR ::ts) = match (ty ts) RPAR | atty _ = raise Error and ty ts = case atty ts of (a, ARROW::tr) => combine a tr ty Arrow | ats => ats fun opa ops (a,a') = Op(a,ops,a') fun firstAtexp (TRUE ::_) = true | firstAtexp (FALSE ::_) = true | firstAtexp (ICON _::_) = true | firstAtexp (ID _ ::_) = true | firstAtexp (LPAR ::_) = true | firstAtexp _ = false fun atexp (FALSE ::ts) = (Con False, ts) | atexp (TRUE ::ts) = (Con True , ts) | atexp (ICON n::ts) = (Con(IC n), ts) | atexp (ID s ::ts) = (Id s , ts) | atexp (LPAR ::ts) = match (exp ts) RPAR | atexp _ = raise Error and appexp ts = appexp'(atexp ts) and appexp'(a,ts) = if firstAtexp ts then appexp'(combine a ts atexp App) else (a,ts) and mulexp ts = mulexp'(appexp ts) and mulexp'(a, MUL::ts) = mulexp'(combine a ts appexp (opa Mul)) | mulexp' ats = ats and asexp ts = asexp' (mulexp ts) and asexp'(a, ADD::ts) = asexp'(combine a ts mulexp (opa Add)) | asexp'(a, SUB::ts) = asexp'(combine a ts mulexp (opa Sub)) | asexp' ats = ats and exp (IF::ts) = let val (a1,ts1) = match (exp ts) THEN val (a2,ts2) = match (exp ts1) ELSE val (a3,ts3) = exp ts2 in (If(a1,a2,a3), ts3) end | exp (FN::ID s::COLON::ts) = let val (a1,ts1) = match (ty ts) DARROW val (a2,ts2) = exp ts1 in (Abs(s,a1,a2), ts2) end | exp (REC::ID s::LPAR::ID s'::COLON::ts) = let val (a1,ts1) = match (match (ty ts) RPAR) COLON val (a2,ts2) = match (ty ts1) DARROW val (a3,ts3) = exp ts2 in (Rec(s,s',a1,a2,a3), ts3) end | exp ts = case asexp ts of (a, LEQ::tr) => combine a tr asexp (opa Leq) | ats => ats fun parse ts = case exp ts of (a, nil) => a | _ => raise Error val faca = parse fac10Tok val potenza = parse potenzTok