diff options
-rw-r--r-- | ChangeLog | 6 | ||||
-rw-r--r-- | NEWS | 4 | ||||
-rw-r--r-- | sml-defs.el | 5 | ||||
-rw-r--r-- | sml-mode.el | 19 | ||||
-rw-r--r-- | testcases.sml | 430 |
5 files changed, 303 insertions, 161 deletions
diff --git a/ChangeLog b/ChangeLog index 49ed5755c86..dab2de7f5a5 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,11 @@ 2012-04-11 Stefan Monnier <monnier@iro.umontreal.ca> + * sml-mode.el (sml-mark-function): New implementation using SMIE. + * sml-defs.el (sml-mode-map): Use backtab. + Remove leftover unused sml-drag-region binding. + +2012-04-11 Stefan Monnier <monnier@iro.umontreal.ca> + Use SMIE by default and make sml-oldindent optional. * sml-mode.el: Only load sml-oldindent if necessary. (sml-use-smie): Default to t. @@ -2,8 +2,12 @@ Changes since 4.1: * New indentation code using SMIE when available. +* sml-back-to-outer-indent is now on S-tab (aka `backtab') rather than M-tab. + * Support for electric-layout-mode and electric-indent-mode. +* sml-mark-defun tries to be more clever. + Changes since 4.0: * Switch to GPLv3+. diff --git a/sml-defs.el b/sml-defs.el index b095bedec0b..c8094d93ab0 100644 --- a/sml-defs.el +++ b/sml-defs.el @@ -49,14 +49,13 @@ notion of \"the end of an outline\".") (define-key map "\M-|" 'sml-electric-pipe) (define-key map "\M-\ " 'sml-electric-space) (define-key map "\;" 'sml-electric-semi) - (define-key map "\M-\t" 'sml-back-to-outer-indent) - ;; Process commands added to sml-mode-map -- these should autoload + (define-key map [backtab] 'sml-back-to-outer-indent) + ;; Process commands added to sml-mode-map -- these should autoload. (define-key map "\C-c\C-l" 'sml-load-file) (define-key map "\C-c\C-c" 'sml-compile) (define-key map "\C-c\C-s" 'switch-to-sml) (define-key map "\C-c\C-r" 'sml-send-region) (define-key map "\C-c\C-b" 'sml-send-buffer) - (define-key map [(meta shift down-mouse-1)] 'sml-drag-region) map) "The keymap used in `sml-mode'.") diff --git a/sml-mode.el b/sml-mode.el index c1c85178867..767b0c7c235 100644 --- a/sml-mode.el +++ b/sml-mode.el @@ -792,13 +792,24 @@ a newline, and indent." (if sml-electric-semi-mode (reindent-then-newline-and-indent))) -;;; INDENTATION !!! +;;; Misc (defun sml-mark-function () - "Synonym for `mark-paragraph' -- sorry. -If anyone has a good algorithm for this..." + "Mark the surrounding function. Or try to at least." (interactive) - (mark-paragraph)) + (if (not (fboundp 'smie-setup)) + (mark-paragraph) + ;; FIXME: Provide beginning-of-defun-function so mark-defun "just works". + (let ((start (point))) + (sml-beginning-of-defun) + (let ((beg (point))) + (smie-forward-sexp 'halfsexp) + (if (or (< start beg) (> start (point))) + (progn + (goto-char start) + (mark-paragraph)) + (push-mark nil t t) + (goto-char beg)))))) (defun sml-back-to-outer-indent () "Unindents to the next outer level of indentation." diff --git a/testcases.sml b/testcases.sml index 2bc4b73d6f2..12bf18abb81 100644 --- a/testcases.sml +++ b/testcases.sml @@ -1,147 +1,269 @@ -(* Copyright 1999, 2004, 2007, 2010 Stefan Monnier <monnier@gnu.org> *) +(* Copyright 1999,2004,2007,2010-2012 Stefan Monnier <monnier@gnu.org> *) -(let val a = 1 val b = 2 - val c = 3 - in 1 - end); - -(* From "Christopher Dutchyn" <cdutchyn@cs.ubc.ca> *) -(case foo of - (* FIXME: The line gets unindented by 2 every time you hit TAB :-( *) - | BAR => baz) - -(* sml-mode here treats the second `=' as an equal op because it assumes - * that the first is the definitional equal for the structure. FIXME! *) +(* sml-mode here treats the second `=' as an equal op because it + * thinks it's seeing something like "... type t = (s.t = ...)". FIXME! *) functor foo (structure s : S) where type t = s.t = -struct -val bar = 0 +struct (* fixindent *) +val bar = fn a1 a2 a3 + a5 a6 + a4 => 1 +val rec bar = + fn a1 a2 a3 + a5 a6 a4 => 1 +val bar = + fn a1 a2 a3 + a5 a6 + a4 => (1 + ;( + w + , + s + , + s + , s , a , + a + , s , a , + a + ) + ;( + w + ,s + ,a + ) + ;( + w + , s + , a + ) + ;( w + , s + , a + ) + ;( w + ,s + ,a + ) + ;3 + + a + * 4 + + let val x = 3 + in toto + end + + if a then + b + else + c + ;4) + val ber = 1; val sdfg = 1 val tut = fn (x,y) z y e r => body -end +val tut = fn (x,y) => fn z y => fn e r => + body +val tut = fn (x,y) + z + y e + r => + body +val tut = + (let + local + val x = 1 in val x = x end + val a = 1 val b = 2 + local val x = 1 in val x = x end + local val x = 1 in val x = x end + local val x = 1 in val x = x end (* fixindent *) + local val x = 1 in val x = x end + val c = 3 + in + let + val x = 3 + in + x + a * b + * c + end + end) + +val x = + (* From "Christopher Dutchyn" <cdutchyn@cs.ubc.ca> *) + (case foo of + (* This is actually not valid SML anyway. *) + | BAR => baz + | BAR => baz) + +val x = + (x := 1; + x := 2; + (* Testing obedience to user overrides: *) + x := 3; (* fixindent *) + case x of + FOO => 1 + | BAR => + 2; + case x of + FOO => 1 + | BAR => + case y of + FAR => 2 + | FRA => 3; + hello); -(x := 1; - case x of - FOO => 1 - | BAR => - 2; - case x of - FOO => 1 - | BAR => - (case y of - FAR => 2 - | FRA => 3); - hello); - -let datatype foobar - = FooB of int - | FooA of bool * int - datatype foo = FOO | BAR of baz - and baz = BAZ | QUUX of foo - - datatype foo = FOO - | BAR of baz - and baz = BAZ (* fixindent *) - | QUUX of foo - and b = g - - datatype foo = datatype M.foo - val _ = 42 val x = 5 - - signature S = S' where type foo = int - val _ = 42 - - val foo = [ - "blah" - , let val x = f 42 in g (x,x,44) end +datatype foobar + = FooB of int + | FooA of bool * int +datatype foo = FOO | BAR of baz + and baz = BAZ | QUUX of foo + +fun toto = if a + then + b + else c + +datatype foo = FOO + | BAR of baz + and baz = BAZ (* fixindent *) + | QUUX of foo + and b = g + +datatype foo = datatype M.foo +val _ = 42 val x = 5 + +signature S = S' where type foo = int +val _ = 42 + +val foo = [ + "blah" + , let val x = f 42 in g (x,x,44) end +] + +val foo = [ + "blah", + let val x = f 42 in g (x,x,44) end +] + +val foo = + [ + "blah", + let val x = f 42 in g (x,x,44) end ] - - val foo = [ "blah" - , let val x = f 42 in g (x,x,44) end - , foldl (fn ((p,q),s) => g (p,q,Vector.length q) ^ ":" ^ s) - "" (Beeblebrox.masterCountList mlist2) - , if null mlist2 then ";" else "" - ] - - fun foo (true::rest) - = 1 + 2 * foo rest - | foo (false::rest) - = let val _ = 1 in 2 end - + 2 * foo rest - - val x = if foo then - 1 - else if bar then - 2 - else - 3 - val y = if foo - then 1 - else if foo - then 2 - else 3 - - ; val yt = 4 -in - if a then b else c; - case M.find(m,f) - of SOME(fl, filt) => - F.APP(F.VAR fl, OU.filter filt vs) - | NONE => le; - x := x + 1; - (case foo - of a => f - ) -end; +val foo = [ "blah" + , let val x = f 42 in g (x,x,44) end + , foldl (fn ((p,q),s) => g (p,q,Vector.length q) ^ ":" ^ s) + "" (Beeblebrox.masterCountList mlist2) + , if null mlist2 then ";" else "" + ] -let -in a; - foo("(*") - * 2; -end; +fun foo (true::rest) = 1 + 2 * foo rest + | foo (false::rest) + = let val _ = 1 in 2 end + + 2 + * foo rest -let -in a - ; b -end; +val x = if foo then + 1 + else if bar then + 2 + else + 3 +val y = if foo + then 1 + else if foo + then 2 (* Could also be indented by a basic offset. *) + else 3 -let -in - a - ; b -end; +val yt = 4 -let -in if a then - b - else - c -end; +val x = + (if a then b else c; + case M.find(m,f) + of SOME(fl, filt) => + F.APP(F.VAR fl, OU.filter filt vs) + | NONE + => le + | NONE => + le + | NONE => le; + x := x + 1; + (case foo + of a => f + )) -let -in case a of - F => 1 - | D => 2 -end; +val y = ( + let fun f1 = + let fun g1 x = 2 + fun g2 y = 4 + local fun toto y = 1 + (* val x = 5 *) + in + fun g3 z = z + end + in toto + end + in a;( ( let + val f =1 + in + toto + end + ) + ) + foo("(*") + * 2; + end; -let -in case a - of F => 1 - | D => 2 -end; + let + in a + ; b + end; + + let + in + a + + b + + c + ; b + end; + + let + in if a then + b + else + c + end; + + let + in case a of + F => 1 + | D => 2 + end; -let -in if a then b else - c + let + in case a + of F => 1 + | D => 2 + end; + + let + in if a then b else + c + end; + + let + in if a then b + else + c + end) end; structure Foo = struct val x = 1 end +structure Foo = struct val x = 1 + end + signature FSPLIT = sig type flint = FLINT.prog @@ -169,23 +291,23 @@ fun bug msg = ErrorMsg.impossible ("FSplit: "^msg) fun buglexp (msg,le) = (say "\n"; PP.printLexp le; say " "; bug msg) fun bugval (msg,v) = (say "\n"; PP.printSval v; say " "; bug msg) fun assert p = if p then () else bug ("assertion failed") - + type flint = F.prog val mklv = LambdaVar.mkLvar val cplv = LambdaVar.dupLvar - + fun S_rmv(x, s) = S.delete(s, x) handle NotFound => s - + fun addv (s,F.VAR lv) = S.add(s, lv) | addv (s,_) = s fun addvs (s,vs) = foldl (fn (v,s) => addv(s, v)) s vs fun rmvs (s,lvs) = foldl (fn (l,s) => S_rmv(l, s)) s lvs - + exception Unknown - + fun split (fdec as (fk,f,args,body)) = let val {getLty,addLty,...} = Recover.recover (fdec, false) - + val m = Intmap.new(64, Unknown) fun addpurefun f = Intmap.add m (f, false) fun funeffect f = (Intmap.map m f) handle Uknown => true @@ -207,7 +329,7 @@ fun split (fdec as (fk,f,args,body)) = let * mistakenly adding anything to leI. *) fun sexp env lexp = (* fixindent *) - let + let (* non-side effecting binds are copied to leI if exported *) fun let1 (le,lewrap,lv,vs,effect) = let val (leE,leI,fvI,leRet) = sexp (S.add(env, lv)) le @@ -216,7 +338,7 @@ fun sexp env lexp = (* fixindent *) then (leE, leI, fvI, leRet) else (leE, lewrap leI, addvs(S_rmv(lv, fvI), vs), leRet) end - + in case lexp (* we can completely move both RET and TAPP to the I part *) of F.RECORD (rk,vs,lv,le as F.RET [F.VAR lv']) => @@ -227,11 +349,11 @@ fun sexp env lexp = (* fixindent *) (fn e => e, lexp, addvs(S.empty, vs), lexp) | F.TAPP (F.VAR tf,tycs) => (fn e => e, lexp, S.singleton tf, lexp) - + (* recursive splittable lexps *) | F.FIX (fdecs,le) => sfix env (fdecs, le) | F.TFN (tfdec,le) => stfn env (tfdec, le) - + (* binding-lexps *) | F.CON (dc,tycs,v,lv,le) => let1(le, fn e => F.CON(dc, tycs, v, lv, e), lv, [v], false) @@ -241,33 +363,33 @@ fun sexp env lexp = (* fixindent *) let1(le, fn e => F.SELECT(v, i, lv, e), lv, [v], false) | F.PRIMOP (po,vs,lv,le) => let1(le, fn e => F.PRIMOP(po, vs, lv, e), lv, vs, PO.effect(#2 po)) - + (* IMPROVEME: lvs should not be restricted to [lv] *) | F.LET(lvs as [lv],body as F.TAPP (v,tycs),le) => let1(le, fn e => F.LET(lvs, body, e), lv, [v], false) | F.LET (lvs as [lv],body as F.APP (v as F.VAR f,vs),le) => let1(le, fn e => F.LET(lvs, body, e), lv, v::vs, funeffect f) - + | F.SWITCH (v,ac,[(dc as F.DATAcon(_,_,lv),le)],NONE) => let1(le, fn e => F.SWITCH(v, ac, [(dc, e)], NONE), lv, [v], false) - + | F.LET (lvs,body,le) => let val (leE,leI,fvI,leRet) = sexp (S.union(S.addList(S.empty, lvs), env)) le in (fn e => F.LET(lvs, body, leE e), leI, fvI, leRet) end - + (* useless sophistication *) | F.APP (F.VAR f,args) => if funeffect f then (fn e => e, F.RET[], S.empty, lexp) else (fn e => e, lexp, addvs(S.singleton f, args), lexp) - + (* other non-binding lexps result in unsplittable functions *) | (F.APP _ | F.TAPP _) => bug "strange (T)APP" | (F.SWITCH _ | F.RAISE _ | F.BRANCH _ | F.HANDLE _) => (fn e => e, F.RET[], S.empty, lexp) end - + (* Functions definitions fall into the following categories: * - inlinable: if exported, copy to leI * - (mutually) recursive: don't bother @@ -288,10 +410,10 @@ and sfix env (fdecs,le) = end | [fdec as (fk as {cconv=F.CC_FCT,...},_,_,_)] => sfdec env (leE,leI,fvI,leRet) fdec - + | _ => (nleE, leI, fvI, leRet) end - + and sfdec env (leE,leI,fvI,leRet) (fk,f,args,body) = let val benv = S.union(S.addList(S.empty, map #1 args), env) val (bodyE,bodyI,fvbI,bodyRet) = sexp benv body @@ -302,7 +424,7 @@ and sfdec env (leE,leI,fvI,leRet) (fk,f,args,body) = | _ => let val fvbIs = S.listItems(S.difference(fvbI, benv)) val (nfk,fkE) = OU.fk_wrap(fk, NONE) - + (* fdecE *) val fE = cplv f val fErets = (map F.VAR fvbIs) @@ -313,7 +435,7 @@ and sfdec env (leE,leI,fvI,leRet) (fk,f,args,body) = val fdecE = (fkE, fE, args, bodyE) val fElty = LT.ltc_fct(map #2 args, map getLty fErets) val _ = addLty(fE, fElty) - + (* fdecI *) val fkI = {inline=F.IH_ALWAYS, cconv=F.CC_FCT, known=true, isrec=NONE} @@ -321,7 +443,7 @@ and sfdec env (leE,leI,fvI,leRet) (fk,f,args,body) = (map (fn lv => (lv, getLty(F.VAR lv))) fvbIs) @ args val fdecI as (_,fI,_,_) = FU.copyfdec(fkI,f,argsI,bodyI) val _ = addpurefun fI - + (* nfdec *) val nargs = map (fn (v,t) => (cplv v, t)) args val argsv = map (fn (v,t) => F.VAR v) nargs @@ -335,11 +457,11 @@ and sfdec env (leE,leI,fvI,leRet) (fk,f,args,body) = F.APP(F.VAR fI, (F.VAR lv)::argsv)) end *) val nfdec = (nfk, f, nargs, nbody) - + (* and now, for the whole F.FIX *) fun nleE e = F.FIX([fdecE], F.FIX([fdecI], F.FIX([nfdec], leE e))) - + in if not(S.member(fvI, f)) then (nleE, leI, fvI, leRet) else (nleE, F.FIX([fdecI], F.FIX([nfdec], leI)), @@ -347,7 +469,7 @@ and sfdec env (leE,leI,fvI,leRet) (fk,f,args,body) = leRet) end end - + (* TFNs are kinda like FIX except there's no recursion *) and stfn env (tfdec as (tfk,tf,args,body),le) = let val (bodyE,bodyI,fvbI,bodyRet) = @@ -376,7 +498,7 @@ and stfn env (tfdec as (tfk,tf,args,body),le) = val bodyE = bodyE(F.RET tfEvs) val tfElty = LT.lt_nvpoly(args, map getLty tfEvs) val _ = addLty(tfE, tfElty) - + (* tfdecI *) val tfkI = {inline=F.IH_ALWAYS} val argsI = map (fn (v,k) => (cplv v, k)) args @@ -390,7 +512,7 @@ and stfn env (tfdec as (tfk,tf,args,body),le) = fun nleE e = F.TFN((tfk, tfE, args, bodyE), F.TFN((tfkI, tf, argsI, bodyI), leE e)) - + in if not(S.member(fvI, tf)) then (nleE, leI, fvI, leRet) else (nleE, F.TFN((tfkI, tf, argsI, bodyI), leI), @@ -398,7 +520,7 @@ and stfn env (tfdec as (tfk,tf,args,body),le) = leRet) end end - + (* here, we use B-decomposition, so the args should not be * considered as being in scope *) val (bodyE,bodyI,fvbI,bodyRet) = sexp S.empty body @@ -406,11 +528,11 @@ in case (bodyI, bodyRet) of (F.RET _,_) => ((fk, f, args, bodyE bodyRet), NONE) | (_,F.RECORD (rk,vs,lv,F.RET[lv'])) => let val fvbIs = S.listItems fvbI - + (* fdecE *) val bodyE = bodyE(F.RECORD(rk, vs@(map F.VAR fvbIs), lv, F.RET[lv'])) val fdecE as (_,fE,_,_) = (fk, cplv f, args, bodyE) - + (* fdecI *) val argI = mklv() val argLtys = (map getLty vs) @ (map (getLty o F.VAR) fvbIs) @@ -419,7 +541,7 @@ in case (bodyI, bodyRet) (n+1, F.SELECT(F.VAR argI, n, lv, le))) (length vs, bodyI) fvbIs val fdecI as (_,fI,_,_) = FU.copyfdec (fk, f, argsI, bodyI) - + val nargs = map (fn (v,t) => (cplv v, t)) args in (fdecE, SOME fdecI) @@ -431,11 +553,11 @@ in case (bodyI, bodyRet) F.APP(F.VAR fI, [F.VAR argI]))))), NONE) *) end - + | _ => (fdec, NONE) (* sorry, can't do that *) (* (PPFlint.printLexp bodyRet; bug "couldn't find the returned record") *) - + end - + end end |